Annotation of loncom/interface/loncommon.pm, revision 1.1378
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1378 ! raeburn 4: # $Id: loncommon.pm,v 1.1377 2022/02/16 16:28:49 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.1378 ! raeburn 1313: if (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
! 1314: $target = ' target="'.$env{'request.deeplink.target'}.'"';
! 1315: }
1.755 neumanie 1316: if ($text ne "") {
1.763 bisitz 1317: $template.='<span class="LC_help_open_topic">'
1.1314 raeburn 1318: .'<a'.$target.' href="'.$link.'">'
1.763 bisitz 1319: .$text.'</a>';
1.48 bowersj2 1320: }
1321:
1.763 bisitz 1322: # (Always) Add the graphic
1.179 matthew 1323: my $title = &mt('Online Help');
1.667 raeburn 1324: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1325: if ($imgid ne '') {
1326: $imgid = ' id="'.$imgid.'"';
1327: }
1.1314 raeburn 1328: $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763 bisitz 1329: .'<img src="'.$helpicon.'" border="0"'
1330: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1331: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1332: .' /></a>';
1333: if ($text ne "") {
1334: $template.='</span>';
1335: }
1.44 bowersj2 1336: return $template;
1337:
1.106 bowersj2 1338: }
1339:
1340: # This is a quicky function for Latex cheatsheet editing, since it
1341: # appears in at least four places
1342: sub helpLatexCheatsheet {
1.1037 www 1343: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1344: my $out;
1.106 bowersj2 1345: my $addOther = '';
1.732 raeburn 1346: if ($topic) {
1.1037 www 1347: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1348: }
1349: $out = '<span>' # Start cheatsheet
1350: .$addOther
1351: .'<span>'
1.1037 www 1352: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1353: .'</span> <span>'
1.1037 www 1354: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1355: .'</span>';
1.732 raeburn 1356: unless ($not_author) {
1.1186 kruse 1357: $out .= '<span>'
1358: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1359: .'</span> <span>'
1360: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1361: .'</span>';
1.732 raeburn 1362: }
1.763 bisitz 1363: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1364: return $out;
1.172 www 1365: }
1366:
1.430 albertel 1367: sub general_help {
1368: my $helptopic='Student_Intro';
1369: if ($env{'request.role'}=~/^(ca|au)/) {
1370: $helptopic='Authoring_Intro';
1.907 raeburn 1371: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1372: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1373: } elsif ($env{'request.role'}=~/^dc/) {
1374: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1375: }
1376: return $helptopic;
1377: }
1378:
1379: sub update_help_link {
1380: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1381: my $origurl = $ENV{'REQUEST_URI'};
1382: $origurl=~s|^/~|/priv/|;
1383: my $timestamp = time;
1384: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1385: $$datum = &escape($$datum);
1386: }
1387:
1388: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1389: my $output .= <<"ENDOUTPUT";
1390: <script type="text/javascript">
1.824 bisitz 1391: // <![CDATA[
1.430 albertel 1392: banner_link = '$banner_link';
1.824 bisitz 1393: // ]]>
1.430 albertel 1394: </script>
1395: ENDOUTPUT
1396: return $output;
1397: }
1398:
1399: # now just updates the help link and generates a blue icon
1.193 raeburn 1400: sub help_open_menu {
1.430 albertel 1401: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1402: = @_;
1.949 droeschl 1403: $stayOnPage = 1;
1.430 albertel 1404: my $output;
1405: if ($component_help) {
1406: if (!$text) {
1407: $output=&help_open_topic($component_help,undef,$stayOnPage,
1408: $width,$height);
1409: } else {
1410: my $help_text;
1411: $help_text=&unescape($topic);
1412: $output='<table><tr><td>'.
1413: &help_open_topic($component_help,$help_text,$stayOnPage,
1414: $width,$height).'</td></tr></table>';
1415: }
1416: }
1417: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1418: return $output.$banner_link;
1419: }
1420:
1421: sub top_nav_help {
1.1369 raeburn 1422: my ($text,$linkattr) = @_;
1.436 albertel 1423: $text = &mt($text);
1.949 droeschl 1424: my $stay_on_page = 1;
1425:
1.1168 raeburn 1426: my ($link,$banner_link);
1427: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1428: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1429: : "javascript:helpMenu('open')";
1430: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1431: }
1.201 raeburn 1432: my $title = &mt('Get help');
1.1168 raeburn 1433: if ($link) {
1434: return <<"END";
1.436 albertel 1435: $banner_link
1.1369 raeburn 1436: <a href="$link" title="$title" $linkattr>$text</a>
1.436 albertel 1437: END
1.1168 raeburn 1438: } else {
1439: return ' '.$text.' ';
1440: }
1.436 albertel 1441: }
1442:
1443: sub help_menu_js {
1.1154 raeburn 1444: my ($httphost) = @_;
1.949 droeschl 1445: my $stayOnPage = 1;
1.436 albertel 1446: my $width = 620;
1447: my $height = 600;
1.430 albertel 1448: my $helptopic=&general_help();
1.1154 raeburn 1449: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1450: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1451: my $start_page =
1452: &Apache::loncommon::start_page('Help Menu', undef,
1453: {'frameset' => 1,
1454: 'js_ready' => 1,
1.1154 raeburn 1455: 'use_absolute' => $httphost,
1.331 albertel 1456: 'add_entries' => {
1.1168 raeburn 1457: 'border' => '0',
1.579 raeburn 1458: 'rows' => "110,*",},});
1.331 albertel 1459: my $end_page =
1460: &Apache::loncommon::end_page({'frameset' => 1,
1461: 'js_ready' => 1,});
1462:
1.436 albertel 1463: my $template .= <<"ENDTEMPLATE";
1464: <script type="text/javascript">
1.877 bisitz 1465: // <![CDATA[
1.253 albertel 1466: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1467: var banner_link = '';
1.243 raeburn 1468: function helpMenu(target) {
1469: var caller = this;
1470: if (target == 'open') {
1471: var newWindow = null;
1472: try {
1.262 albertel 1473: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1474: }
1475: catch(error) {
1476: writeHelp(caller);
1477: return;
1478: }
1479: if (newWindow) {
1480: caller = newWindow;
1481: }
1.193 raeburn 1482: }
1.243 raeburn 1483: writeHelp(caller);
1484: return;
1485: }
1486: function writeHelp(caller) {
1.1168 raeburn 1487: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1488: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1489: caller.document.close();
1490: caller.focus();
1.193 raeburn 1491: }
1.877 bisitz 1492: // END LON-CAPA Internal -->
1.253 albertel 1493: // ]]>
1.436 albertel 1494: </script>
1.193 raeburn 1495: ENDTEMPLATE
1496: return $template;
1497: }
1498:
1.172 www 1499: sub help_open_bug {
1500: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1501: unless ($env{'user.adv'}) { return ''; }
1.172 www 1502: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1503: $text = "" if (not defined $text);
1504: $stayOnPage=1;
1.184 albertel 1505: $width = 600 if (not defined $width);
1506: $height = 600 if (not defined $height);
1.172 www 1507:
1508: $topic=~s/\W+/\+/g;
1509: my $link='';
1510: my $template='';
1.379 albertel 1511: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1512: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1513: if (!$stayOnPage)
1514: {
1515: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1516: }
1517: else
1518: {
1519: $link = $url;
1520: }
1.1314 raeburn 1521:
1522: my $target = ' target="_top"';
1523: if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1524: $target = '';
1525: }
1.1378 ! raeburn 1526: if (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
! 1527: $target = ' target="'.$env{'request.deeplink.target'}.'"';
! 1528: }
1.172 www 1529: # Add the text
1530: if ($text ne "")
1531: {
1532: $template .=
1533: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1314 raeburn 1534: "<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1535: }
1536:
1537: # Add the graphic
1.179 matthew 1538: my $title = &mt('Report a Bug');
1.215 albertel 1539: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1540: $template .= <<"ENDTEMPLATE";
1.1314 raeburn 1541: <a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1542: ENDTEMPLATE
1543: if ($text ne '') { $template.='</td></tr></table>' };
1544: return $template;
1545:
1546: }
1547:
1548: sub help_open_faq {
1549: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1550: unless ($env{'user.adv'}) { return ''; }
1.172 www 1551: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1552: $text = "" if (not defined $text);
1553: $stayOnPage=1;
1554: $width = 350 if (not defined $width);
1555: $height = 400 if (not defined $height);
1556:
1557: $topic=~s/\W+/\+/g;
1558: my $link='';
1559: my $template='';
1560: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1561: if (!$stayOnPage)
1562: {
1563: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1564: }
1565: else
1566: {
1567: $link = $url;
1568: }
1569:
1570: # Add the text
1571: if ($text ne "")
1572: {
1573: $template .=
1.173 www 1574: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1575: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1576: }
1577:
1578: # Add the graphic
1.179 matthew 1579: my $title = &mt('View the FAQ');
1.215 albertel 1580: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1581: $template .= <<"ENDTEMPLATE";
1.436 albertel 1582: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1583: ENDTEMPLATE
1584: if ($text ne '') { $template.='</td></tr></table>' };
1585: return $template;
1586:
1.44 bowersj2 1587: }
1.37 matthew 1588:
1.180 matthew 1589: ###############################################################
1590: ###############################################################
1591:
1.45 matthew 1592: =pod
1593:
1.648 raeburn 1594: =item * &change_content_javascript():
1.256 matthew 1595:
1596: This and the next function allow you to create small sections of an
1597: otherwise static HTML page that you can update on the fly with
1598: Javascript, even in Netscape 4.
1599:
1600: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1601: must be written to the HTML page once. It will prove the Javascript
1602: function "change(name, content)". Calling the change function with the
1603: name of the section
1604: you want to update, matching the name passed to C<changable_area>, and
1605: the new content you want to put in there, will put the content into
1606: that area.
1607:
1608: B<Note>: Netscape 4 only reserves enough space for the changable area
1609: to contain room for the original contents. You need to "make space"
1610: for whatever changes you wish to make, and be B<sure> to check your
1611: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1612: it's adequate for updating a one-line status display, but little more.
1613: This script will set the space to 100% width, so you only need to
1614: worry about height in Netscape 4.
1615:
1616: Modern browsers are much less limiting, and if you can commit to the
1617: user not using Netscape 4, this feature may be used freely with
1618: pretty much any HTML.
1619:
1620: =cut
1621:
1622: sub change_content_javascript {
1623: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1624: if ($env{'browser.type'} eq 'netscape' &&
1625: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1626: return (<<NETSCAPE4);
1627: function change(name, content) {
1628: doc = document.layers[name+"___escape"].layers[0].document;
1629: doc.open();
1630: doc.write(content);
1631: doc.close();
1632: }
1633: NETSCAPE4
1634: } else {
1635: # Otherwise, we need to use semi-standards-compliant code
1636: # (technically, "innerHTML" isn't standard but the equivalent
1637: # is really scary, and every useful browser supports it
1638: return (<<DOMBASED);
1639: function change(name, content) {
1640: element = document.getElementById(name);
1641: element.innerHTML = content;
1642: }
1643: DOMBASED
1644: }
1645: }
1646:
1647: =pod
1648:
1.648 raeburn 1649: =item * &changable_area($name,$origContent):
1.256 matthew 1650:
1651: This provides a "changable area" that can be modified on the fly via
1652: the Javascript code provided in C<change_content_javascript>. $name is
1653: the name you will use to reference the area later; do not repeat the
1654: same name on a given HTML page more then once. $origContent is what
1655: the area will originally contain, which can be left blank.
1656:
1657: =cut
1658:
1659: sub changable_area {
1660: my ($name, $origContent) = @_;
1661:
1.258 albertel 1662: if ($env{'browser.type'} eq 'netscape' &&
1663: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1664: # If this is netscape 4, we need to use the Layer tag
1665: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1666: } else {
1667: return "<span id='$name'>$origContent</span>";
1668: }
1669: }
1670:
1671: =pod
1672:
1.648 raeburn 1673: =item * &viewport_geometry_js
1.590 raeburn 1674:
1675: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1676:
1677: =cut
1678:
1679:
1680: sub viewport_geometry_js {
1681: return <<"GEOMETRY";
1682: var Geometry = {};
1683: function init_geometry() {
1684: if (Geometry.init) { return };
1685: Geometry.init=1;
1686: if (window.innerHeight) {
1687: Geometry.getViewportHeight = function() { return window.innerHeight; };
1688: Geometry.getViewportWidth = function() { return window.innerWidth; };
1689: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1690: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1691: }
1692: else if (document.documentElement && document.documentElement.clientHeight) {
1693: Geometry.getViewportHeight =
1694: function() { return document.documentElement.clientHeight; };
1695: Geometry.getViewportWidth =
1696: function() { return document.documentElement.clientWidth; };
1697:
1698: Geometry.getHorizontalScroll =
1699: function() { return document.documentElement.scrollLeft; };
1700: Geometry.getVerticalScroll =
1701: function() { return document.documentElement.scrollTop; };
1702: }
1703: else if (document.body.clientHeight) {
1704: Geometry.getViewportHeight =
1705: function() { return document.body.clientHeight; };
1706: Geometry.getViewportWidth =
1707: function() { return document.body.clientWidth; };
1708: Geometry.getHorizontalScroll =
1709: function() { return document.body.scrollLeft; };
1710: Geometry.getVerticalScroll =
1711: function() { return document.body.scrollTop; };
1712: }
1713: }
1714:
1715: GEOMETRY
1716: }
1717:
1718: =pod
1719:
1.648 raeburn 1720: =item * &viewport_size_js()
1.590 raeburn 1721:
1722: 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.
1723:
1724: =cut
1725:
1726: sub viewport_size_js {
1727: my $geometry = &viewport_geometry_js();
1728: return <<"DIMS";
1729:
1730: $geometry
1731:
1732: function getViewportDims(width,height) {
1733: init_geometry();
1734: width.value = Geometry.getViewportWidth();
1735: height.value = Geometry.getViewportHeight();
1736: return;
1737: }
1738:
1739: DIMS
1740: }
1741:
1742: =pod
1743:
1.648 raeburn 1744: =item * &resize_textarea_js()
1.565 albertel 1745:
1746: emits the needed javascript to resize a textarea to be as big as possible
1747:
1748: creates a function resize_textrea that takes two IDs first should be
1749: the id of the element to resize, second should be the id of a div that
1750: surrounds everything that comes after the textarea, this routine needs
1751: to be attached to the <body> for the onload and onresize events.
1752:
1.648 raeburn 1753: =back
1.565 albertel 1754:
1755: =cut
1756:
1757: sub resize_textarea_js {
1.590 raeburn 1758: my $geometry = &viewport_geometry_js();
1.565 albertel 1759: return <<"RESIZE";
1760: <script type="text/javascript">
1.824 bisitz 1761: // <![CDATA[
1.590 raeburn 1762: $geometry
1.565 albertel 1763:
1.588 albertel 1764: function getX(element) {
1765: var x = 0;
1766: while (element) {
1767: x += element.offsetLeft;
1768: element = element.offsetParent;
1769: }
1770: return x;
1771: }
1772: function getY(element) {
1773: var y = 0;
1774: while (element) {
1775: y += element.offsetTop;
1776: element = element.offsetParent;
1777: }
1778: return y;
1779: }
1780:
1781:
1.565 albertel 1782: function resize_textarea(textarea_id,bottom_id) {
1783: init_geometry();
1784: var textarea = document.getElementById(textarea_id);
1785: //alert(textarea);
1786:
1.588 albertel 1787: var textarea_top = getY(textarea);
1.565 albertel 1788: var textarea_height = textarea.offsetHeight;
1789: var bottom = document.getElementById(bottom_id);
1.588 albertel 1790: var bottom_top = getY(bottom);
1.565 albertel 1791: var bottom_height = bottom.offsetHeight;
1792: var window_height = Geometry.getViewportHeight();
1.588 albertel 1793: var fudge = 23;
1.565 albertel 1794: var new_height = window_height-fudge-textarea_top-bottom_height;
1795: if (new_height < 300) {
1796: new_height = 300;
1797: }
1798: textarea.style.height=new_height+'px';
1799: }
1.824 bisitz 1800: // ]]>
1.565 albertel 1801: </script>
1802: RESIZE
1803:
1804: }
1805:
1.1205 golterma 1806: sub colorfuleditor_js {
1.1248 raeburn 1807: my $browse_or_search;
1808: my $respath;
1809: my ($cnum,$cdom) = &crsauthor_url();
1810: if ($cnum) {
1811: $respath = "/res/$cdom/$cnum/";
1812: my %js_lt = &Apache::lonlocal::texthash(
1813: sunm => 'Sub-directory name',
1814: save => 'Save page to make this permanent',
1815: );
1816: &js_escape(\%js_lt);
1817: $browse_or_search = <<"END";
1818:
1819: function toggleChooser(form,element,titleid,only,search) {
1820: var disp = 'none';
1821: if (document.getElementById('chooser_'+element)) {
1822: var curr = document.getElementById('chooser_'+element).style.display;
1823: if (curr == 'none') {
1824: disp='inline';
1825: if (form.elements['chooser_'+element].length) {
1826: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1827: form.elements['chooser_'+element][i].checked = false;
1828: }
1829: }
1830: toggleResImport(form,element);
1831: }
1832: document.getElementById('chooser_'+element).style.display = disp;
1833: }
1834: }
1835:
1836: function toggleCrsFile(form,element,numdirs) {
1837: if (document.getElementById('chooser_'+element+'_crsres')) {
1838: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1839: if (curr == 'none') {
1840: if (numdirs) {
1841: form.elements['coursepath_'+element].selectedIndex = 0;
1842: if (numdirs > 1) {
1843: window['select1'+element+'_changed']();
1844: }
1845: }
1846: }
1847: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1848:
1849: }
1850: if (document.getElementById('chooser_'+element+'_upload')) {
1851: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1852: if (document.getElementById('uploadcrsres_'+element)) {
1853: document.getElementById('uploadcrsres_'+element).value = '';
1854: }
1855: }
1856: return;
1857: }
1858:
1859: function toggleCrsUpload(form,element,numcrsdirs) {
1860: if (document.getElementById('chooser_'+element+'_crsres')) {
1861: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1862: }
1863: if (document.getElementById('chooser_'+element+'_upload')) {
1864: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1865: if (curr == 'none') {
1866: if (numcrsdirs) {
1867: form.elements['crsauthorpath_'+element].selectedIndex = 0;
1868: form.elements['newsubdir_'+element][0].checked = true;
1869: toggleNewsubdir(form,element);
1870: }
1871: }
1872: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1873: }
1874: return;
1875: }
1876:
1877: function toggleResImport(form,element) {
1878: var choices = new Array('crsres','upload');
1879: for (var i=0; i<choices.length; i++) {
1880: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1881: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1882: }
1883: }
1884: }
1885:
1886: function toggleNewsubdir(form,element) {
1887: var newsub = form.elements['newsubdir_'+element];
1888: if (newsub) {
1889: if (newsub.length) {
1890: for (var j=0; j<newsub.length; j++) {
1891: if (newsub[j].checked) {
1892: if (document.getElementById('newsubdirname_'+element)) {
1893: if (newsub[j].value == '1') {
1894: document.getElementById('newsubdirname_'+element).type = "text";
1895: if (document.getElementById('newsubdir_'+element)) {
1896: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1897: }
1898: } else {
1899: document.getElementById('newsubdirname_'+element).type = "hidden";
1900: document.getElementById('newsubdirname_'+element).value = "";
1901: document.getElementById('newsubdir_'+element).innerHTML = "";
1902: }
1903: }
1904: break;
1905: }
1906: }
1907: }
1908: }
1909: }
1910:
1911: function updateCrsFile(form,element) {
1912: var directory = form.elements['coursepath_'+element];
1913: var filename = form.elements['coursefile_'+element];
1914: var path = directory.options[directory.selectedIndex].value;
1915: var file = filename.options[filename.selectedIndex].value;
1916: form.elements[element].value = '$respath';
1917: if (path == '/') {
1918: form.elements[element].value += file;
1919: } else {
1920: form.elements[element].value += path+'/'+file;
1921: }
1922: unClean();
1923: if (document.getElementById('previewimg_'+element)) {
1924: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1925: var newsrc = document.getElementById('previewimg_'+element).src;
1926: }
1927: if (document.getElementById('showimg_'+element)) {
1928: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1929: }
1930: toggleChooser(form,element);
1931: return;
1932: }
1933:
1934: function uploadDone(suffix,name) {
1935: if (name) {
1936: document.forms["lonhomework"].elements[suffix].value = name;
1937: unClean();
1938: toggleChooser(document.forms["lonhomework"],suffix);
1939: }
1940: }
1941:
1942: \$(document).ready(function(){
1943:
1944: \$(document).delegate('form :submit', 'click', function( event ) {
1945: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
1946: var buttonId = this.id;
1947: var suffix = buttonId.toString();
1948: suffix = suffix.replace(/^crsupload_/,'');
1949: event.preventDefault();
1950: document.lonhomework.target = 'crsupload_target_'+suffix;
1951: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
1952: \$(this.form).submit();
1953: document.lonhomework.target = '';
1954: if (document.getElementById('crsuploadto_'+suffix)) {
1955: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
1956: }
1957: return false;
1958: }
1959: });
1960: });
1961: END
1962: }
1.1205 golterma 1963: return <<"COLORFULEDIT"
1964: <script type="text/javascript">
1965: // <![CDATA[>
1966: function fold_box(curDepth, lastresource){
1967:
1968: // we need a list because there can be several blocks you need to fold in one tag
1969: var block = document.getElementsByName('foldblock_'+curDepth);
1970: // but there is only one folding button per tag
1971: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1972:
1973: if(block.item(0).style.display == 'none'){
1974:
1975: foldbutton.value = '@{[&mt("Hide")]}';
1976: for (i = 0; i < block.length; i++){
1977: block.item(i).style.display = '';
1978: }
1979: }else{
1980:
1981: foldbutton.value = '@{[&mt("Show")]}';
1982: for (i = 0; i < block.length; i++){
1983: // block.item(i).style.visibility = 'collapse';
1984: block.item(i).style.display = 'none';
1985: }
1986: };
1987: saveState(lastresource);
1988: }
1989:
1990: function saveState (lastresource) {
1991:
1992: var tag_list = getTagList();
1993: if(tag_list != null){
1994: var timestamp = new Date().getTime();
1995: var key = lastresource;
1996:
1997: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1998: // starting with timestamp
1999: var value = timestamp+';';
2000:
2001: // building the list of key-value pairs
2002: for(var i = 0; i < tag_list.length; i++){
2003: value += tag_list[i]+',';
2004: value += document.getElementsByName(tag_list[i])[0].style.display+';';
2005: }
2006:
2007: // only iterate whole storage if nothing to override
2008: if(localStorage.getItem(key) == null){
2009:
2010: // prevent storage from growing large
2011: if(localStorage.length > 50){
2012: var regex_getTimestamp = /^(?:\d)+;/;
2013: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
2014: var oldest_key;
2015:
2016: for(var i = 1; i < localStorage.length; i++){
2017: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
2018: oldest_key = localStorage.key(i);
2019: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
2020: }
2021: }
2022: localStorage.removeItem(oldest_key);
2023: }
2024: }
2025: localStorage.setItem(key,value);
2026: }
2027: }
2028:
2029: // restore folding status of blocks (on page load)
2030: function restoreState (lastresource) {
2031: if(localStorage.getItem(lastresource) != null){
2032: var key = lastresource;
2033: var value = localStorage.getItem(key);
2034: var regex_delTimestamp = /^\d+;/;
2035:
2036: value.replace(regex_delTimestamp, '');
2037:
2038: var valueArr = value.split(';');
2039: var pairs;
2040: var elements;
2041: for (var i = 0; i < valueArr.length; i++){
2042: pairs = valueArr[i].split(',');
2043: elements = document.getElementsByName(pairs[0]);
2044:
2045: for (var j = 0; j < elements.length; j++){
2046: elements[j].style.display = pairs[1];
2047: if (pairs[1] == "none"){
2048: var regex_id = /([_\\d]+)\$/;
2049: regex_id.exec(pairs[0]);
2050: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2051: }
2052: }
2053: }
2054: }
2055: }
2056:
2057: function getTagList () {
2058:
2059: var stringToSearch = document.lonhomework.innerHTML;
2060:
2061: var ret = new Array();
2062: var regex_findBlock = /(foldblock_.*?)"/g;
2063: var tag_list = stringToSearch.match(regex_findBlock);
2064:
2065: if(tag_list != null){
2066: for(var i = 0; i < tag_list.length; i++){
2067: ret.push(tag_list[i].replace(/"/, ''));
2068: }
2069: }
2070: return ret;
2071: }
2072:
2073: function saveScrollPosition (resource) {
2074: var tag_list = getTagList();
2075:
2076: // we dont always want to jump to the first block
2077: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2078: if(\$(window).scrollTop() > 170){
2079: if(tag_list != null){
2080: var result;
2081: for(var i = 0; i < tag_list.length; i++){
2082: if(isElementInViewport(tag_list[i])){
2083: result += tag_list[i]+';';
2084: }
2085: }
2086: sessionStorage.setItem('anchor_'+resource, result);
2087: }
2088: } else {
2089: // we dont need to save zero, just delete the item to leave everything tidy
2090: sessionStorage.removeItem('anchor_'+resource);
2091: }
2092: }
2093:
2094: function restoreScrollPosition(resource){
2095:
2096: var elem = sessionStorage.getItem('anchor_'+resource);
2097: if(elem != null){
2098: var tag_list = elem.split(';');
2099: var elem_list;
2100:
2101: for(var i = 0; i < tag_list.length; i++){
2102: elem_list = document.getElementsByName(tag_list[i]);
2103:
2104: if(elem_list.length > 0){
2105: elem = elem_list[0];
2106: break;
2107: }
2108: }
2109: elem.scrollIntoView();
2110: }
2111: }
2112:
2113: function isElementInViewport(el) {
2114:
2115: // change to last element instead of first
2116: var elem = document.getElementsByName(el);
2117: var rect = elem[0].getBoundingClientRect();
2118:
2119: return (
2120: rect.top >= 0 &&
2121: rect.left >= 0 &&
2122: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2123: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2124: );
2125: }
2126:
2127: function autosize(depth){
2128: var cmInst = window['cm'+depth];
2129: var fitsizeButton = document.getElementById('fitsize'+depth);
2130:
2131: // is fixed size, switching to dynamic
2132: if (sessionStorage.getItem("autosized_"+depth) == null) {
2133: cmInst.setSize("","auto");
2134: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2135: sessionStorage.setItem("autosized_"+depth, "yes");
2136:
2137: // is dynamic size, switching to fixed
2138: } else {
2139: cmInst.setSize("","300px");
2140: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2141: sessionStorage.removeItem("autosized_"+depth);
2142: }
2143: }
2144:
1.1248 raeburn 2145: $browse_or_search
1.1205 golterma 2146:
2147: // ]]>
2148: </script>
2149: COLORFULEDIT
2150: }
2151:
2152: sub xmleditor_js {
2153: return <<XMLEDIT
2154: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2155: <script type="text/javascript">
2156: // <![CDATA[>
2157:
2158: function saveScrollPosition (resource) {
2159:
2160: var scrollPos = \$(window).scrollTop();
2161: sessionStorage.setItem(resource,scrollPos);
2162: }
2163:
2164: function restoreScrollPosition(resource){
2165:
2166: var scrollPos = sessionStorage.getItem(resource);
2167: \$(window).scrollTop(scrollPos);
2168: }
2169:
2170: // unless internet explorer
2171: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2172:
2173: \$(document).ready(function() {
2174: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2175: });
2176: }
2177:
2178: // inserts text at cursor position into codemirror (xml editor only)
2179: function insertText(text){
2180: cm.focus();
2181: var curPos = cm.getCursor();
2182: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2183: }
2184: // ]]>
2185: </script>
2186: XMLEDIT
2187: }
2188:
2189: sub insert_folding_button {
2190: my $curDepth = $Apache::lonxml::curdepth;
2191: my $lastresource = $env{'request.ambiguous'};
2192:
2193: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2194: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2195: }
2196:
1.1248 raeburn 2197: sub crsauthor_url {
2198: my ($url) = @_;
2199: if ($url eq '') {
2200: $url = $ENV{'REQUEST_URI'};
2201: }
2202: my ($cnum,$cdom);
2203: if ($env{'request.course.id'}) {
2204: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2205: if ($audom ne '' && $auname ne '') {
2206: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2207: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2208: $cnum = $auname;
2209: $cdom = $audom;
2210: }
2211: }
2212: }
2213: return ($cnum,$cdom);
2214: }
2215:
2216: sub import_crsauthor_form {
1.1265 raeburn 2217: my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248 raeburn 2218: return (0) unless ($env{'request.course.id'});
2219: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2220: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2221: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2222: return (0) unless (($cnum ne '') && ($cdom ne ''));
2223: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
2224: my @ids=&Apache::lonnet::current_machine_ids();
2225: my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
2226:
2227: if (grep(/^\Q$crshome\E$/,@ids)) {
2228: $is_home = 1;
2229: }
2230: $relpath = "/priv/$cdom/$cnum";
2231: &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
2232: my %lt = &Apache::lonlocal::texthash (
2233: fnam => 'Filename',
2234: dire => 'Directory',
2235: );
2236: my $numdirs = scalar(keys(%files));
2237: my (%possexts,$singledir,@singledirfiles);
2238: if ($only) {
2239: map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
2240: }
2241: my (%nonemptydirs,$possdirs);
2242: if ($numdirs > 1) {
2243: my @order;
2244: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
2245: if (ref($files{$key}) eq 'HASH') {
2246: my $shown = $key;
2247: if ($key eq '') {
2248: $shown = '/';
2249: }
2250: my @ordered = ();
2251: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
1.1315 raeburn 2252: next if ($file =~ /\.rights$/);
1.1248 raeburn 2253: if ($only) {
2254: my ($ext) = ($file =~ /\.([^.]+)$/);
2255: unless ($possexts{lc($ext)}) {
2256: next;
2257: }
2258: }
2259: $selimport_menus{$key}->{'select2'}->{$file} = $file;
2260: push(@ordered,$file);
2261: }
2262: if (@ordered) {
2263: push(@order,$key);
2264: $nonemptydirs{$key} = 1;
2265: $selimport_menus{$key}->{'text'} = $shown;
2266: $selimport_menus{$key}->{'default'} = '';
2267: $selimport_menus{$key}->{'select2'}->{''} = '';
2268: $selimport_menus{$key}->{'order'} = \@ordered;
2269: }
2270: }
2271: }
2272: $possdirs = scalar(keys(%nonemptydirs));
2273: if ($possdirs > 1) {
2274: my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
2275: $output = $lt{'dire'}.
2276: &linked_select_forms($form,'<br />'.
2277: $lt{'fnam'},'',
2278: $firstselectname,$secondselectname,
2279: \%selimport_menus,\@order,
2280: $onchangefirst,'',$suffix).'<br />';
2281: } elsif ($possdirs == 1) {
2282: $singledir = (keys(%nonemptydirs))[0];
2283: if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
2284: @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
2285: }
2286: delete($selimport_menus{$singledir});
2287: }
2288: } elsif ($numdirs == 1) {
2289: $singledir = (keys(%files))[0];
2290: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
2291: if ($only) {
2292: my ($ext) = ($file =~ /\.([^.]+)$/);
2293: unless ($possexts{lc($ext)}) {
2294: next;
2295: }
1.1315 raeburn 2296: } else {
2297: next if ($file =~ /\.rights$/);
1.1248 raeburn 2298: }
2299: push(@singledirfiles,$file);
2300: }
2301: if (@singledirfiles) {
1.1315 raeburn 2302: $possdirs = 1;
1.1248 raeburn 2303: }
2304: }
2305: if (($possdirs == 1) && (@singledirfiles)) {
2306: my $showdir = $singledir;
2307: if ($singledir eq '') {
2308: $showdir = '/';
2309: }
2310: $output = $lt{'dire'}.
2311: '<select name="'.$firstselectname.'">'.
2312: '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
2313: '</select><br />'.
2314: $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
2315: '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
2316: foreach my $file (@singledirfiles) {
2317: $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
2318: }
2319: $output .= '</select><br />'."\n";
2320: }
2321: return ($possdirs,$output);
2322: }
2323:
1.565 albertel 2324: =pod
2325:
1.256 matthew 2326: =head1 Excel and CSV file utility routines
2327:
2328: =cut
2329:
2330: ###############################################################
2331: ###############################################################
2332:
2333: =pod
2334:
1.1162 raeburn 2335: =over 4
2336:
1.648 raeburn 2337: =item * &csv_translate($text)
1.37 matthew 2338:
1.185 www 2339: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2340: format.
2341:
2342: =cut
2343:
1.180 matthew 2344: ###############################################################
2345: ###############################################################
1.37 matthew 2346: sub csv_translate {
2347: my $text = shift;
2348: $text =~ s/\"/\"\"/g;
1.209 albertel 2349: $text =~ s/\n/ /g;
1.37 matthew 2350: return $text;
2351: }
1.180 matthew 2352:
2353: ###############################################################
2354: ###############################################################
2355:
2356: =pod
2357:
1.648 raeburn 2358: =item * &define_excel_formats()
1.180 matthew 2359:
2360: Define some commonly used Excel cell formats.
2361:
2362: Currently supported formats:
2363:
2364: =over 4
2365:
2366: =item header
2367:
2368: =item bold
2369:
2370: =item h1
2371:
2372: =item h2
2373:
2374: =item h3
2375:
1.256 matthew 2376: =item h4
2377:
2378: =item i
2379:
1.180 matthew 2380: =item date
2381:
2382: =back
2383:
2384: Inputs: $workbook
2385:
2386: Returns: $format, a hash reference.
2387:
1.1057 foxr 2388:
1.180 matthew 2389: =cut
2390:
2391: ###############################################################
2392: ###############################################################
2393: sub define_excel_formats {
2394: my ($workbook) = @_;
2395: my $format;
2396: $format->{'header'} = $workbook->add_format(bold => 1,
2397: bottom => 1,
2398: align => 'center');
2399: $format->{'bold'} = $workbook->add_format(bold=>1);
2400: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2401: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2402: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2403: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2404: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2405: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2406: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2407: return $format;
2408: }
2409:
2410: ###############################################################
2411: ###############################################################
1.113 bowersj2 2412:
2413: =pod
2414:
1.648 raeburn 2415: =item * &create_workbook()
1.255 matthew 2416:
2417: Create an Excel worksheet. If it fails, output message on the
2418: request object and return undefs.
2419:
2420: Inputs: Apache request object
2421:
2422: Returns (undef) on failure,
2423: Excel worksheet object, scalar with filename, and formats
2424: from &Apache::loncommon::define_excel_formats on success
2425:
2426: =cut
2427:
2428: ###############################################################
2429: ###############################################################
2430: sub create_workbook {
2431: my ($r) = @_;
2432: #
2433: # Create the excel spreadsheet
2434: my $filename = '/prtspool/'.
1.258 albertel 2435: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2436: time.'_'.rand(1000000000).'.xls';
2437: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2438: if (! defined($workbook)) {
2439: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2440: $r->print(
2441: '<p class="LC_error">'
2442: .&mt('Problems occurred in creating the new Excel file.')
2443: .' '.&mt('This error has been logged.')
2444: .' '.&mt('Please alert your LON-CAPA administrator.')
2445: .'</p>'
2446: );
1.255 matthew 2447: return (undef);
2448: }
2449: #
1.1014 foxr 2450: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2451: #
2452: my $format = &Apache::loncommon::define_excel_formats($workbook);
2453: return ($workbook,$filename,$format);
2454: }
2455:
2456: ###############################################################
2457: ###############################################################
2458:
2459: =pod
2460:
1.648 raeburn 2461: =item * &create_text_file()
1.113 bowersj2 2462:
1.542 raeburn 2463: Create a file to write to and eventually make available to the user.
1.256 matthew 2464: If file creation fails, outputs an error message on the request object and
2465: return undefs.
1.113 bowersj2 2466:
1.256 matthew 2467: Inputs: Apache request object, and file suffix
1.113 bowersj2 2468:
1.256 matthew 2469: Returns (undef) on failure,
2470: Filehandle and filename on success.
1.113 bowersj2 2471:
2472: =cut
2473:
1.256 matthew 2474: ###############################################################
2475: ###############################################################
2476: sub create_text_file {
2477: my ($r,$suffix) = @_;
2478: if (! defined($suffix)) { $suffix = 'txt'; };
2479: my $fh;
2480: my $filename = '/prtspool/'.
1.258 albertel 2481: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2482: time.'_'.rand(1000000000).'.'.$suffix;
2483: $fh = Apache::File->new('>/home/httpd'.$filename);
2484: if (! defined($fh)) {
2485: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2486: $r->print(
2487: '<p class="LC_error">'
2488: .&mt('Problems occurred in creating the output file.')
2489: .' '.&mt('This error has been logged.')
2490: .' '.&mt('Please alert your LON-CAPA administrator.')
2491: .'</p>'
2492: );
1.113 bowersj2 2493: }
1.256 matthew 2494: return ($fh,$filename)
1.113 bowersj2 2495: }
2496:
2497:
1.256 matthew 2498: =pod
1.113 bowersj2 2499:
2500: =back
2501:
2502: =cut
1.37 matthew 2503:
2504: ###############################################################
1.33 matthew 2505: ## Home server <option> list generating code ##
2506: ###############################################################
1.35 matthew 2507:
1.169 www 2508: # ------------------------------------------
2509:
2510: sub domain_select {
1.1289 raeburn 2511: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
2512: my @possdoms;
2513: if (ref($incdoms) eq 'ARRAY') {
2514: @possdoms = @{$incdoms};
2515: } else {
2516: @possdoms = &Apache::lonnet::all_domains();
2517: }
2518:
1.169 www 2519: my %domains=map {
1.514 albertel 2520: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 raeburn 2521: } @possdoms;
2522:
2523: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
2524: foreach my $dom (@{$excdoms}) {
2525: delete($domains{$dom});
2526: }
2527: }
2528:
1.169 www 2529: if ($multiple) {
2530: $domains{''}=&mt('Any domain');
1.550 albertel 2531: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2532: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2533: } else {
1.550 albertel 2534: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2535: return &select_form($name,$value,\%domains);
1.169 www 2536: }
2537: }
2538:
1.282 albertel 2539: #-------------------------------------------
2540:
2541: =pod
2542:
1.519 raeburn 2543: =head1 Routines for form select boxes
2544:
2545: =over 4
2546:
1.648 raeburn 2547: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2548:
2549: Returns a string containing a <select> element int multiple mode
2550:
2551:
2552: Args:
2553: $name - name of the <select> element
1.506 raeburn 2554: $value - scalar or array ref of values that should already be selected
1.282 albertel 2555: $size - number of rows long the select element is
1.283 albertel 2556: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2557: (shown text should already have been &mt())
1.506 raeburn 2558: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2559:
1.282 albertel 2560: =cut
2561:
2562: #-------------------------------------------
1.169 www 2563: sub multiple_select_form {
1.284 albertel 2564: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2565: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2566: my $output='';
1.191 matthew 2567: if (! defined($size)) {
2568: $size = 4;
1.283 albertel 2569: if (scalar(keys(%$hash))<4) {
2570: $size = scalar(keys(%$hash));
1.191 matthew 2571: }
2572: }
1.734 bisitz 2573: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2574: my @order;
1.506 raeburn 2575: if (ref($order) eq 'ARRAY') {
2576: @order = @{$order};
2577: } else {
2578: @order = sort(keys(%$hash));
1.501 banghart 2579: }
2580: if (exists($$hash{'select_form_order'})) {
2581: @order = @{$$hash{'select_form_order'}};
2582: }
2583:
1.284 albertel 2584: foreach my $key (@order) {
1.356 albertel 2585: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2586: $output.='selected="selected" ' if ($selected{$key});
2587: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2588: }
2589: $output.="</select>\n";
2590: return $output;
2591: }
2592:
1.88 www 2593: #-------------------------------------------
2594:
2595: =pod
2596:
1.1254 raeburn 2597: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2598:
2599: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2600: allow a user to select options from a ref to a hash containing:
2601: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2602: a javascript onchange item, e.g., onchange="this.form.submit();".
2603: An optional arg -- $readonly -- if true will cause the select form
2604: to be disabled, e.g., for the case where an instructor has a section-
2605: specific role, and is viewing/modifying parameters.
1.970 raeburn 2606:
1.88 www 2607: See lonrights.pm for an example invocation and use.
2608:
2609: =cut
2610:
2611: #-------------------------------------------
2612: sub select_form {
1.1228 raeburn 2613: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2614: return unless (ref($hashref) eq 'HASH');
2615: if ($onchange) {
2616: $onchange = ' onchange="'.$onchange.'"';
2617: }
1.1228 raeburn 2618: my $disabled;
2619: if ($readonly) {
2620: $disabled = ' disabled="disabled"';
2621: }
2622: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2623: my @keys;
1.970 raeburn 2624: if (exists($hashref->{'select_form_order'})) {
2625: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2626: } else {
1.970 raeburn 2627: @keys=sort(keys(%{$hashref}));
1.128 albertel 2628: }
1.356 albertel 2629: foreach my $key (@keys) {
2630: $selectform.=
2631: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2632: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2633: ">".$hashref->{$key}."</option>\n";
1.88 www 2634: }
2635: $selectform.="</select>";
2636: return $selectform;
2637: }
2638:
1.475 www 2639: # For display filters
2640:
2641: sub display_filter {
1.1074 raeburn 2642: my ($context) = @_;
1.475 www 2643: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2644: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2645: my $phraseinput = 'hidden';
2646: my $includeinput = 'hidden';
2647: my ($checked,$includetypestext);
2648: if ($env{'form.displayfilter'} eq 'containing') {
2649: $phraseinput = 'text';
2650: if ($context eq 'parmslog') {
2651: $includeinput = 'checkbox';
2652: if ($env{'form.includetypes'}) {
2653: $checked = ' checked="checked"';
2654: }
2655: $includetypestext = &mt('Include parameter types');
2656: }
2657: } else {
2658: $includetypestext = ' ';
2659: }
2660: my ($additional,$secondid,$thirdid);
2661: if ($context eq 'parmslog') {
2662: $additional =
2663: '<label><input type="'.$includeinput.'" name="includetypes"'.
2664: $checked.' name="includetypes" value="1" id="includetypes" />'.
2665: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2666: '</label>';
2667: $secondid = 'includetypes';
2668: $thirdid = 'includetypestext';
2669: }
2670: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2671: '$secondid','$thirdid')";
2672: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2673: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2674: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2675: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2676: &mt('Filter: [_1]',
1.477 www 2677: &select_form($env{'form.displayfilter'},
2678: 'displayfilter',
1.970 raeburn 2679: {'currentfolder' => 'Current folder/page',
1.477 www 2680: 'containing' => 'Containing phrase',
1.1074 raeburn 2681: 'none' => 'None'},$onchange)).' '.
2682: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2683: &HTML::Entities::encode($env{'form.containingphrase'}).
2684: '" />'.$additional;
2685: }
2686:
2687: sub display_filter_js {
2688: my $includetext = &mt('Include parameter types');
2689: return <<"ENDJS";
2690:
2691: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2692: var firstType = 'hidden';
2693: if (setter.options[setter.selectedIndex].value == 'containing') {
2694: firstType = 'text';
2695: }
2696: firstObject = document.getElementById(firstid);
2697: if (typeof(firstObject) == 'object') {
2698: if (firstObject.type != firstType) {
2699: changeInputType(firstObject,firstType);
2700: }
2701: }
2702: if (context == 'parmslog') {
2703: var secondType = 'hidden';
2704: if (firstType == 'text') {
2705: secondType = 'checkbox';
2706: }
2707: secondObject = document.getElementById(secondid);
2708: if (typeof(secondObject) == 'object') {
2709: if (secondObject.type != secondType) {
2710: changeInputType(secondObject,secondType);
2711: }
2712: }
2713: var textItem = document.getElementById(thirdid);
2714: var currtext = textItem.innerHTML;
2715: var newtext;
2716: if (firstType == 'text') {
2717: newtext = '$includetext';
2718: } else {
2719: newtext = ' ';
2720: }
2721: if (currtext != newtext) {
2722: textItem.innerHTML = newtext;
2723: }
2724: }
2725: return;
2726: }
2727:
2728: function changeInputType(oldObject,newType) {
2729: var newObject = document.createElement('input');
2730: newObject.type = newType;
2731: if (oldObject.size) {
2732: newObject.size = oldObject.size;
2733: }
2734: if (oldObject.value) {
2735: newObject.value = oldObject.value;
2736: }
2737: if (oldObject.name) {
2738: newObject.name = oldObject.name;
2739: }
2740: if (oldObject.id) {
2741: newObject.id = oldObject.id;
2742: }
2743: oldObject.parentNode.replaceChild(newObject,oldObject);
2744: return;
2745: }
2746:
2747: ENDJS
1.475 www 2748: }
2749:
1.167 www 2750: sub gradeleveldescription {
2751: my $gradelevel=shift;
2752: my %gradelevels=(0 => 'Not specified',
2753: 1 => 'Grade 1',
2754: 2 => 'Grade 2',
2755: 3 => 'Grade 3',
2756: 4 => 'Grade 4',
2757: 5 => 'Grade 5',
2758: 6 => 'Grade 6',
2759: 7 => 'Grade 7',
2760: 8 => 'Grade 8',
2761: 9 => 'Grade 9',
2762: 10 => 'Grade 10',
2763: 11 => 'Grade 11',
2764: 12 => 'Grade 12',
2765: 13 => 'Grade 13',
2766: 14 => '100 Level',
2767: 15 => '200 Level',
2768: 16 => '300 Level',
2769: 17 => '400 Level',
2770: 18 => 'Graduate Level');
2771: return &mt($gradelevels{$gradelevel});
2772: }
2773:
1.163 www 2774: sub select_level_form {
2775: my ($deflevel,$name)=@_;
2776: unless ($deflevel) { $deflevel=0; }
1.167 www 2777: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2778: for (my $i=0; $i<=18; $i++) {
2779: $selectform.="<option value=\"$i\" ".
1.253 albertel 2780: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2781: ">".&gradeleveldescription($i)."</option>\n";
2782: }
2783: $selectform.="</select>";
2784: return $selectform;
1.163 www 2785: }
1.167 www 2786:
1.35 matthew 2787: #-------------------------------------------
2788:
1.45 matthew 2789: =pod
2790:
1.1256 raeburn 2791: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2792:
2793: Returns a string containing a <select name='$name' size='1'> form to
2794: allow a user to select the domain to preform an operation in.
2795: See loncreateuser.pm for an example invocation and use.
2796:
1.90 www 2797: If the $includeempty flag is set, it also includes an empty choice ("no domain
2798: selected");
2799:
1.743 raeburn 2800: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2801:
1.910 raeburn 2802: 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.
2803:
1.1121 raeburn 2804: The optional $incdoms is a reference to an array of domains which will be the only available options.
2805:
2806: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2807:
1.1256 raeburn 2808: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
2809:
1.35 matthew 2810: =cut
2811:
2812: #-------------------------------------------
1.34 matthew 2813: sub select_dom_form {
1.1256 raeburn 2814: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2815: if ($onchange) {
1.874 raeburn 2816: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2817: }
1.1256 raeburn 2818: if ($disabled) {
2819: $disabled = ' disabled="disabled"';
2820: }
1.1121 raeburn 2821: my (@domains,%exclude);
1.910 raeburn 2822: if (ref($incdoms) eq 'ARRAY') {
2823: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2824: } else {
2825: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2826: }
1.90 www 2827: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2828: if (ref($excdoms) eq 'ARRAY') {
2829: map { $exclude{$_} = 1; } @{$excdoms};
2830: }
1.1256 raeburn 2831: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2832: foreach my $dom (@domains) {
1.1121 raeburn 2833: next if ($exclude{$dom});
1.356 albertel 2834: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2835: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2836: if ($showdomdesc) {
2837: if ($dom ne '') {
2838: my $domdesc = &Apache::lonnet::domain($dom,'description');
2839: if ($domdesc ne '') {
2840: $selectdomain .= ' ('.$domdesc.')';
2841: }
2842: }
2843: }
2844: $selectdomain .= "</option>\n";
1.34 matthew 2845: }
2846: $selectdomain.="</select>";
2847: return $selectdomain;
2848: }
2849:
1.35 matthew 2850: #-------------------------------------------
2851:
1.45 matthew 2852: =pod
2853:
1.648 raeburn 2854: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2855:
1.586 raeburn 2856: input: 4 arguments (two required, two optional) -
2857: $domain - domain of new user
2858: $name - name of form element
2859: $default - Value of 'default' causes a default item to be first
2860: option, and selected by default.
2861: $hide - Value of 'hide' causes hiding of the name of the server,
2862: if 1 server found, or default, if 0 found.
1.594 raeburn 2863: output: returns 2 items:
1.586 raeburn 2864: (a) form element which contains either:
2865: (i) <select name="$name">
2866: <option value="$hostid1">$hostid $servers{$hostid}</option>
2867: <option value="$hostid2">$hostid $servers{$hostid}</option>
2868: </select>
2869: form item if there are multiple library servers in $domain, or
2870: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2871: if there is only one library server in $domain.
2872:
2873: (b) number of library servers found.
2874:
2875: See loncreateuser.pm for example of use.
1.35 matthew 2876:
2877: =cut
2878:
2879: #-------------------------------------------
1.586 raeburn 2880: sub home_server_form_item {
2881: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2882: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2883: my $result;
2884: my $numlib = keys(%servers);
2885: if ($numlib > 1) {
2886: $result .= '<select name="'.$name.'" />'."\n";
2887: if ($default) {
1.804 bisitz 2888: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2889: '</option>'."\n";
2890: }
2891: foreach my $hostid (sort(keys(%servers))) {
2892: $result.= '<option value="'.$hostid.'">'.
2893: $hostid.' '.$servers{$hostid}."</option>\n";
2894: }
2895: $result .= '</select>'."\n";
2896: } elsif ($numlib == 1) {
2897: my $hostid;
2898: foreach my $item (keys(%servers)) {
2899: $hostid = $item;
2900: }
2901: $result .= '<input type="hidden" name="'.$name.'" value="'.
2902: $hostid.'" />';
2903: if (!$hide) {
2904: $result .= $hostid.' '.$servers{$hostid};
2905: }
2906: $result .= "\n";
2907: } elsif ($default) {
2908: $result .= '<input type="hidden" name="'.$name.
2909: '" value="default" />';
2910: if (!$hide) {
2911: $result .= &mt('default');
2912: }
2913: $result .= "\n";
1.33 matthew 2914: }
1.586 raeburn 2915: return ($result,$numlib);
1.33 matthew 2916: }
1.112 bowersj2 2917:
2918: =pod
2919:
1.534 albertel 2920: =back
2921:
1.112 bowersj2 2922: =cut
1.87 matthew 2923:
2924: ###############################################################
1.112 bowersj2 2925: ## Decoding User Agent ##
1.87 matthew 2926: ###############################################################
2927:
2928: =pod
2929:
1.112 bowersj2 2930: =head1 Decoding the User Agent
2931:
2932: =over 4
2933:
2934: =item * &decode_user_agent()
1.87 matthew 2935:
2936: Inputs: $r
2937:
2938: Outputs:
2939:
2940: =over 4
2941:
1.112 bowersj2 2942: =item * $httpbrowser
1.87 matthew 2943:
1.112 bowersj2 2944: =item * $clientbrowser
1.87 matthew 2945:
1.112 bowersj2 2946: =item * $clientversion
1.87 matthew 2947:
1.112 bowersj2 2948: =item * $clientmathml
1.87 matthew 2949:
1.112 bowersj2 2950: =item * $clientunicode
1.87 matthew 2951:
1.112 bowersj2 2952: =item * $clientos
1.87 matthew 2953:
1.1137 raeburn 2954: =item * $clientmobile
2955:
1.1141 raeburn 2956: =item * $clientinfo
2957:
1.1194 raeburn 2958: =item * $clientosversion
2959:
1.87 matthew 2960: =back
2961:
1.157 matthew 2962: =back
2963:
1.87 matthew 2964: =cut
2965:
2966: ###############################################################
2967: ###############################################################
2968: sub decode_user_agent {
1.247 albertel 2969: my ($r)=@_;
1.87 matthew 2970: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2971: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2972: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2973: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2974: my $clientbrowser='unknown';
2975: my $clientversion='0';
2976: my $clientmathml='';
2977: my $clientunicode='0';
1.1137 raeburn 2978: my $clientmobile=0;
1.1194 raeburn 2979: my $clientosversion='';
1.87 matthew 2980: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2981: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2982: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2983: $clientbrowser=$bname;
2984: $httpbrowser=~/$vreg/i;
2985: $clientversion=$1;
2986: $clientmathml=($clientversion>=$minv);
2987: $clientunicode=($clientversion>=$univ);
2988: }
2989: }
2990: my $clientos='unknown';
1.1141 raeburn 2991: my $clientinfo;
1.87 matthew 2992: if (($httpbrowser=~/linux/i) ||
2993: ($httpbrowser=~/unix/i) ||
2994: ($httpbrowser=~/ux/i) ||
2995: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2996: if (($httpbrowser=~/vax/i) ||
2997: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2998: if ($httpbrowser=~/next/i) { $clientos='next'; }
2999: if (($httpbrowser=~/mac/i) ||
3000: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 3001: if ($httpbrowser=~/win/i) {
3002: $clientos='win';
3003: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
3004: $clientosversion = $1;
3005: }
3006: }
1.87 matthew 3007: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 3008: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
3009: $clientmobile=lc($1);
3010: }
1.1141 raeburn 3011: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
3012: $clientinfo = 'firefox-'.$1;
3013: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
3014: $clientinfo = 'chromeframe-'.$1;
3015: }
1.87 matthew 3016: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 3017: $clientunicode,$clientos,$clientmobile,$clientinfo,
3018: $clientosversion);
1.87 matthew 3019: }
3020:
1.32 matthew 3021: ###############################################################
3022: ## Authentication changing form generation subroutines ##
3023: ###############################################################
3024: ##
3025: ## All of the authform_xxxxxxx subroutines take their inputs in a
3026: ## hash, and have reasonable default values.
3027: ##
3028: ## formname = the name given in the <form> tag.
1.35 matthew 3029: #-------------------------------------------
3030:
1.45 matthew 3031: =pod
3032:
1.112 bowersj2 3033: =head1 Authentication Routines
3034:
3035: =over 4
3036:
1.648 raeburn 3037: =item * &authform_xxxxxx()
1.35 matthew 3038:
3039: The authform_xxxxxx subroutines provide javascript and html forms which
3040: handle some of the conveniences required for authentication forms.
3041: This is not an optimal method, but it works.
3042:
3043: =over 4
3044:
1.112 bowersj2 3045: =item * authform_header
1.35 matthew 3046:
1.112 bowersj2 3047: =item * authform_authorwarning
1.35 matthew 3048:
1.112 bowersj2 3049: =item * authform_nochange
1.35 matthew 3050:
1.112 bowersj2 3051: =item * authform_kerberos
1.35 matthew 3052:
1.112 bowersj2 3053: =item * authform_internal
1.35 matthew 3054:
1.112 bowersj2 3055: =item * authform_filesystem
1.35 matthew 3056:
1.1310 raeburn 3057: =item * authform_lti
3058:
1.35 matthew 3059: =back
3060:
1.648 raeburn 3061: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3062:
1.35 matthew 3063: =cut
3064:
3065: #-------------------------------------------
1.32 matthew 3066: sub authform_header{
3067: my %in = (
3068: formname => 'cu',
1.80 albertel 3069: kerb_def_dom => '',
1.32 matthew 3070: @_,
3071: );
3072: $in{'formname'} = 'document.' . $in{'formname'};
3073: my $result='';
1.80 albertel 3074:
3075: #---------------------------------------------- Code for upper case translation
3076: my $Javascript_toUpperCase;
3077: unless ($in{kerb_def_dom}) {
3078: $Javascript_toUpperCase =<<"END";
3079: switch (choice) {
3080: case 'krb': currentform.elements[choicearg].value =
3081: currentform.elements[choicearg].value.toUpperCase();
3082: break;
3083: default:
3084: }
3085: END
3086: } else {
3087: $Javascript_toUpperCase = "";
3088: }
3089:
1.165 raeburn 3090: my $radioval = "'nochange'";
1.591 raeburn 3091: if (defined($in{'curr_authtype'})) {
3092: if ($in{'curr_authtype'} ne '') {
3093: $radioval = "'".$in{'curr_authtype'}."arg'";
3094: }
1.174 matthew 3095: }
1.165 raeburn 3096: my $argfield = 'null';
1.591 raeburn 3097: if (defined($in{'mode'})) {
1.165 raeburn 3098: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3099: if (defined($in{'curr_autharg'})) {
3100: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3101: $argfield = "'$in{'curr_autharg'}'";
3102: }
3103: }
3104: }
3105: }
3106:
1.32 matthew 3107: $result.=<<"END";
3108: var current = new Object();
1.165 raeburn 3109: current.radiovalue = $radioval;
3110: current.argfield = $argfield;
1.32 matthew 3111:
3112: function changed_radio(choice,currentform) {
3113: var choicearg = choice + 'arg';
3114: // If a radio button in changed, we need to change the argfield
3115: if (current.radiovalue != choice) {
3116: current.radiovalue = choice;
3117: if (current.argfield != null) {
3118: currentform.elements[current.argfield].value = '';
3119: }
3120: if (choice == 'nochange') {
3121: current.argfield = null;
3122: } else {
3123: current.argfield = choicearg;
3124: switch(choice) {
3125: case 'krb':
3126: currentform.elements[current.argfield].value =
3127: "$in{'kerb_def_dom'}";
3128: break;
3129: default:
3130: break;
3131: }
3132: }
3133: }
3134: return;
3135: }
1.22 www 3136:
1.32 matthew 3137: function changed_text(choice,currentform) {
3138: var choicearg = choice + 'arg';
3139: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3140: $Javascript_toUpperCase
1.32 matthew 3141: // clear old field
3142: if ((current.argfield != choicearg) && (current.argfield != null)) {
3143: currentform.elements[current.argfield].value = '';
3144: }
3145: current.argfield = choicearg;
3146: }
3147: set_auth_radio_buttons(choice,currentform);
3148: return;
1.20 www 3149: }
1.32 matthew 3150:
3151: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3152: var numauthchoices = currentform.login.length;
3153: if (typeof numauthchoices == "undefined") {
3154: return;
3155: }
1.32 matthew 3156: var i=0;
1.986 raeburn 3157: while (i < numauthchoices) {
1.32 matthew 3158: if (currentform.login[i].value == newvalue) { break; }
3159: i++;
3160: }
1.986 raeburn 3161: if (i == numauthchoices) {
1.32 matthew 3162: return;
3163: }
3164: current.radiovalue = newvalue;
3165: currentform.login[i].checked = true;
3166: return;
3167: }
3168: END
3169: return $result;
3170: }
3171:
1.1106 raeburn 3172: sub authform_authorwarning {
1.32 matthew 3173: my $result='';
1.144 matthew 3174: $result='<i>'.
3175: &mt('As a general rule, only authors or co-authors should be '.
3176: 'filesystem authenticated '.
3177: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3178: return $result;
3179: }
3180:
1.1106 raeburn 3181: sub authform_nochange {
1.32 matthew 3182: my %in = (
3183: formname => 'document.cu',
3184: kerb_def_dom => 'MSU.EDU',
3185: @_,
3186: );
1.1106 raeburn 3187: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3188: my $result;
1.1104 raeburn 3189: if (!$authnum) {
1.1105 raeburn 3190: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3191: } else {
3192: $result = '<label>'.&mt('[_1] Do not change login data',
3193: '<input type="radio" name="login" value="nochange" '.
3194: 'checked="checked" onclick="'.
1.281 albertel 3195: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3196: '</label>';
1.586 raeburn 3197: }
1.32 matthew 3198: return $result;
3199: }
3200:
1.591 raeburn 3201: sub authform_kerberos {
1.32 matthew 3202: my %in = (
3203: formname => 'document.cu',
3204: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3205: kerb_def_auth => 'krb4',
1.32 matthew 3206: @_,
3207: );
1.586 raeburn 3208: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3209: $autharg,$jscall,$disabled);
1.1106 raeburn 3210: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3211: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3212: $check5 = ' checked="checked"';
1.80 albertel 3213: } else {
1.772 bisitz 3214: $check4 = ' checked="checked"';
1.80 albertel 3215: }
1.1259 raeburn 3216: if ($in{'readonly'}) {
3217: $disabled = ' disabled="disabled"';
3218: }
1.165 raeburn 3219: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3220: if (defined($in{'curr_authtype'})) {
3221: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3222: $krbcheck = ' checked="checked"';
1.623 raeburn 3223: if (defined($in{'mode'})) {
3224: if ($in{'mode'} eq 'modifyuser') {
3225: $krbcheck = '';
3226: }
3227: }
1.591 raeburn 3228: if (defined($in{'curr_kerb_ver'})) {
3229: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3230: $check5 = ' checked="checked"';
1.591 raeburn 3231: $check4 = '';
3232: } else {
1.772 bisitz 3233: $check4 = ' checked="checked"';
1.591 raeburn 3234: $check5 = '';
3235: }
1.586 raeburn 3236: }
1.591 raeburn 3237: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3238: $krbarg = $in{'curr_autharg'};
3239: }
1.586 raeburn 3240: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3241: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3242: $result =
3243: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3244: $in{'curr_autharg'},$krbver);
3245: } else {
3246: $result =
3247: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3248: }
3249: return $result;
3250: }
3251: }
3252: } else {
3253: if ($authnum == 1) {
1.784 bisitz 3254: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3255: }
3256: }
1.586 raeburn 3257: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3258: return;
1.587 raeburn 3259: } elsif ($authtype eq '') {
1.591 raeburn 3260: if (defined($in{'mode'})) {
1.587 raeburn 3261: if ($in{'mode'} eq 'modifycourse') {
3262: if ($authnum == 1) {
1.1259 raeburn 3263: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3264: }
3265: }
3266: }
1.586 raeburn 3267: }
3268: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3269: if ($authtype eq '') {
3270: $authtype = '<input type="radio" name="login" value="krb" '.
3271: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3272: $krbcheck.$disabled.' />';
1.586 raeburn 3273: }
3274: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3275: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3276: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3277: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3278: $in{'curr_authtype'} eq 'krb4')) {
3279: $result .= &mt
1.144 matthew 3280: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3281: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3282: '<label>'.$authtype,
1.281 albertel 3283: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3284: 'value="'.$krbarg.'" '.
1.1259 raeburn 3285: 'onchange="'.$jscall.'"'.$disabled.' />',
3286: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3287: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3288: '</label>');
1.586 raeburn 3289: } elsif ($can_assign{'krb4'}) {
3290: $result .= &mt
3291: ('[_1] Kerberos authenticated with domain [_2] '.
3292: '[_3] Version 4 [_4]',
3293: '<label>'.$authtype,
3294: '</label><input type="text" size="10" name="krbarg" '.
3295: 'value="'.$krbarg.'" '.
1.1259 raeburn 3296: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3297: '<label><input type="hidden" name="krbver" value="4" />',
3298: '</label>');
3299: } elsif ($can_assign{'krb5'}) {
3300: $result .= &mt
3301: ('[_1] Kerberos authenticated with domain [_2] '.
3302: '[_3] Version 5 [_4]',
3303: '<label>'.$authtype,
3304: '</label><input type="text" size="10" name="krbarg" '.
3305: 'value="'.$krbarg.'" '.
1.1259 raeburn 3306: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3307: '<label><input type="hidden" name="krbver" value="5" />',
3308: '</label>');
3309: }
1.32 matthew 3310: return $result;
3311: }
3312:
1.1106 raeburn 3313: sub authform_internal {
1.586 raeburn 3314: my %in = (
1.32 matthew 3315: formname => 'document.cu',
3316: kerb_def_dom => 'MSU.EDU',
3317: @_,
3318: );
1.1259 raeburn 3319: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3320: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3321: if ($in{'readonly'}) {
3322: $disabled = ' disabled="disabled"';
3323: }
1.591 raeburn 3324: if (defined($in{'curr_authtype'})) {
3325: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3326: if ($can_assign{'int'}) {
1.772 bisitz 3327: $intcheck = 'checked="checked" ';
1.623 raeburn 3328: if (defined($in{'mode'})) {
3329: if ($in{'mode'} eq 'modifyuser') {
3330: $intcheck = '';
3331: }
3332: }
1.591 raeburn 3333: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3334: $intarg = $in{'curr_autharg'};
3335: }
3336: } else {
3337: $result = &mt('Currently internally authenticated.');
3338: return $result;
1.165 raeburn 3339: }
3340: }
1.586 raeburn 3341: } else {
3342: if ($authnum == 1) {
1.784 bisitz 3343: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3344: }
3345: }
3346: if (!$can_assign{'int'}) {
3347: return;
1.587 raeburn 3348: } elsif ($authtype eq '') {
1.591 raeburn 3349: if (defined($in{'mode'})) {
1.587 raeburn 3350: if ($in{'mode'} eq 'modifycourse') {
3351: if ($authnum == 1) {
1.1259 raeburn 3352: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3353: }
3354: }
3355: }
1.165 raeburn 3356: }
1.586 raeburn 3357: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3358: if ($authtype eq '') {
3359: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3360: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3361: }
1.605 bisitz 3362: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3363: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3364: $result = &mt
1.144 matthew 3365: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3366: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3367: $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 3368: return $result;
3369: }
3370:
1.1104 raeburn 3371: sub authform_local {
1.32 matthew 3372: my %in = (
3373: formname => 'document.cu',
3374: kerb_def_dom => 'MSU.EDU',
3375: @_,
3376: );
1.1259 raeburn 3377: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3378: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3379: if ($in{'readonly'}) {
3380: $disabled = ' disabled="disabled"';
3381: }
1.591 raeburn 3382: if (defined($in{'curr_authtype'})) {
3383: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3384: if ($can_assign{'loc'}) {
1.772 bisitz 3385: $loccheck = 'checked="checked" ';
1.623 raeburn 3386: if (defined($in{'mode'})) {
3387: if ($in{'mode'} eq 'modifyuser') {
3388: $loccheck = '';
3389: }
3390: }
1.591 raeburn 3391: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3392: $locarg = $in{'curr_autharg'};
3393: }
3394: } else {
3395: $result = &mt('Currently using local (institutional) authentication.');
3396: return $result;
1.165 raeburn 3397: }
3398: }
1.586 raeburn 3399: } else {
3400: if ($authnum == 1) {
1.784 bisitz 3401: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3402: }
3403: }
3404: if (!$can_assign{'loc'}) {
3405: return;
1.587 raeburn 3406: } elsif ($authtype eq '') {
1.591 raeburn 3407: if (defined($in{'mode'})) {
1.587 raeburn 3408: if ($in{'mode'} eq 'modifycourse') {
3409: if ($authnum == 1) {
1.1259 raeburn 3410: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3411: }
3412: }
3413: }
1.165 raeburn 3414: }
1.586 raeburn 3415: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3416: if ($authtype eq '') {
3417: $authtype = '<input type="radio" name="login" value="loc" '.
3418: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3419: $jscall.'"'.$disabled.' />';
1.586 raeburn 3420: }
3421: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3422: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3423: $result = &mt('[_1] Local Authentication with argument [_2]',
3424: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3425: return $result;
3426: }
3427:
1.1106 raeburn 3428: sub authform_filesystem {
1.32 matthew 3429: my %in = (
3430: formname => 'document.cu',
3431: kerb_def_dom => 'MSU.EDU',
3432: @_,
3433: );
1.1259 raeburn 3434: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3435: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3436: if ($in{'readonly'}) {
3437: $disabled = ' disabled="disabled"';
3438: }
1.591 raeburn 3439: if (defined($in{'curr_authtype'})) {
3440: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3441: if ($can_assign{'fsys'}) {
1.772 bisitz 3442: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3443: if (defined($in{'mode'})) {
3444: if ($in{'mode'} eq 'modifyuser') {
3445: $fsyscheck = '';
3446: }
3447: }
1.586 raeburn 3448: } else {
3449: $result = &mt('Currently Filesystem Authenticated.');
3450: return $result;
1.1259 raeburn 3451: }
1.586 raeburn 3452: }
3453: } else {
3454: if ($authnum == 1) {
1.784 bisitz 3455: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3456: }
3457: }
3458: if (!$can_assign{'fsys'}) {
3459: return;
1.587 raeburn 3460: } elsif ($authtype eq '') {
1.591 raeburn 3461: if (defined($in{'mode'})) {
1.587 raeburn 3462: if ($in{'mode'} eq 'modifycourse') {
3463: if ($authnum == 1) {
1.1259 raeburn 3464: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3465: }
3466: }
3467: }
1.586 raeburn 3468: }
3469: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3470: if ($authtype eq '') {
3471: $authtype = '<input type="radio" name="login" value="fsys" '.
3472: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3473: $jscall.'"'.$disabled.' />';
1.586 raeburn 3474: }
1.1310 raeburn 3475: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3476: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3477: $result = &mt
1.144 matthew 3478: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310 raeburn 3479: '<label>'.$authtype,'</label>'.$autharg);
3480: return $result;
3481: }
3482:
3483: sub authform_lti {
3484: my %in = (
3485: formname => 'document.cu',
3486: kerb_def_dom => 'MSU.EDU',
3487: @_,
3488: );
3489: my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
3490: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
3491: if ($in{'readonly'}) {
3492: $disabled = ' disabled="disabled"';
3493: }
3494: if (defined($in{'curr_authtype'})) {
3495: if ($in{'curr_authtype'} eq 'lti') {
3496: if ($can_assign{'lti'}) {
3497: $lticheck = 'checked="checked" ';
3498: if (defined($in{'mode'})) {
3499: if ($in{'mode'} eq 'modifyuser') {
3500: $lticheck = '';
3501: }
3502: }
3503: } else {
3504: $result = &mt('Currently LTI Authenticated.');
3505: return $result;
3506: }
3507: }
3508: } else {
3509: if ($authnum == 1) {
3510: $authtype = '<input type="hidden" name="login" value="lti" />';
3511: }
3512: }
3513: if (!$can_assign{'lti'}) {
3514: return;
3515: } elsif ($authtype eq '') {
3516: if (defined($in{'mode'})) {
3517: if ($in{'mode'} eq 'modifycourse') {
3518: if ($authnum == 1) {
3519: $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
3520: }
3521: }
3522: }
3523: }
3524: $jscall = "javascript:changed_radio('lti',$in{'formname'});";
3525: if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
3526: $authtype = '<input type="radio" name="login" value="lti" '.
3527: $lticheck.' onchange="'.$jscall.'" onclick="'.
3528: $jscall.'"'.$disabled.' />';
3529: }
3530: $autharg = '<input type="hidden" name="ltiarg" value="" />';
3531: if ($authtype) {
3532: $result = &mt('[_1] LTI Authenticated',
3533: '<label>'.$authtype.'</label>'.$autharg);
3534: } else {
3535: $result = '<b>'.&mt('LTI Authenticated').'</b>'.
3536: $autharg;
3537: }
1.32 matthew 3538: return $result;
3539: }
3540:
1.586 raeburn 3541: sub get_assignable_auth {
3542: my ($dom) = @_;
3543: if ($dom eq '') {
3544: $dom = $env{'request.role.domain'};
3545: }
3546: my %can_assign = (
3547: krb4 => 1,
3548: krb5 => 1,
3549: int => 1,
3550: loc => 1,
1.1310 raeburn 3551: lti => 1,
1.586 raeburn 3552: );
3553: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3554: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3555: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3556: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3557: my $context;
3558: if ($env{'request.role'} =~ /^au/) {
3559: $context = 'author';
1.1259 raeburn 3560: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3561: $context = 'domain';
3562: } elsif ($env{'request.course.id'}) {
3563: $context = 'course';
3564: }
3565: if ($context) {
3566: if (ref($authhash->{$context}) eq 'HASH') {
3567: %can_assign = %{$authhash->{$context}};
3568: }
3569: }
3570: }
3571: }
3572: my $authnum = 0;
3573: foreach my $key (keys(%can_assign)) {
3574: if ($can_assign{$key}) {
3575: $authnum ++;
3576: }
3577: }
3578: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3579: $authnum --;
3580: }
3581: return ($authnum,%can_assign);
3582: }
3583:
1.1331 raeburn 3584: sub check_passwd_rules {
3585: my ($domain,$plainpass) = @_;
3586: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3587: my ($min,$max,@chars,@brokerule,$warning);
1.1333 raeburn 3588: $min = $Apache::lonnet::passwdmin;
1.1331 raeburn 3589: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3590: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1333 raeburn 3591: if ($passwdconf{'min'} > $min) {
3592: $min = $passwdconf{'min'};
3593: }
1.1331 raeburn 3594: }
3595: if ($passwdconf{'max'} =~ /^\d+$/) {
3596: $max = $passwdconf{'max'};
3597: }
3598: @chars = @{$passwdconf{'chars'}};
3599: }
3600: if (($min) && (length($plainpass) < $min)) {
3601: push(@brokerule,'min');
3602: }
3603: if (($max) && (length($plainpass) > $max)) {
3604: push(@brokerule,'max');
3605: }
3606: if (@chars) {
3607: my %rules;
3608: map { $rules{$_} = 1; } @chars;
3609: if ($rules{'uc'}) {
3610: unless ($plainpass =~ /[A-Z]/) {
3611: push(@brokerule,'uc');
3612: }
3613: }
3614: if ($rules{'lc'}) {
1.1332 raeburn 3615: unless ($plainpass =~ /[a-z]/) {
1.1331 raeburn 3616: push(@brokerule,'lc');
3617: }
3618: }
3619: if ($rules{'num'}) {
3620: unless ($plainpass =~ /\d/) {
3621: push(@brokerule,'num');
3622: }
3623: }
3624: if ($rules{'spec'}) {
3625: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3626: push(@brokerule,'spec');
3627: }
3628: }
3629: }
3630: if (@brokerule) {
3631: my %rulenames = &Apache::lonlocal::texthash(
3632: uc => 'At least one upper case letter',
3633: lc => 'At least one lower case letter',
3634: num => 'At least one number',
3635: spec => 'At least one non-alphanumeric',
3636: );
3637: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3638: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3639: $rulenames{'num'} .= ': 0123456789';
3640: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3641: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3642: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3643: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1336 raeburn 3644: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1331 raeburn 3645: if (grep(/^$rule$/,@brokerule)) {
3646: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3647: }
3648: }
3649: $warning .= '</ul>';
3650: }
1.1332 raeburn 3651: if (wantarray) {
3652: return @brokerule;
3653: }
1.1331 raeburn 3654: return $warning;
3655: }
3656:
1.1376 raeburn 3657: sub passwd_validation_js {
1.1377 raeburn 3658: my ($currpasswdval,$domain,$context,$id) = @_;
3659: my (%passwdconf,$alertmsg);
3660: if ($context eq 'linkprot') {
3661: my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
3662: if (ref($domconfig{'ltisec'}) eq 'HASH') {
3663: if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
3664: %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
3665: }
3666: }
3667: if ($id eq 'add') {
3668: $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
3669: } elsif ($id =~ /^\d+$/) {
3670: my $pos = $id+1;
3671: $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3672: } else {
3673: $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3674: }
3675: } else {
3676: %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3677: $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
3678: }
1.1376 raeburn 3679: my ($min,$max,@chars,$numrules,$intargjs,%alert);
3680: $numrules = 0;
3681: $min = $Apache::lonnet::passwdmin;
3682: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3683: if ($passwdconf{'min'} =~ /^\d+$/) {
3684: if ($passwdconf{'min'} > $min) {
3685: $min = $passwdconf{'min'};
3686: }
3687: }
3688: if ($passwdconf{'max'} =~ /^\d+$/) {
3689: $max = $passwdconf{'max'};
3690: $numrules ++;
3691: }
3692: @chars = @{$passwdconf{'chars'}};
3693: if (@chars) {
3694: $numrules ++;
3695: }
3696: }
3697: if ($min > 0) {
3698: $numrules ++;
3699: }
3700: if (($min > 0) || ($max ne '') || (@chars > 0)) {
3701: if ($min) {
3702: $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
3703: }
3704: if ($max) {
3705: $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
3706: }
3707: my (@charalerts,@charrules);
3708: if (@chars) {
3709: if (grep(/^uc$/,@chars)) {
3710: push(@charalerts,&mt('contain at least one upper case letter'));
3711: push(@charrules,'uc');
3712: }
3713: if (grep(/^lc$/,@chars)) {
3714: push(@charalerts,&mt('contain at least one lower case letter'));
3715: push(@charrules,'lc');
3716: }
3717: if (grep(/^num$/,@chars)) {
3718: push(@charalerts,&mt('contain at least one number'));
3719: push(@charrules,'num');
3720: }
3721: if (grep(/^spec$/,@chars)) {
3722: push(@charalerts,&mt('contain at least one non-alphanumeric'));
3723: push(@charrules,'spec');
3724: }
3725: }
3726: $intargjs = qq| var rulesmsg = '';\n|.
3727: qq| var currpwval = $currpasswdval;\n|;
3728: if ($min) {
3729: $intargjs .= qq|
3730: if (currpwval.length < $min) {
3731: rulesmsg += ' - $alert{min}';
3732: }
3733: |;
3734: }
3735: if ($max) {
3736: $intargjs .= qq|
3737: if (currpwval.length > $max) {
3738: rulesmsg += ' - $alert{max}';
3739: }
3740: |;
3741: }
3742: if (@chars > 0) {
3743: my $charrulestr = '"'.join('","',@charrules).'"';
3744: my $charalertstr = '"'.join('","',@charalerts).'"';
3745: $intargjs .= qq| var brokerules = new Array();\n|.
3746: qq| var charrules = new Array($charrulestr);\n|.
3747: qq| var charalerts = new Array($charalertstr);\n|;
3748: my %rules;
3749: map { $rules{$_} = 1; } @chars;
3750: if ($rules{'uc'}) {
3751: $intargjs .= qq|
3752: var ucRegExp = /[A-Z]/;
3753: if (!ucRegExp.test(currpwval)) {
3754: brokerules.push('uc');
3755: }
3756: |;
3757: }
3758: if ($rules{'lc'}) {
3759: $intargjs .= qq|
3760: var lcRegExp = /[a-z]/;
3761: if (!lcRegExp.test(currpwval)) {
3762: brokerules.push('lc');
3763: }
3764: |;
3765: }
3766: if ($rules{'num'}) {
3767: $intargjs .= qq|
3768: var numRegExp = /[0-9]/;
3769: if (!numRegExp.test(currpwval)) {
3770: brokerules.push('num');
3771: }
3772: |;
3773: }
3774: if ($rules{'spec'}) {
3775: $intargjs .= q|
3776: var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
3777: if (!specRegExp.test(currpwval)) {
3778: brokerules.push('spec');
3779: }
3780: |;
3781: }
3782: $intargjs .= qq|
3783: if (brokerules.length > 0) {
3784: for (var i=0; i<brokerules.length; i++) {
3785: for (var j=0; j<charrules.length; j++) {
3786: if (brokerules[i] == charrules[j]) {
3787: rulesmsg += ' - '+charalerts[j]+'\\n';
3788: break;
3789: }
3790: }
3791: }
3792: }
3793: |;
3794: }
3795: $intargjs .= qq|
3796: if (rulesmsg != '') {
3797: rulesmsg = '$alertmsg'+rulesmsg;
3798: alert(rulesmsg);
3799: return false;
3800: }
3801: |;
3802: }
3803: return ($numrules,$intargjs);
3804: }
3805:
1.80 albertel 3806: ###############################################################
3807: ## Get Kerberos Defaults for Domain ##
3808: ###############################################################
3809: ##
3810: ## Returns default kerberos version and an associated argument
3811: ## as listed in file domain.tab. If not listed, provides
3812: ## appropriate default domain and kerberos version.
3813: ##
3814: #-------------------------------------------
3815:
3816: =pod
3817:
1.648 raeburn 3818: =item * &get_kerberos_defaults()
1.80 albertel 3819:
3820: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3821: version and domain. If not found, it defaults to version 4 and the
3822: domain of the server.
1.80 albertel 3823:
1.648 raeburn 3824: =over 4
3825:
1.80 albertel 3826: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3827:
1.648 raeburn 3828: =back
3829:
3830: =back
3831:
1.80 albertel 3832: =cut
3833:
3834: #-------------------------------------------
3835: sub get_kerberos_defaults {
3836: my $domain=shift;
1.641 raeburn 3837: my ($krbdef,$krbdefdom);
3838: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3839: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3840: $krbdef = $domdefaults{'auth_def'};
3841: $krbdefdom = $domdefaults{'auth_arg_def'};
3842: } else {
1.80 albertel 3843: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3844: my $krbdefdom=$1;
3845: $krbdefdom=~tr/a-z/A-Z/;
3846: $krbdef = "krb4";
3847: }
3848: return ($krbdef,$krbdefdom);
3849: }
1.112 bowersj2 3850:
1.32 matthew 3851:
1.46 matthew 3852: ###############################################################
3853: ## Thesaurus Functions ##
3854: ###############################################################
1.20 www 3855:
1.46 matthew 3856: =pod
1.20 www 3857:
1.112 bowersj2 3858: =head1 Thesaurus Functions
3859:
3860: =over 4
3861:
1.648 raeburn 3862: =item * &initialize_keywords()
1.46 matthew 3863:
3864: Initializes the package variable %Keywords if it is empty. Uses the
3865: package variable $thesaurus_db_file.
3866:
3867: =cut
3868:
3869: ###################################################
3870:
3871: sub initialize_keywords {
3872: return 1 if (scalar keys(%Keywords));
3873: # If we are here, %Keywords is empty, so fill it up
3874: # Make sure the file we need exists...
3875: if (! -e $thesaurus_db_file) {
3876: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3877: " failed because it does not exist");
3878: return 0;
3879: }
3880: # Set up the hash as a database
3881: my %thesaurus_db;
3882: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3883: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3884: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3885: $thesaurus_db_file);
3886: return 0;
3887: }
3888: # Get the average number of appearances of a word.
3889: my $avecount = $thesaurus_db{'average.count'};
3890: # Put keywords (those that appear > average) into %Keywords
3891: while (my ($word,$data)=each (%thesaurus_db)) {
3892: my ($count,undef) = split /:/,$data;
3893: $Keywords{$word}++ if ($count > $avecount);
3894: }
3895: untie %thesaurus_db;
3896: # Remove special values from %Keywords.
1.356 albertel 3897: foreach my $value ('total.count','average.count') {
3898: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3899: }
1.46 matthew 3900: return 1;
3901: }
3902:
3903: ###################################################
3904:
3905: =pod
3906:
1.648 raeburn 3907: =item * &keyword($word)
1.46 matthew 3908:
3909: Returns true if $word is a keyword. A keyword is a word that appears more
3910: than the average number of times in the thesaurus database. Calls
3911: &initialize_keywords
3912:
3913: =cut
3914:
3915: ###################################################
1.20 www 3916:
3917: sub keyword {
1.46 matthew 3918: return if (!&initialize_keywords());
3919: my $word=lc(shift());
3920: $word=~s/\W//g;
3921: return exists($Keywords{$word});
1.20 www 3922: }
1.46 matthew 3923:
3924: ###############################################################
3925:
3926: =pod
1.20 www 3927:
1.648 raeburn 3928: =item * &get_related_words()
1.46 matthew 3929:
1.160 matthew 3930: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3931: an array of words. If the keyword is not in the thesaurus, an empty array
3932: will be returned. The order of the words returned is determined by the
3933: database which holds them.
3934:
3935: Uses global $thesaurus_db_file.
3936:
1.1057 foxr 3937:
1.46 matthew 3938: =cut
3939:
3940: ###############################################################
3941: sub get_related_words {
3942: my $keyword = shift;
3943: my %thesaurus_db;
3944: if (! -e $thesaurus_db_file) {
3945: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3946: "failed because the file does not exist");
3947: return ();
3948: }
3949: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3950: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3951: return ();
3952: }
3953: my @Words=();
1.429 www 3954: my $count=0;
1.46 matthew 3955: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3956: # The first element is the number of times
3957: # the word appears. We do not need it now.
1.429 www 3958: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3959: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3960: my $threshold=$mostfrequentcount/10;
3961: foreach my $possibleword (@RelatedWords) {
3962: my ($word,$wordcount)=split(/\,/,$possibleword);
3963: if ($wordcount>$threshold) {
3964: push(@Words,$word);
3965: $count++;
3966: if ($count>10) { last; }
3967: }
1.20 www 3968: }
3969: }
1.46 matthew 3970: untie %thesaurus_db;
3971: return @Words;
1.14 harris41 3972: }
1.1090 foxr 3973: ###############################################################
3974: #
3975: # Spell checking
3976: #
3977:
3978: =pod
3979:
1.1142 raeburn 3980: =back
3981:
1.1090 foxr 3982: =head1 Spell checking
3983:
3984: =over 4
3985:
3986: =item * &check_spelling($wordlist $language)
3987:
3988: Takes a string containing words and feeds it to an external
3989: spellcheck program via a pipeline. Returns a string containing
3990: them mis-spelled words.
3991:
3992: Parameters:
3993:
3994: =over 4
3995:
3996: =item - $wordlist
3997:
3998: String that will be fed into the spellcheck program.
3999:
4000: =item - $language
4001:
4002: Language string that specifies the language for which the spell
4003: check will be performed.
4004:
4005: =back
4006:
4007: =back
4008:
4009: Note: This sub assumes that aspell is installed.
4010:
4011:
4012: =cut
4013:
1.46 matthew 4014:
1.1090 foxr 4015: sub check_spelling {
4016: my ($wordlist, $language) = @_;
1.1091 foxr 4017: my @misspellings;
4018:
4019: # Generate the speller and set the langauge.
4020: # if explicitly selected:
1.1090 foxr 4021:
1.1091 foxr 4022: my $speller = Text::Aspell->new;
1.1090 foxr 4023: if ($language) {
1.1091 foxr 4024: $speller->set_option('lang', $language);
1.1090 foxr 4025: }
4026:
1.1091 foxr 4027: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 4028:
1.1091 foxr 4029: my @words = split(/\s+/, $wordlist);
1.1090 foxr 4030:
1.1091 foxr 4031: foreach my $word (@words) {
4032: if(! $speller->check($word)) {
4033: push(@misspellings, $word);
1.1090 foxr 4034: }
4035: }
1.1091 foxr 4036: return join(' ', @misspellings);
4037:
1.1090 foxr 4038: }
4039:
1.61 www 4040: # -------------------------------------------------------------- Plaintext name
1.81 albertel 4041: =pod
4042:
1.112 bowersj2 4043: =head1 User Name Functions
4044:
4045: =over 4
4046:
1.648 raeburn 4047: =item * &plainname($uname,$udom,$first)
1.81 albertel 4048:
1.112 bowersj2 4049: Takes a users logon name and returns it as a string in
1.226 albertel 4050: "first middle last generation" form
4051: if $first is set to 'lastname' then it returns it as
4052: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 4053:
4054: =cut
1.61 www 4055:
1.295 www 4056:
1.81 albertel 4057: ###############################################################
1.61 www 4058: sub plainname {
1.226 albertel 4059: my ($uname,$udom,$first)=@_;
1.537 albertel 4060: return if (!defined($uname) || !defined($udom));
1.295 www 4061: my %names=&getnames($uname,$udom);
1.226 albertel 4062: my $name=&Apache::lonnet::format_name($names{'firstname'},
4063: $names{'middlename'},
4064: $names{'lastname'},
4065: $names{'generation'},$first);
4066: $name=~s/^\s+//;
1.62 www 4067: $name=~s/\s+$//;
4068: $name=~s/\s+/ /g;
1.353 albertel 4069: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 4070: return $name;
1.61 www 4071: }
1.66 www 4072:
4073: # -------------------------------------------------------------------- Nickname
1.81 albertel 4074: =pod
4075:
1.648 raeburn 4076: =item * &nickname($uname,$udom)
1.81 albertel 4077:
4078: Gets a users name and returns it as a string as
4079:
4080: ""nickname""
1.66 www 4081:
1.81 albertel 4082: if the user has a nickname or
4083:
4084: "first middle last generation"
4085:
4086: if the user does not
4087:
4088: =cut
1.66 www 4089:
4090: sub nickname {
4091: my ($uname,$udom)=@_;
1.537 albertel 4092: return if (!defined($uname) || !defined($udom));
1.295 www 4093: my %names=&getnames($uname,$udom);
1.68 albertel 4094: my $name=$names{'nickname'};
1.66 www 4095: if ($name) {
4096: $name='"'.$name.'"';
4097: } else {
4098: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
4099: $names{'lastname'}.' '.$names{'generation'};
4100: $name=~s/\s+$//;
4101: $name=~s/\s+/ /g;
4102: }
4103: return $name;
4104: }
4105:
1.295 www 4106: sub getnames {
4107: my ($uname,$udom)=@_;
1.537 albertel 4108: return if (!defined($uname) || !defined($udom));
1.433 albertel 4109: if ($udom eq 'public' && $uname eq 'public') {
4110: return ('lastname' => &mt('Public'));
4111: }
1.295 www 4112: my $id=$uname.':'.$udom;
4113: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
4114: if ($cached) {
4115: return %{$names};
4116: } else {
4117: my %loadnames=&Apache::lonnet::get('environment',
4118: ['firstname','middlename','lastname','generation','nickname'],
4119: $udom,$uname);
4120: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
4121: return %loadnames;
4122: }
4123: }
1.61 www 4124:
1.542 raeburn 4125: # -------------------------------------------------------------------- getemails
1.648 raeburn 4126:
1.542 raeburn 4127: =pod
4128:
1.648 raeburn 4129: =item * &getemails($uname,$udom)
1.542 raeburn 4130:
4131: Gets a user's email information and returns it as a hash with keys:
4132: notification, critnotification, permanentemail
4133:
4134: For notification and critnotification, values are comma-separated lists
1.648 raeburn 4135: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 4136:
1.648 raeburn 4137:
1.542 raeburn 4138: =cut
4139:
1.648 raeburn 4140:
1.466 albertel 4141: sub getemails {
4142: my ($uname,$udom)=@_;
4143: if ($udom eq 'public' && $uname eq 'public') {
4144: return;
4145: }
1.467 www 4146: if (!$udom) { $udom=$env{'user.domain'}; }
4147: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 4148: my $id=$uname.':'.$udom;
4149: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
4150: if ($cached) {
4151: return %{$names};
4152: } else {
4153: my %loadnames=&Apache::lonnet::get('environment',
4154: ['notification','critnotification',
4155: 'permanentemail'],
4156: $udom,$uname);
4157: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
4158: return %loadnames;
4159: }
4160: }
4161:
1.551 albertel 4162: sub flush_email_cache {
4163: my ($uname,$udom)=@_;
4164: if (!$udom) { $udom =$env{'user.domain'}; }
4165: if (!$uname) { $uname=$env{'user.name'}; }
4166: return if ($udom eq 'public' && $uname eq 'public');
4167: my $id=$uname.':'.$udom;
4168: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
4169: }
4170:
1.728 raeburn 4171: # -------------------------------------------------------------------- getlangs
4172:
4173: =pod
4174:
4175: =item * &getlangs($uname,$udom)
4176:
4177: Gets a user's language preference and returns it as a hash with key:
4178: language.
4179:
4180: =cut
4181:
4182:
4183: sub getlangs {
4184: my ($uname,$udom) = @_;
4185: if (!$udom) { $udom =$env{'user.domain'}; }
4186: if (!$uname) { $uname=$env{'user.name'}; }
4187: my $id=$uname.':'.$udom;
4188: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
4189: if ($cached) {
4190: return %{$langs};
4191: } else {
4192: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
4193: $udom,$uname);
4194: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
4195: return %loadlangs;
4196: }
4197: }
4198:
4199: sub flush_langs_cache {
4200: my ($uname,$udom)=@_;
4201: if (!$udom) { $udom =$env{'user.domain'}; }
4202: if (!$uname) { $uname=$env{'user.name'}; }
4203: return if ($udom eq 'public' && $uname eq 'public');
4204: my $id=$uname.':'.$udom;
4205: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
4206: }
4207:
1.61 www 4208: # ------------------------------------------------------------------ Screenname
1.81 albertel 4209:
4210: =pod
4211:
1.648 raeburn 4212: =item * &screenname($uname,$udom)
1.81 albertel 4213:
4214: Gets a users screenname and returns it as a string
4215:
4216: =cut
1.61 www 4217:
4218: sub screenname {
4219: my ($uname,$udom)=@_;
1.258 albertel 4220: if ($uname eq $env{'user.name'} &&
4221: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 4222: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 4223: return $names{'screenname'};
1.62 www 4224: }
4225:
1.212 albertel 4226:
1.802 bisitz 4227: # ------------------------------------------------------------- Confirm Wrapper
4228: =pod
4229:
1.1142 raeburn 4230: =item * &confirmwrapper($message)
1.802 bisitz 4231:
4232: Wrap messages about completion of operation in box
4233:
4234: =cut
4235:
4236: sub confirmwrapper {
4237: my ($message)=@_;
4238: if ($message) {
4239: return "\n".'<div class="LC_confirm_box">'."\n"
4240: .$message."\n"
4241: .'</div>'."\n";
4242: } else {
4243: return $message;
4244: }
4245: }
4246:
1.62 www 4247: # ------------------------------------------------------------- Message Wrapper
4248:
4249: sub messagewrapper {
1.369 www 4250: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 4251: return
1.441 albertel 4252: '<a href="/adm/email?compose=individual&'.
4253: 'recname='.$username.'&recdom='.$domain.
4254: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 4255: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 4256: }
1.802 bisitz 4257:
1.74 www 4258: # --------------------------------------------------------------- Notes Wrapper
4259:
4260: sub noteswrapper {
4261: my ($link,$un,$do)=@_;
4262: return
1.896 amueller 4263: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 4264: }
1.802 bisitz 4265:
1.62 www 4266: # ------------------------------------------------------------- Aboutme Wrapper
4267:
4268: sub aboutmewrapper {
1.1070 raeburn 4269: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 4270: if (!defined($username) && !defined($domain)) {
4271: return;
4272: }
1.1096 raeburn 4273: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 4274: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 4275: }
4276:
4277: # ------------------------------------------------------------ Syllabus Wrapper
4278:
4279: sub syllabuswrapper {
1.707 bisitz 4280: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 4281: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 4282: }
1.14 harris41 4283:
1.802 bisitz 4284: # -----------------------------------------------------------------------------
4285:
1.208 matthew 4286: sub track_student_link {
1.887 raeburn 4287: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 4288: my $link ="/adm/trackstudent?";
1.208 matthew 4289: my $title = 'View recent activity';
4290: if (defined($sname) && $sname !~ /^\s*$/ &&
4291: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 4292: $link .= "selected_student=$sname:$sdom";
1.208 matthew 4293: $title .= ' of this student';
1.268 albertel 4294: }
1.208 matthew 4295: if (defined($target) && $target !~ /^\s*$/) {
4296: $target = qq{target="$target"};
4297: } else {
4298: $target = '';
4299: }
1.268 albertel 4300: if ($start) { $link.='&start='.$start; }
1.887 raeburn 4301: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 4302: $title = &mt($title);
4303: $linktext = &mt($linktext);
1.448 albertel 4304: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
4305: &help_open_topic('View_recent_activity');
1.208 matthew 4306: }
4307:
1.781 raeburn 4308: sub slot_reservations_link {
4309: my ($linktext,$sname,$sdom,$target) = @_;
4310: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4311: my $title = 'View slot reservation history';
4312: if (defined($sname) && $sname !~ /^\s*$/ &&
4313: defined($sdom) && $sdom !~ /^\s*$/) {
4314: $link .= "&uname=$sname&udom=$sdom";
4315: $title .= ' of this student';
4316: }
4317: if (defined($target) && $target !~ /^\s*$/) {
4318: $target = qq{target="$target"};
4319: } else {
4320: $target = '';
4321: }
4322: $title = &mt($title);
4323: $linktext = &mt($linktext);
4324: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4325: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4326:
4327: }
4328:
1.508 www 4329: # ===================================================== Display a student photo
4330:
4331:
1.509 albertel 4332: sub student_image_tag {
1.508 www 4333: my ($domain,$user)=@_;
4334: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4335: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4336: return '<img src="'.$imgsrc.'" align="right" />';
4337: } else {
4338: return '';
4339: }
4340: }
4341:
1.112 bowersj2 4342: =pod
4343:
4344: =back
4345:
4346: =head1 Access .tab File Data
4347:
4348: =over 4
4349:
1.648 raeburn 4350: =item * &languageids()
1.112 bowersj2 4351:
4352: returns list of all language ids
4353:
4354: =cut
4355:
1.14 harris41 4356: sub languageids {
1.16 harris41 4357: return sort(keys(%language));
1.14 harris41 4358: }
4359:
1.112 bowersj2 4360: =pod
4361:
1.648 raeburn 4362: =item * &languagedescription()
1.112 bowersj2 4363:
4364: returns description of a specified language id
4365:
4366: =cut
4367:
1.14 harris41 4368: sub languagedescription {
1.125 www 4369: my $code=shift;
4370: return ($supported_language{$code}?'* ':'').
4371: $language{$code}.
1.126 www 4372: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4373: }
4374:
1.1048 foxr 4375: =pod
4376:
4377: =item * &plainlanguagedescription
4378:
4379: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4380: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4381:
4382: =cut
4383:
1.145 www 4384: sub plainlanguagedescription {
4385: my $code=shift;
4386: return $language{$code};
4387: }
4388:
1.1048 foxr 4389: =pod
4390:
4391: =item * &supportedlanguagecode
4392:
4393: Returns the supported language code (e.g. sptutf maps to pt) given a language
4394: code.
4395:
4396: =cut
4397:
1.145 www 4398: sub supportedlanguagecode {
4399: my $code=shift;
4400: return $supported_language{$code};
1.97 www 4401: }
4402:
1.112 bowersj2 4403: =pod
4404:
1.1048 foxr 4405: =item * &latexlanguage()
4406:
4407: Given a language key code returns the correspondnig language to use
4408: to select the correct hyphenation on LaTeX printouts. This is undef if there
4409: is no supported hyphenation for the language code.
4410:
4411: =cut
4412:
4413: sub latexlanguage {
4414: my $code = shift;
4415: return $latex_language{$code};
4416: }
4417:
4418: =pod
4419:
4420: =item * &latexhyphenation()
4421:
4422: Same as above but what's supplied is the language as it might be stored
4423: in the metadata.
4424:
4425: =cut
4426:
4427: sub latexhyphenation {
4428: my $key = shift;
4429: return $latex_language_bykey{$key};
4430: }
4431:
4432: =pod
4433:
1.648 raeburn 4434: =item * ©rightids()
1.112 bowersj2 4435:
4436: returns list of all copyrights
4437:
4438: =cut
4439:
4440: sub copyrightids {
4441: return sort(keys(%cprtag));
4442: }
4443:
4444: =pod
4445:
1.648 raeburn 4446: =item * ©rightdescription()
1.112 bowersj2 4447:
4448: returns description of a specified copyright id
4449:
4450: =cut
4451:
4452: sub copyrightdescription {
1.166 www 4453: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4454: }
1.197 matthew 4455:
4456: =pod
4457:
1.648 raeburn 4458: =item * &source_copyrightids()
1.192 taceyjo1 4459:
4460: returns list of all source copyrights
4461:
4462: =cut
4463:
4464: sub source_copyrightids {
4465: return sort(keys(%scprtag));
4466: }
4467:
4468: =pod
4469:
1.648 raeburn 4470: =item * &source_copyrightdescription()
1.192 taceyjo1 4471:
4472: returns description of a specified source copyright id
4473:
4474: =cut
4475:
4476: sub source_copyrightdescription {
4477: return &mt($scprtag{shift(@_)});
4478: }
1.112 bowersj2 4479:
4480: =pod
4481:
1.648 raeburn 4482: =item * &filecategories()
1.112 bowersj2 4483:
4484: returns list of all file categories
4485:
4486: =cut
4487:
4488: sub filecategories {
4489: return sort(keys(%category_extensions));
4490: }
4491:
4492: =pod
4493:
1.648 raeburn 4494: =item * &filecategorytypes()
1.112 bowersj2 4495:
4496: returns list of file types belonging to a given file
4497: category
4498:
4499: =cut
4500:
4501: sub filecategorytypes {
1.356 albertel 4502: my ($cat) = @_;
1.1248 raeburn 4503: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4504: return @{$category_extensions{lc($cat)}};
4505: } else {
4506: return ();
4507: }
1.112 bowersj2 4508: }
4509:
4510: =pod
4511:
1.648 raeburn 4512: =item * &fileembstyle()
1.112 bowersj2 4513:
4514: returns embedding style for a specified file type
4515:
4516: =cut
4517:
4518: sub fileembstyle {
4519: return $fe{lc(shift(@_))};
1.169 www 4520: }
4521:
1.351 www 4522: sub filemimetype {
4523: return $fm{lc(shift(@_))};
4524: }
4525:
1.169 www 4526:
4527: sub filecategoryselect {
4528: my ($name,$value)=@_;
1.189 matthew 4529: return &select_form($value,$name,
1.970 raeburn 4530: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4531: }
4532:
4533: =pod
4534:
1.648 raeburn 4535: =item * &filedescription()
1.112 bowersj2 4536:
4537: returns description for a specified file type
4538:
4539: =cut
4540:
4541: sub filedescription {
1.188 matthew 4542: my $file_description = $fd{lc(shift())};
4543: $file_description =~ s:([\[\]]):~$1:g;
4544: return &mt($file_description);
1.112 bowersj2 4545: }
4546:
4547: =pod
4548:
1.648 raeburn 4549: =item * &filedescriptionex()
1.112 bowersj2 4550:
4551: returns description for a specified file type with
4552: extra formatting
4553:
4554: =cut
4555:
4556: sub filedescriptionex {
4557: my $ex=shift;
1.188 matthew 4558: my $file_description = $fd{lc($ex)};
4559: $file_description =~ s:([\[\]]):~$1:g;
4560: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4561: }
4562:
4563: # End of .tab access
4564: =pod
4565:
4566: =back
4567:
4568: =cut
4569:
4570: # ------------------------------------------------------------------ File Types
4571: sub fileextensions {
4572: return sort(keys(%fe));
4573: }
4574:
1.97 www 4575: # ----------------------------------------------------------- Display Languages
4576: # returns a hash with all desired display languages
4577: #
4578:
4579: sub display_languages {
4580: my %languages=();
1.695 raeburn 4581: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4582: $languages{$lang}=1;
1.97 www 4583: }
4584: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4585: if ($env{'form.displaylanguage'}) {
1.356 albertel 4586: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4587: $languages{$lang}=1;
1.97 www 4588: }
4589: }
4590: return %languages;
1.14 harris41 4591: }
4592:
1.582 albertel 4593: sub languages {
4594: my ($possible_langs) = @_;
1.695 raeburn 4595: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4596: if (!ref($possible_langs)) {
4597: if( wantarray ) {
4598: return @preferred_langs;
4599: } else {
4600: return $preferred_langs[0];
4601: }
4602: }
4603: my %possibilities = map { $_ => 1 } (@$possible_langs);
4604: my @preferred_possibilities;
4605: foreach my $preferred_lang (@preferred_langs) {
4606: if (exists($possibilities{$preferred_lang})) {
4607: push(@preferred_possibilities, $preferred_lang);
4608: }
4609: }
4610: if( wantarray ) {
4611: return @preferred_possibilities;
4612: }
4613: return $preferred_possibilities[0];
4614: }
4615:
1.742 raeburn 4616: sub user_lang {
4617: my ($touname,$toudom,$fromcid) = @_;
4618: my @userlangs;
4619: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4620: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4621: $env{'course.'.$fromcid.'.languages'}));
4622: } else {
4623: my %langhash = &getlangs($touname,$toudom);
4624: if ($langhash{'languages'} ne '') {
4625: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4626: } else {
4627: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4628: if ($domdefs{'lang_def'} ne '') {
4629: @userlangs = ($domdefs{'lang_def'});
4630: }
4631: }
4632: }
4633: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4634: my $user_lh = Apache::localize->get_handle(@languages);
4635: return $user_lh;
4636: }
4637:
4638:
1.112 bowersj2 4639: ###############################################################
4640: ## Student Answer Attempts ##
4641: ###############################################################
4642:
4643: =pod
4644:
4645: =head1 Alternate Problem Views
4646:
4647: =over 4
4648:
1.648 raeburn 4649: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4650: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4651:
4652: Return string with previous attempt on problem. Arguments:
4653:
4654: =over 4
4655:
4656: =item * $symb: Problem, including path
4657:
4658: =item * $username: username of the desired student
4659:
4660: =item * $domain: domain of the desired student
1.14 harris41 4661:
1.112 bowersj2 4662: =item * $course: Course ID
1.14 harris41 4663:
1.112 bowersj2 4664: =item * $getattempt: Leave blank for all attempts, otherwise put
4665: something
1.14 harris41 4666:
1.112 bowersj2 4667: =item * $regexp: if string matches this regexp, the string will be
4668: sent to $gradesub
1.14 harris41 4669:
1.112 bowersj2 4670: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4671:
1.1199 raeburn 4672: =item * $usec: section of the desired student
4673:
4674: =item * $identifier: counter for student (multiple students one problem) or
4675: problem (one student; whole sequence).
4676:
1.112 bowersj2 4677: =back
1.14 harris41 4678:
1.112 bowersj2 4679: The output string is a table containing all desired attempts, if any.
1.16 harris41 4680:
1.112 bowersj2 4681: =cut
1.1 albertel 4682:
4683: sub get_previous_attempt {
1.1199 raeburn 4684: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4685: my $prevattempts='';
1.43 ng 4686: no strict 'refs';
1.1 albertel 4687: if ($symb) {
1.3 albertel 4688: my (%returnhash)=
4689: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4690: if ($returnhash{'version'}) {
4691: my %lasthash=();
4692: my $version;
4693: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4694: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4695: if ($key =~ /\.rawrndseed$/) {
4696: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4697: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4698: } else {
4699: $lasthash{$key}=$returnhash{$version.':'.$key};
4700: }
1.19 harris41 4701: }
1.1 albertel 4702: }
1.596 albertel 4703: $prevattempts=&start_data_table().&start_data_table_header_row();
4704: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4705: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4706: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4707: foreach my $key (sort(keys(%lasthash))) {
4708: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4709: if ($#parts > 0) {
1.31 albertel 4710: my $data=$parts[-1];
1.989 raeburn 4711: next if ($data eq 'foilorder');
1.31 albertel 4712: pop(@parts);
1.1010 www 4713: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4714: if ($data eq 'type') {
4715: unless ($showsurv) {
4716: my $id = join(',',@parts);
4717: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4718: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4719: $lasthidden{$ign.'.'.$id} = 1;
4720: }
1.945 raeburn 4721: }
1.1199 raeburn 4722: if ($identifier ne '') {
4723: my $id = join(',',@parts);
4724: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4725: $domain,$username,$usec,undef,$course) =~ /^no/) {
4726: $hidestatus{$ign.'.'.$id} = 1;
4727: }
4728: }
4729: } elsif ($data eq 'regrader') {
4730: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4731: my $id = join(',',@parts);
4732: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4733: }
1.1010 www 4734: }
1.31 albertel 4735: } else {
1.41 ng 4736: if ($#parts == 0) {
4737: $prevattempts.='<th>'.$parts[0].'</th>';
4738: } else {
4739: $prevattempts.='<th>'.$ign.'</th>';
4740: }
1.31 albertel 4741: }
1.16 harris41 4742: }
1.596 albertel 4743: $prevattempts.=&end_data_table_header_row();
1.40 ng 4744: if ($getattempt eq '') {
1.1199 raeburn 4745: my (%solved,%resets,%probstatus);
1.1200 raeburn 4746: if (($identifier ne '') && (keys(%regraded) > 0)) {
4747: for ($version=1;$version<=$returnhash{'version'};$version++) {
4748: foreach my $id (keys(%regraded)) {
4749: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4750: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4751: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4752: push(@{$resets{$id}},$version);
1.1199 raeburn 4753: }
4754: }
4755: }
1.1200 raeburn 4756: }
4757: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4758: my (@hidden,@unsolved);
1.945 raeburn 4759: if (%typeparts) {
4760: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4761: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4762: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4763: push(@hidden,$id);
1.1199 raeburn 4764: } elsif ($identifier ne '') {
4765: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4766: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4767: ($hidestatus{$id})) {
1.1200 raeburn 4768: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4769: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4770: push(@{$solved{$id}},$version);
4771: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4772: (ref($solved{$id}) eq 'ARRAY')) {
4773: my $skip;
4774: if (ref($resets{$id}) eq 'ARRAY') {
4775: foreach my $reset (@{$resets{$id}}) {
4776: if ($reset > $solved{$id}[-1]) {
4777: $skip=1;
4778: last;
4779: }
4780: }
4781: }
4782: unless ($skip) {
4783: my ($ign,$partslist) = split(/\./,$id,2);
4784: push(@unsolved,$partslist);
4785: }
4786: }
4787: }
1.945 raeburn 4788: }
4789: }
4790: }
4791: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4792: '<td>'.&mt('Transaction [_1]',$version);
4793: if (@unsolved) {
4794: $prevattempts .= '<span class="LC_nobreak"><label>'.
4795: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4796: &mt('Hide').'</label></span>';
4797: }
4798: $prevattempts .= '</td>';
1.945 raeburn 4799: if (@hidden) {
4800: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4801: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4802: my $hide;
4803: foreach my $id (@hidden) {
4804: if ($key =~ /^\Q$id\E/) {
4805: $hide = 1;
4806: last;
4807: }
4808: }
4809: if ($hide) {
4810: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4811: if (($data eq 'award') || ($data eq 'awarddetail')) {
4812: my $value = &format_previous_attempt_value($key,
4813: $returnhash{$version.':'.$key});
1.1173 kruse 4814: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4815: } else {
4816: $prevattempts.='<td> </td>';
4817: }
4818: } else {
4819: if ($key =~ /\./) {
1.1212 raeburn 4820: my $value = $returnhash{$version.':'.$key};
4821: if ($key =~ /\.rndseed$/) {
4822: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4823: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4824: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4825: }
4826: }
4827: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4828: ' </td>';
1.945 raeburn 4829: } else {
4830: $prevattempts.='<td> </td>';
4831: }
4832: }
4833: }
4834: } else {
4835: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4836: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4837: my $value = $returnhash{$version.':'.$key};
4838: if ($key =~ /\.rndseed$/) {
4839: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4840: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4841: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4842: }
4843: }
4844: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4845: ' </td>';
1.945 raeburn 4846: }
4847: }
4848: $prevattempts.=&end_data_table_row();
1.40 ng 4849: }
1.1 albertel 4850: }
1.945 raeburn 4851: my @currhidden = keys(%lasthidden);
1.596 albertel 4852: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4853: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4854: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4855: if (%typeparts) {
4856: my $hidden;
4857: foreach my $id (@currhidden) {
4858: if ($key =~ /^\Q$id\E/) {
4859: $hidden = 1;
4860: last;
4861: }
4862: }
4863: if ($hidden) {
4864: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4865: if (($data eq 'award') || ($data eq 'awarddetail')) {
4866: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4867: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4868: $value = &$gradesub($value);
4869: }
1.1173 kruse 4870: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4871: } else {
4872: $prevattempts.='<td> </td>';
4873: }
4874: } else {
4875: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4876: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4877: $value = &$gradesub($value);
4878: }
1.1173 kruse 4879: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4880: }
4881: } else {
4882: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4883: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4884: $value = &$gradesub($value);
4885: }
1.1173 kruse 4886: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4887: }
1.16 harris41 4888: }
1.596 albertel 4889: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4890: } else {
1.1305 raeburn 4891: my $msg;
4892: if ($symb =~ /ext\.tool$/) {
4893: $msg = &mt('No grade passed back.');
4894: } else {
4895: $msg = &mt('Nothing submitted - no attempts.');
4896: }
1.596 albertel 4897: $prevattempts=
4898: &start_data_table().&start_data_table_row().
1.1305 raeburn 4899: '<td>'.$msg.'</td>'.
1.596 albertel 4900: &end_data_table_row().&end_data_table();
1.1 albertel 4901: }
4902: } else {
1.596 albertel 4903: $prevattempts=
4904: &start_data_table().&start_data_table_row().
4905: '<td>'.&mt('No data.').'</td>'.
4906: &end_data_table_row().&end_data_table();
1.1 albertel 4907: }
1.10 albertel 4908: }
4909:
1.581 albertel 4910: sub format_previous_attempt_value {
4911: my ($key,$value) = @_;
1.1011 www 4912: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4913: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4914: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4915: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4916: } elsif ($key =~ /answerstring$/) {
4917: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4918: my @answer = %answers;
4919: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4920: my @anskeys = sort(keys(%answers));
4921: if (@anskeys == 1) {
4922: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4923: if ($answer =~ m{\0}) {
4924: $answer =~ s{\0}{,}g;
1.988 raeburn 4925: }
4926: my $tag_internal_answer_name = 'INTERNAL';
4927: if ($anskeys[0] eq $tag_internal_answer_name) {
4928: $value = $answer;
4929: } else {
4930: $value = $anskeys[0].'='.$answer;
4931: }
4932: } else {
4933: foreach my $ans (@anskeys) {
4934: my $answer = $answers{$ans};
1.1001 raeburn 4935: if ($answer =~ m{\0}) {
4936: $answer =~ s{\0}{,}g;
1.988 raeburn 4937: }
4938: $value .= $ans.'='.$answer.'<br />';;
4939: }
4940: }
1.581 albertel 4941: } else {
1.1173 kruse 4942: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4943: }
4944: return $value;
4945: }
4946:
4947:
1.107 albertel 4948: sub relative_to_absolute {
4949: my ($url,$output)=@_;
4950: my $parser=HTML::TokeParser->new(\$output);
4951: my $token;
4952: my $thisdir=$url;
4953: my @rlinks=();
4954: while ($token=$parser->get_token) {
4955: if ($token->[0] eq 'S') {
4956: if ($token->[1] eq 'a') {
4957: if ($token->[2]->{'href'}) {
4958: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4959: }
4960: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4961: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4962: } elsif ($token->[1] eq 'base') {
4963: $thisdir=$token->[2]->{'href'};
4964: }
4965: }
4966: }
4967: $thisdir=~s-/[^/]*$--;
1.356 albertel 4968: foreach my $link (@rlinks) {
1.726 raeburn 4969: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4970: ($link=~/^\//) ||
4971: ($link=~/^javascript:/i) ||
4972: ($link=~/^mailto:/i) ||
4973: ($link=~/^\#/)) {
4974: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4975: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4976: }
4977: }
4978: # -------------------------------------------------- Deal with Applet codebases
4979: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4980: return $output;
4981: }
4982:
1.112 bowersj2 4983: =pod
4984:
1.648 raeburn 4985: =item * &get_student_view()
1.112 bowersj2 4986:
4987: show a snapshot of what student was looking at
4988:
4989: =cut
4990:
1.10 albertel 4991: sub get_student_view {
1.186 albertel 4992: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4993: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4994: my (%form);
1.10 albertel 4995: my @elements=('symb','courseid','domain','username');
4996: foreach my $element (@elements) {
1.186 albertel 4997: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4998: }
1.186 albertel 4999: if (defined($moreenv)) {
5000: %form=(%form,%{$moreenv});
5001: }
1.236 albertel 5002: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 5003: $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306 raeburn 5004: if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
5005: $feedurl =~ s{^/adm/wrapper}{};
5006: }
1.650 www 5007: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 5008: $userview=~s/\<body[^\>]*\>//gi;
5009: $userview=~s/\<\/body\>//gi;
5010: $userview=~s/\<html\>//gi;
5011: $userview=~s/\<\/html\>//gi;
5012: $userview=~s/\<head\>//gi;
5013: $userview=~s/\<\/head\>//gi;
5014: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 5015: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 5016: if (wantarray) {
5017: return ($userview,$response);
5018: } else {
5019: return $userview;
5020: }
5021: }
5022:
5023: sub get_student_view_with_retries {
5024: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
5025:
5026: my $ok = 0; # True if we got a good response.
5027: my $content;
5028: my $response;
5029:
5030: # Try to get the student_view done. within the retries count:
5031:
5032: do {
5033: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
5034: $ok = $response->is_success;
5035: if (!$ok) {
5036: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
5037: }
5038: $retries--;
5039: } while (!$ok && ($retries > 0));
5040:
5041: if (!$ok) {
5042: $content = ''; # On error return an empty content.
5043: }
1.651 www 5044: if (wantarray) {
5045: return ($content, $response);
5046: } else {
5047: return $content;
5048: }
1.11 albertel 5049: }
5050:
1.1349 raeburn 5051: sub css_links {
5052: my ($currsymb,$level) = @_;
5053: my ($links,@symbs,%cssrefs,%httpref);
5054: if ($level eq 'map') {
5055: my $navmap = Apache::lonnavmaps::navmap->new();
5056: if (ref($navmap)) {
5057: my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
5058: my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
5059: foreach my $res (@resources) {
5060: if (ref($res) && $res->symb()) {
5061: push(@symbs,$res->symb());
5062: }
5063: }
5064: }
5065: } else {
5066: @symbs = ($currsymb);
5067: }
5068: foreach my $symb (@symbs) {
5069: my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
5070: if ($css_href =~ /\S/) {
5071: unless ($css_href =~ m{https?://}) {
5072: my $url = (&Apache::lonnet::decode_symb($symb))[-1];
5073: my $proburl = &Apache::lonnet::clutter($url);
5074: my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
5075: unless ($css_href =~ m{^/}) {
5076: $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
5077: }
5078: if ($css_href =~ m{^/(res|uploaded)/}) {
5079: unless (($httpref{'httpref.'.$css_href}) ||
5080: (&Apache::lonnet::is_on_map($css_href))) {
5081: my $thisurl = $proburl;
5082: if ($env{'httpref.'.$proburl}) {
5083: $thisurl = $env{'httpref.'.$proburl};
5084: }
5085: $httpref{'httpref.'.$css_href} = $thisurl;
5086: }
5087: }
5088: }
5089: $cssrefs{$css_href} = 1;
5090: }
5091: }
5092: if (keys(%httpref)) {
5093: &Apache::lonnet::appenv(\%httpref);
5094: }
5095: if (keys(%cssrefs)) {
5096: foreach my $css_href (keys(%cssrefs)) {
5097: next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
5098: $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
5099: }
5100: }
5101: return $links;
5102: }
5103:
1.112 bowersj2 5104: =pod
5105:
1.648 raeburn 5106: =item * &get_student_answers()
1.112 bowersj2 5107:
5108: show a snapshot of how student was answering problem
5109:
5110: =cut
5111:
1.11 albertel 5112: sub get_student_answers {
1.100 sakharuk 5113: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 5114: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5115: my (%moreenv);
1.11 albertel 5116: my @elements=('symb','courseid','domain','username');
5117: foreach my $element (@elements) {
1.186 albertel 5118: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5119: }
1.186 albertel 5120: $moreenv{'grade_target'}='answer';
5121: %moreenv=(%form,%moreenv);
1.497 raeburn 5122: $feedurl = &Apache::lonnet::clutter($feedurl);
5123: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 5124: return $userview;
1.1 albertel 5125: }
1.116 albertel 5126:
5127: =pod
5128:
5129: =item * &submlink()
5130:
1.242 albertel 5131: Inputs: $text $uname $udom $symb $target
1.116 albertel 5132:
5133: Returns: A link to grades.pm such as to see the SUBM view of a student
5134:
5135: =cut
5136:
5137: ###############################################
5138: sub submlink {
1.242 albertel 5139: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 5140: if (!($uname && $udom)) {
5141: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5142: &Apache::lonnet::whichuser($symb);
1.116 albertel 5143: if (!$symb) { $symb=$cursymb; }
5144: }
1.254 matthew 5145: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5146: $symb=&escape($symb);
1.960 bisitz 5147: if ($target) { $target=" target=\"$target\""; }
5148: return
5149: '<a href="/adm/grades?command=submission'.
5150: '&symb='.$symb.
5151: '&student='.$uname.
5152: '&userdom='.$udom.'"'.
5153: $target.'>'.$text.'</a>';
1.242 albertel 5154: }
5155: ##############################################
5156:
5157: =pod
5158:
5159: =item * &pgrdlink()
5160:
5161: Inputs: $text $uname $udom $symb $target
5162:
5163: Returns: A link to grades.pm such as to see the PGRD view of a student
5164:
5165: =cut
5166:
5167: ###############################################
5168: sub pgrdlink {
5169: my $link=&submlink(@_);
5170: $link=~s/(&command=submission)/$1&showgrading=yes/;
5171: return $link;
5172: }
5173: ##############################################
5174:
5175: =pod
5176:
5177: =item * &pprmlink()
5178:
5179: Inputs: $text $uname $udom $symb $target
5180:
5181: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 5182: student and a specific resource
1.242 albertel 5183:
5184: =cut
5185:
5186: ###############################################
5187: sub pprmlink {
5188: my ($text,$uname,$udom,$symb,$target)=@_;
5189: if (!($uname && $udom)) {
5190: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5191: &Apache::lonnet::whichuser($symb);
1.242 albertel 5192: if (!$symb) { $symb=$cursymb; }
5193: }
1.254 matthew 5194: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5195: $symb=&escape($symb);
1.242 albertel 5196: if ($target) { $target="target=\"$target\""; }
1.595 albertel 5197: return '<a href="/adm/parmset?command=set&'.
5198: 'symb='.$symb.'&uname='.$uname.
5199: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 5200: }
5201: ##############################################
1.37 matthew 5202:
1.112 bowersj2 5203: =pod
5204:
5205: =back
5206:
5207: =cut
5208:
1.37 matthew 5209: ###############################################
1.51 www 5210:
5211:
5212: sub timehash {
1.687 raeburn 5213: my ($thistime) = @_;
5214: my $timezone = &Apache::lonlocal::gettimezone();
5215: my $dt = DateTime->from_epoch(epoch => $thistime)
5216: ->set_time_zone($timezone);
5217: my $wday = $dt->day_of_week();
5218: if ($wday == 7) { $wday = 0; }
5219: return ( 'second' => $dt->second(),
5220: 'minute' => $dt->minute(),
5221: 'hour' => $dt->hour(),
5222: 'day' => $dt->day_of_month(),
5223: 'month' => $dt->month(),
5224: 'year' => $dt->year(),
5225: 'weekday' => $wday,
5226: 'dayyear' => $dt->day_of_year(),
5227: 'dlsav' => $dt->is_dst() );
1.51 www 5228: }
5229:
1.370 www 5230: sub utc_string {
5231: my ($date)=@_;
1.371 www 5232: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 5233: }
5234:
1.51 www 5235: sub maketime {
5236: my %th=@_;
1.687 raeburn 5237: my ($epoch_time,$timezone,$dt);
5238: $timezone = &Apache::lonlocal::gettimezone();
5239: eval {
5240: $dt = DateTime->new( year => $th{'year'},
5241: month => $th{'month'},
5242: day => $th{'day'},
5243: hour => $th{'hour'},
5244: minute => $th{'minute'},
5245: second => $th{'second'},
5246: time_zone => $timezone,
5247: );
5248: };
5249: if (!$@) {
5250: $epoch_time = $dt->epoch;
5251: if ($epoch_time) {
5252: return $epoch_time;
5253: }
5254: }
1.51 www 5255: return POSIX::mktime(
5256: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 5257: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 5258: }
5259:
5260: #########################################
1.51 www 5261:
5262: sub findallcourses {
1.482 raeburn 5263: my ($roles,$uname,$udom) = @_;
1.355 albertel 5264: my %roles;
5265: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 5266: my %courses;
1.51 www 5267: my $now=time;
1.482 raeburn 5268: if (!defined($uname)) {
5269: $uname = $env{'user.name'};
5270: }
5271: if (!defined($udom)) {
5272: $udom = $env{'user.domain'};
5273: }
5274: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 5275: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 5276: if (!%roles) {
5277: %roles = (
5278: cc => 1,
1.907 raeburn 5279: co => 1,
1.482 raeburn 5280: in => 1,
5281: ep => 1,
5282: ta => 1,
5283: cr => 1,
5284: st => 1,
5285: );
5286: }
5287: foreach my $entry (keys(%roleshash)) {
5288: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
5289: if ($trole =~ /^cr/) {
5290: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
5291: } else {
5292: next if (!exists($roles{$trole}));
5293: }
5294: if ($tend) {
5295: next if ($tend < $now);
5296: }
5297: if ($tstart) {
5298: next if ($tstart > $now);
5299: }
1.1058 raeburn 5300: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 5301: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 5302: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 5303: if ($secpart eq '') {
5304: ($cnum,$role) = split(/_/,$cnumpart);
5305: $sec = 'none';
1.1058 raeburn 5306: $value .= $cnum.'/';
1.482 raeburn 5307: } else {
5308: $cnum = $cnumpart;
5309: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 5310: $value .= $cnum.'/'.$sec;
5311: }
5312: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5313: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5314: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5315: }
5316: } else {
5317: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 5318: }
1.482 raeburn 5319: }
5320: } else {
5321: foreach my $key (keys(%env)) {
1.483 albertel 5322: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
5323: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 5324: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
5325: next if ($role eq 'ca' || $role eq 'aa');
5326: next if (%roles && !exists($roles{$role}));
5327: my ($starttime,$endtime)=split(/\./,$env{$key});
5328: my $active=1;
5329: if ($starttime) {
5330: if ($now<$starttime) { $active=0; }
5331: }
5332: if ($endtime) {
5333: if ($now>$endtime) { $active=0; }
5334: }
5335: if ($active) {
1.1058 raeburn 5336: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 5337: if ($sec eq '') {
5338: $sec = 'none';
1.1058 raeburn 5339: } else {
5340: $value .= $sec;
5341: }
5342: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5343: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5344: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5345: }
5346: } else {
5347: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 5348: }
1.474 raeburn 5349: }
5350: }
1.51 www 5351: }
5352: }
1.474 raeburn 5353: return %courses;
1.51 www 5354: }
1.37 matthew 5355:
1.54 www 5356: ###############################################
1.474 raeburn 5357:
5358: sub blockcheck {
1.1372 raeburn 5359: my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
5360: unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
5361: my ($has_evb,$check_ipaccess);
5362: my $dom = $env{'user.domain'};
5363: if ($env{'request.course.id'}) {
5364: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5365: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
5366: my $checkrole = "cm./$cdom/$cnum";
5367: my $sec = $env{'request.course.sec'};
5368: if ($sec ne '') {
5369: $checkrole .= "/$sec";
5370: }
5371: if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
5372: ($env{'request.role'} !~ /^st/)) {
5373: $has_evb = 1;
5374: }
5375: unless ($has_evb) {
5376: if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
5377: ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
5378: if ($udom eq $cdom) {
5379: $check_ipaccess = 1;
5380: }
5381: }
5382: }
1.1375 raeburn 5383: } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
5384: ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
5385: my $checkrole;
5386: if ($env{'request.role.domain'} eq '') {
5387: $checkrole = "cm./$env{'user.domain'}/";
5388: } else {
5389: $checkrole = "cm./$env{'request.role.domain'}/";
5390: }
5391: if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
5392: $has_evb = 1;
5393: }
1.1372 raeburn 5394: }
5395: unless ($has_evb || $check_ipaccess) {
5396: my @machinedoms = &Apache::lonnet::current_machine_domains();
5397: if (($dom eq 'public') && ($activity eq 'port')) {
5398: $dom = $udom;
5399: }
5400: if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
5401: $check_ipaccess = 1;
5402: } else {
5403: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
5404: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
5405: my $prim = &Apache::lonnet::domain($dom,'primary');
5406: my $intdom = &Apache::lonnet::internet_dom($prim);
5407: if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
5408: if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
5409: $check_ipaccess = 1;
5410: }
5411: }
5412: }
5413: }
5414: if ($check_ipaccess) {
5415: my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
5416: unless (defined($cached)) {
5417: my %domconfig =
5418: &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
5419: $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
5420: }
5421: if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
5422: foreach my $id (keys(%{$ipaccessref})) {
5423: if (ref($ipaccessref->{$id}) eq 'HASH') {
5424: my $range = $ipaccessref->{$id}->{'ip'};
5425: if ($range) {
5426: if (&Apache::lonnet::ip_match($clientip,$range)) {
5427: if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
5428: if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
5429: return ('','','',$id,$dom);
5430: last;
5431: }
5432: }
5433: }
5434: }
5435: }
5436: }
5437: }
5438: }
1.1373 raeburn 5439: if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5440: return ();
5441: }
1.1372 raeburn 5442: }
1.1189 raeburn 5443: if (defined($udom) && defined($uname)) {
5444: # If uname and udom are for a course, check for blocks in the course.
5445: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5446: my ($startblock,$endblock,$triggerblock) =
1.1347 raeburn 5447: &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1189 raeburn 5448: return ($startblock,$endblock,$triggerblock);
5449: }
5450: } else {
1.490 raeburn 5451: $udom = $env{'user.domain'};
5452: $uname = $env{'user.name'};
5453: }
5454:
1.502 raeburn 5455: my $startblock = 0;
5456: my $endblock = 0;
1.1062 raeburn 5457: my $triggerblock = '';
1.1373 raeburn 5458: my %live_courses;
5459: unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5460: %live_courses = &findallcourses(undef,$uname,$udom);
5461: }
1.474 raeburn 5462:
1.490 raeburn 5463: # If uname is for a user, and activity is course-specific, i.e.,
5464: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5465:
1.490 raeburn 5466: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5467: $activity eq 'groups' || $activity eq 'printout' ||
1.1346 raeburn 5468: $activity eq 'search' || $activity eq 'reinit' ||
5469: $activity eq 'alert') &&
1.1189 raeburn 5470: ($env{'request.course.id'})) {
1.490 raeburn 5471: foreach my $key (keys(%live_courses)) {
5472: if ($key ne $env{'request.course.id'}) {
5473: delete($live_courses{$key});
5474: }
5475: }
5476: }
5477:
5478: my $otheruser = 0;
5479: my %own_courses;
5480: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5481: # Resource belongs to user other than current user.
5482: $otheruser = 1;
5483: # Gather courses for current user
5484: %own_courses =
5485: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5486: }
5487:
5488: # Gather active course roles - course coordinator, instructor,
5489: # exam proctor, ta, student, or custom role.
1.474 raeburn 5490:
5491: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5492: my ($cdom,$cnum);
5493: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5494: $cdom = $env{'course.'.$course.'.domain'};
5495: $cnum = $env{'course.'.$course.'.num'};
5496: } else {
1.490 raeburn 5497: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5498: }
5499: my $no_ownblock = 0;
5500: my $no_userblock = 0;
1.533 raeburn 5501: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5502: # Check if current user has 'evb' priv for this
5503: if (defined($own_courses{$course})) {
5504: foreach my $sec (keys(%{$own_courses{$course}})) {
5505: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5506: if ($sec ne 'none') {
5507: $checkrole .= '/'.$sec;
5508: }
5509: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5510: $no_ownblock = 1;
5511: last;
5512: }
5513: }
5514: }
5515: # if they have 'evb' priv and are currently not playing student
5516: next if (($no_ownblock) &&
5517: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5518: }
1.474 raeburn 5519: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5520: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5521: if ($sec ne 'none') {
1.482 raeburn 5522: $checkrole .= '/'.$sec;
1.474 raeburn 5523: }
1.490 raeburn 5524: if ($otheruser) {
5525: # Resource belongs to user other than current user.
5526: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5527: my (%allroles,%userroles);
5528: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5529: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5530: my ($trole,$tdom,$tnum,$tsec);
5531: if ($entry =~ /^cr/) {
5532: ($trole,$tdom,$tnum,$tsec) =
5533: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5534: } else {
5535: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5536: }
5537: my ($spec,$area,$trest);
5538: $area = '/'.$tdom.'/'.$tnum;
5539: $trest = $tnum;
5540: if ($tsec ne '') {
5541: $area .= '/'.$tsec;
5542: $trest .= '/'.$tsec;
5543: }
5544: $spec = $trole.'.'.$area;
5545: if ($trole =~ /^cr/) {
5546: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5547: $tdom,$spec,$trest,$area);
5548: } else {
5549: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5550: $tdom,$spec,$trest,$area);
5551: }
5552: }
1.1276 raeburn 5553: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5554: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5555: if ($1) {
5556: $no_userblock = 1;
5557: last;
5558: }
1.486 raeburn 5559: }
5560: }
1.490 raeburn 5561: } else {
5562: # Resource belongs to current user
5563: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5564: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5565: $no_ownblock = 1;
5566: last;
5567: }
1.474 raeburn 5568: }
5569: }
5570: # if they have the evb priv and are currently not playing student
1.482 raeburn 5571: next if (($no_ownblock) &&
1.491 albertel 5572: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5573: next if ($no_userblock);
1.474 raeburn 5574:
1.1303 raeburn 5575: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5576: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5577:
1.1062 raeburn 5578: my ($start,$end,$trigger) =
1.1347 raeburn 5579: &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502 raeburn 5580: if (($start != 0) &&
5581: (($startblock == 0) || ($startblock > $start))) {
5582: $startblock = $start;
1.1062 raeburn 5583: if ($trigger ne '') {
5584: $triggerblock = $trigger;
5585: }
1.502 raeburn 5586: }
5587: if (($end != 0) &&
5588: (($endblock == 0) || ($endblock < $end))) {
5589: $endblock = $end;
1.1062 raeburn 5590: if ($trigger ne '') {
5591: $triggerblock = $trigger;
5592: }
1.502 raeburn 5593: }
1.490 raeburn 5594: }
1.1062 raeburn 5595: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5596: }
5597:
5598: sub get_blocks {
1.1347 raeburn 5599: my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490 raeburn 5600: my $startblock = 0;
5601: my $endblock = 0;
1.1062 raeburn 5602: my $triggerblock = '';
1.490 raeburn 5603: my $course = $cdom.'_'.$cnum;
5604: $setters->{$course} = {};
5605: $setters->{$course}{'staff'} = [];
5606: $setters->{$course}{'times'} = [];
1.1062 raeburn 5607: $setters->{$course}{'triggers'} = [];
5608: my (@blockers,%triggered);
5609: my $now = time;
5610: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5611: if ($activity eq 'docs') {
1.1348 raeburn 5612: my ($blocked,$nosymbcache,$noenccheck);
1.1347 raeburn 5613: if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
5614: $blocked = 1;
5615: $nosymbcache = 1;
1.1348 raeburn 5616: $noenccheck = 1;
1.1347 raeburn 5617: }
1.1348 raeburn 5618: @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062 raeburn 5619: foreach my $block (@blockers) {
5620: if ($block =~ /^firstaccess____(.+)$/) {
5621: my $item = $1;
5622: my $type = 'map';
5623: my $timersymb = $item;
5624: if ($item eq 'course') {
5625: $type = 'course';
5626: } elsif ($item =~ /___\d+___/) {
5627: $type = 'resource';
5628: } else {
5629: $timersymb = &Apache::lonnet::symbread($item);
5630: }
5631: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5632: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5633: $triggered{$block} = {
5634: start => $start,
5635: end => $end,
5636: type => $type,
5637: };
5638: }
5639: }
5640: } else {
5641: foreach my $block (keys(%commblocks)) {
5642: if ($block =~ m/^(\d+)____(\d+)$/) {
5643: my ($start,$end) = ($1,$2);
5644: if ($start <= time && $end >= time) {
5645: if (ref($commblocks{$block}) eq 'HASH') {
5646: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5647: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5648: unless(grep(/^\Q$block\E$/,@blockers)) {
5649: push(@blockers,$block);
5650: }
5651: }
5652: }
5653: }
5654: }
5655: } elsif ($block =~ /^firstaccess____(.+)$/) {
5656: my $item = $1;
5657: my $timersymb = $item;
5658: my $type = 'map';
5659: if ($item eq 'course') {
5660: $type = 'course';
5661: } elsif ($item =~ /___\d+___/) {
5662: $type = 'resource';
5663: } else {
5664: $timersymb = &Apache::lonnet::symbread($item);
5665: }
5666: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5667: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5668: if ($start && $end) {
5669: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5670: if (ref($commblocks{$block}) eq 'HASH') {
5671: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5672: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5673: unless(grep(/^\Q$block\E$/,@blockers)) {
5674: push(@blockers,$block);
5675: $triggered{$block} = {
5676: start => $start,
5677: end => $end,
5678: type => $type,
5679: };
5680: }
5681: }
5682: }
1.1062 raeburn 5683: }
5684: }
1.490 raeburn 5685: }
1.1062 raeburn 5686: }
5687: }
5688: }
5689: foreach my $blocker (@blockers) {
5690: my ($staff_name,$staff_dom,$title,$blocks) =
5691: &parse_block_record($commblocks{$blocker});
5692: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5693: my ($start,$end,$triggertype);
5694: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5695: ($start,$end) = ($1,$2);
5696: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5697: $start = $triggered{$blocker}{'start'};
5698: $end = $triggered{$blocker}{'end'};
5699: $triggertype = $triggered{$blocker}{'type'};
5700: }
5701: if ($start) {
5702: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5703: if ($triggertype) {
5704: push(@{$$setters{$course}{'triggers'}},$triggertype);
5705: } else {
5706: push(@{$$setters{$course}{'triggers'}},0);
5707: }
5708: if ( ($startblock == 0) || ($startblock > $start) ) {
5709: $startblock = $start;
5710: if ($triggertype) {
5711: $triggerblock = $blocker;
1.474 raeburn 5712: }
5713: }
1.1062 raeburn 5714: if ( ($endblock == 0) || ($endblock < $end) ) {
5715: $endblock = $end;
5716: if ($triggertype) {
5717: $triggerblock = $blocker;
5718: }
5719: }
1.474 raeburn 5720: }
5721: }
1.1062 raeburn 5722: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5723: }
5724:
5725: sub parse_block_record {
5726: my ($record) = @_;
5727: my ($setuname,$setudom,$title,$blocks);
5728: if (ref($record) eq 'HASH') {
5729: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5730: $title = &unescape($record->{'event'});
5731: $blocks = $record->{'blocks'};
5732: } else {
5733: my @data = split(/:/,$record,3);
5734: if (scalar(@data) eq 2) {
5735: $title = $data[1];
5736: ($setuname,$setudom) = split(/@/,$data[0]);
5737: } else {
5738: ($setuname,$setudom,$title) = @data;
5739: }
5740: $blocks = { 'com' => 'on' };
5741: }
5742: return ($setuname,$setudom,$title,$blocks);
5743: }
5744:
1.854 kalberla 5745: sub blocking_status {
1.1372 raeburn 5746: my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061 raeburn 5747: my %setters;
1.890 droeschl 5748:
1.1061 raeburn 5749: # check for active blocking
1.1372 raeburn 5750: if ($clientip eq '') {
5751: $clientip = &Apache::lonnet::get_requestor_ip();
5752: }
5753: my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
5754: &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062 raeburn 5755: my $blocked = 0;
1.1372 raeburn 5756: if (($startblock && $endblock) || ($by_ip)) {
1.1062 raeburn 5757: $blocked = 1;
5758: }
1.890 droeschl 5759:
1.1061 raeburn 5760: # caller just wants to know whether a block is active
5761: if (!wantarray) { return $blocked; }
5762:
5763: # build a link to a popup window containing the details
5764: my $querystring = "?activity=$activity";
1.1351 raeburn 5765: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
5766: if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1232 raeburn 5767: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5768: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5769: } elsif ($activity eq 'docs') {
1.1347 raeburn 5770: my $showurl = &Apache::lonenc::check_encrypt($url);
5771: $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
5772: if ($symb) {
5773: my $showsymb = &Apache::lonenc::check_encrypt($symb);
5774: $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
5775: }
1.1062 raeburn 5776: }
1.1061 raeburn 5777:
5778: my $output .= <<'END_MYBLOCK';
5779: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5780: var options = "width=" + w + ",height=" + h + ",";
5781: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5782: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5783: var newWin = window.open(url, wdwName, options);
5784: newWin.focus();
5785: }
1.890 droeschl 5786: END_MYBLOCK
1.854 kalberla 5787:
1.1061 raeburn 5788: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5789:
1.1061 raeburn 5790: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5791: my $text = &mt('Communication Blocked');
1.1217 raeburn 5792: my $class = 'LC_comblock';
1.1062 raeburn 5793: if ($activity eq 'docs') {
5794: $text = &mt('Content Access Blocked');
1.1217 raeburn 5795: $class = '';
1.1063 raeburn 5796: } elsif ($activity eq 'printout') {
5797: $text = &mt('Printing Blocked');
1.1232 raeburn 5798: } elsif ($activity eq 'passwd') {
5799: $text = &mt('Password Changing Blocked');
1.1345 raeburn 5800: } elsif ($activity eq 'grades') {
5801: $text = &mt('Gradebook Blocked');
1.1346 raeburn 5802: } elsif ($activity eq 'search') {
5803: $text = &mt('Search Blocked');
1.1282 raeburn 5804: } elsif ($activity eq 'alert') {
5805: $text = &mt('Checking Critical Messages Blocked');
5806: } elsif ($activity eq 'reinit') {
5807: $text = &mt('Checking Course Update Blocked');
1.1351 raeburn 5808: } elsif ($activity eq 'about') {
5809: $text = &mt('Access to User Information Pages Blocked');
1.1373 raeburn 5810: } elsif ($activity eq 'wishlist') {
5811: $text = &mt('Access to Stored Links Blocked');
5812: } elsif ($activity eq 'annotate') {
5813: $text = &mt('Access to Annotations Blocked');
1.1062 raeburn 5814: }
1.1061 raeburn 5815: $output .= <<"END_BLOCK";
1.1217 raeburn 5816: <div class='$class'>
1.869 kalberla 5817: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5818: title='$text'>
5819: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5820: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5821: title='$text'>$text</a>
1.867 kalberla 5822: </div>
5823:
5824: END_BLOCK
1.474 raeburn 5825:
1.1061 raeburn 5826: return ($blocked, $output);
1.854 kalberla 5827: }
1.490 raeburn 5828:
1.60 matthew 5829: ###############################################
5830:
1.682 raeburn 5831: sub check_ip_acc {
1.1201 raeburn 5832: my ($acc,$clientip)=@_;
1.682 raeburn 5833: &Apache::lonxml::debug("acc is $acc");
5834: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5835: return 1;
5836: }
1.1339 raeburn 5837: my ($ip,$allowed);
5838: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
5839: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
5840: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
5841: } else {
1.1350 raeburn 5842: my $remote_ip = &Apache::lonnet::get_requestor_ip();
5843: $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1339 raeburn 5844: }
1.682 raeburn 5845:
5846: my $name;
1.1219 raeburn 5847: my %access = (
5848: allowfrom => 1,
5849: denyfrom => 0,
5850: );
5851: my @allows;
5852: my @denies;
5853: foreach my $item (split(',',$acc)) {
5854: $item =~ s/^\s*//;
5855: $item =~ s/\s*$//;
5856: my $pattern;
5857: if ($item =~ /^\!(.+)$/) {
5858: push(@denies,$1);
5859: } else {
5860: push(@allows,$item);
5861: }
5862: }
5863: my $numdenies = scalar(@denies);
5864: my $numallows = scalar(@allows);
5865: my $count = 0;
5866: foreach my $pattern (@denies,@allows) {
5867: $count ++;
5868: my $acctype = 'allowfrom';
5869: if ($count <= $numdenies) {
5870: $acctype = 'denyfrom';
5871: }
1.682 raeburn 5872: if ($pattern =~ /\*$/) {
5873: #35.8.*
5874: $pattern=~s/\*//;
1.1219 raeburn 5875: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5876: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5877: #35.8.3.[34-56]
5878: my $low=$2;
5879: my $high=$3;
5880: $pattern=$1;
5881: if ($ip =~ /^\Q$pattern\E/) {
5882: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5883: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5884: }
5885: } elsif ($pattern =~ /^\*/) {
5886: #*.msu.edu
5887: $pattern=~s/\*//;
5888: if (!defined($name)) {
5889: use Socket;
5890: my $netaddr=inet_aton($ip);
5891: ($name)=gethostbyaddr($netaddr,AF_INET);
5892: }
1.1219 raeburn 5893: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5894: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5895: #127.0.0.1
1.1219 raeburn 5896: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5897: } else {
5898: #some.name.com
5899: if (!defined($name)) {
5900: use Socket;
5901: my $netaddr=inet_aton($ip);
5902: ($name)=gethostbyaddr($netaddr,AF_INET);
5903: }
1.1219 raeburn 5904: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5905: }
5906: if ($allowed =~ /^(0|1)$/) { last; }
5907: }
5908: if ($allowed eq '') {
5909: if ($numdenies && !$numallows) {
5910: $allowed = 1;
5911: } else {
5912: $allowed = 0;
1.682 raeburn 5913: }
5914: }
5915: return $allowed;
5916: }
5917:
5918: ###############################################
5919:
1.60 matthew 5920: =pod
5921:
1.112 bowersj2 5922: =head1 Domain Template Functions
5923:
5924: =over 4
5925:
5926: =item * &determinedomain()
1.60 matthew 5927:
5928: Inputs: $domain (usually will be undef)
5929:
1.63 www 5930: Returns: Determines which domain should be used for designs
1.60 matthew 5931:
5932: =cut
1.54 www 5933:
1.60 matthew 5934: ###############################################
1.63 www 5935: sub determinedomain {
5936: my $domain=shift;
1.531 albertel 5937: if (! $domain) {
1.60 matthew 5938: # Determine domain if we have not been given one
1.893 raeburn 5939: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5940: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5941: if ($env{'request.role.domain'}) {
5942: $domain=$env{'request.role.domain'};
1.60 matthew 5943: }
5944: }
1.63 www 5945: return $domain;
5946: }
5947: ###############################################
1.517 raeburn 5948:
1.518 albertel 5949: sub devalidate_domconfig_cache {
5950: my ($udom)=@_;
5951: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5952: }
5953:
5954: # ---------------------- Get domain configuration for a domain
5955: sub get_domainconf {
5956: my ($udom) = @_;
5957: my $cachetime=1800;
5958: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5959: if (defined($cached)) { return %{$result}; }
5960:
5961: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5962: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5963: my (%designhash,%legacy);
1.518 albertel 5964: if (keys(%domconfig) > 0) {
5965: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5966: if (keys(%{$domconfig{'login'}})) {
5967: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5968: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5969: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5970: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5971: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5972: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5973: if ($key eq 'loginvia') {
5974: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5975: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5976: $designhash{$udom.'.login.loginvia'} = $server;
5977: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5978:
5979: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5980: } else {
5981: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5982: }
1.948 raeburn 5983: }
1.1208 raeburn 5984: } elsif ($key eq 'headtag') {
5985: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5986: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5987: }
1.946 raeburn 5988: }
1.1208 raeburn 5989: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5990: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5991: }
1.946 raeburn 5992: }
5993: }
5994: }
1.1366 raeburn 5995: } elsif ($key eq 'saml') {
5996: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5997: foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
5998: if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
5999: $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
6000: foreach my $item ('text','img','alt','url','title','notsso') {
6001: $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
6002: }
6003: }
6004: }
6005: }
1.946 raeburn 6006: } else {
6007: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
6008: $designhash{$udom.'.login.'.$key.'_'.$img} =
6009: $domconfig{'login'}{$key}{$img};
6010: }
1.699 raeburn 6011: }
6012: } else {
6013: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
6014: }
1.632 raeburn 6015: }
6016: } else {
6017: $legacy{'login'} = 1;
1.518 albertel 6018: }
1.632 raeburn 6019: } else {
6020: $legacy{'login'} = 1;
1.518 albertel 6021: }
6022: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 6023: if (keys(%{$domconfig{'rolecolors'}})) {
6024: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
6025: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
6026: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
6027: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
6028: }
1.518 albertel 6029: }
6030: }
1.632 raeburn 6031: } else {
6032: $legacy{'rolecolors'} = 1;
1.518 albertel 6033: }
1.632 raeburn 6034: } else {
6035: $legacy{'rolecolors'} = 1;
1.518 albertel 6036: }
1.948 raeburn 6037: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
6038: if ($domconfig{'autoenroll'}{'co-owners'}) {
6039: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
6040: }
6041: }
1.632 raeburn 6042: if (keys(%legacy) > 0) {
6043: my %legacyhash = &get_legacy_domconf($udom);
6044: foreach my $item (keys(%legacyhash)) {
6045: if ($item =~ /^\Q$udom\E\.login/) {
6046: if ($legacy{'login'}) {
6047: $designhash{$item} = $legacyhash{$item};
6048: }
6049: } else {
6050: if ($legacy{'rolecolors'}) {
6051: $designhash{$item} = $legacyhash{$item};
6052: }
1.518 albertel 6053: }
6054: }
6055: }
1.632 raeburn 6056: } else {
6057: %designhash = &get_legacy_domconf($udom);
1.518 albertel 6058: }
6059: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
6060: $cachetime);
6061: return %designhash;
6062: }
6063:
1.632 raeburn 6064: sub get_legacy_domconf {
6065: my ($udom) = @_;
6066: my %legacyhash;
6067: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
6068: my $designfile = $designdir.'/'.$udom.'.tab';
6069: if (-e $designfile) {
1.1317 raeburn 6070: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 6071: while (my $line = <$fh>) {
6072: next if ($line =~ /^\#/);
6073: chomp($line);
6074: my ($key,$val)=(split(/\=/,$line));
6075: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
6076: }
6077: close($fh);
6078: }
6079: }
1.1026 raeburn 6080: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 6081: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
6082: }
6083: return %legacyhash;
6084: }
6085:
1.63 www 6086: =pod
6087:
1.112 bowersj2 6088: =item * &domainlogo()
1.63 www 6089:
6090: Inputs: $domain (usually will be undef)
6091:
6092: Returns: A link to a domain logo, if the domain logo exists.
6093: If the domain logo does not exist, a description of the domain.
6094:
6095: =cut
1.112 bowersj2 6096:
1.63 www 6097: ###############################################
6098: sub domainlogo {
1.517 raeburn 6099: my $domain = &determinedomain(shift);
1.518 albertel 6100: my %designhash = &get_domainconf($domain);
1.517 raeburn 6101: # See if there is a logo
6102: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 6103: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 6104: if ($imgsrc =~ m{^/(adm|res)/}) {
6105: if ($imgsrc =~ m{^/res/}) {
6106: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
6107: &Apache::lonnet::repcopy($local_name);
6108: }
6109: $imgsrc = &lonhttpdurl($imgsrc);
1.1374 raeburn 6110: }
6111: my $alttext = $domain;
6112: if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
6113: $alttext = $designhash{$domain.'.login.alttext_domlogo'};
6114: }
6115: return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514 albertel 6116: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
6117: return &Apache::lonnet::domain($domain,'description');
1.59 www 6118: } else {
1.60 matthew 6119: return '';
1.59 www 6120: }
6121: }
1.63 www 6122: ##############################################
6123:
6124: =pod
6125:
1.112 bowersj2 6126: =item * &designparm()
1.63 www 6127:
6128: Inputs: $which parameter; $domain (usually will be undef)
6129:
6130: Returns: value of designparamter $which
6131:
6132: =cut
1.112 bowersj2 6133:
1.397 albertel 6134:
1.400 albertel 6135: ##############################################
1.397 albertel 6136: sub designparm {
6137: my ($which,$domain)=@_;
6138: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 6139: return $env{'environment.color.'.$which};
1.96 www 6140: }
1.63 www 6141: $domain=&determinedomain($domain);
1.1016 raeburn 6142: my %domdesign;
6143: unless ($domain eq 'public') {
6144: %domdesign = &get_domainconf($domain);
6145: }
1.520 raeburn 6146: my $output;
1.517 raeburn 6147: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 6148: $output = $domdesign{$domain.'.'.$which};
1.63 www 6149: } else {
1.520 raeburn 6150: $output = $defaultdesign{$which};
6151: }
6152: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 6153: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 6154: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 6155: if ($output =~ m{^/res/}) {
6156: my $local_name = &Apache::lonnet::filelocation('',$output);
6157: &Apache::lonnet::repcopy($local_name);
6158: }
1.520 raeburn 6159: $output = &lonhttpdurl($output);
6160: }
1.63 www 6161: }
1.520 raeburn 6162: return $output;
1.63 www 6163: }
1.59 www 6164:
1.822 bisitz 6165: ##############################################
6166: =pod
6167:
1.832 bisitz 6168: =item * &authorspace()
6169:
1.1028 raeburn 6170: Inputs: $url (usually will be undef).
1.832 bisitz 6171:
1.1132 raeburn 6172: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 6173: directory being viewed (or for which action is being taken).
6174: If $url is provided, and begins /priv/<domain>/<uname>
6175: the path will be that portion of the $context argument.
6176: Otherwise the path will be for the author space of the current
6177: user when the current role is author, or for that of the
6178: co-author/assistant co-author space when the current role
6179: is co-author or assistant co-author.
1.832 bisitz 6180:
6181: =cut
6182:
6183: sub authorspace {
1.1028 raeburn 6184: my ($url) = @_;
6185: if ($url ne '') {
6186: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
6187: return $1;
6188: }
6189: }
1.832 bisitz 6190: my $caname = '';
1.1024 www 6191: my $cadom = '';
1.1028 raeburn 6192: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 6193: ($cadom,$caname) =
1.832 bisitz 6194: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 6195: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 6196: $caname = $env{'user.name'};
1.1024 www 6197: $cadom = $env{'user.domain'};
1.832 bisitz 6198: }
1.1028 raeburn 6199: if (($caname ne '') && ($cadom ne '')) {
6200: return "/priv/$cadom/$caname/";
6201: }
6202: return;
1.832 bisitz 6203: }
6204:
6205: ##############################################
6206: =pod
6207:
1.822 bisitz 6208: =item * &head_subbox()
6209:
6210: Inputs: $content (contains HTML code with page functions, etc.)
6211:
6212: Returns: HTML div with $content
6213: To be included in page header
6214:
6215: =cut
6216:
6217: sub head_subbox {
6218: my ($content)=@_;
6219: my $output =
1.993 raeburn 6220: '<div class="LC_head_subbox">'
1.822 bisitz 6221: .$content
6222: .'</div>'
6223: }
6224:
6225: ##############################################
6226: =pod
6227:
6228: =item * &CSTR_pageheader()
6229:
1.1026 raeburn 6230: Input: (optional) filename from which breadcrumb trail is built.
6231: In most cases no input as needed, as $env{'request.filename'}
6232: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 6233:
6234: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 6235: To be included on Authoring Space pages
1.822 bisitz 6236:
6237: =cut
6238:
6239: sub CSTR_pageheader {
1.1026 raeburn 6240: my ($trailfile) = @_;
6241: if ($trailfile eq '') {
6242: $trailfile = $env{'request.filename'};
6243: }
6244:
6245: # this is for resources; directories have customtitle, and crumbs
6246: # and select recent are created in lonpubdir.pm
6247:
6248: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 6249: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 6250: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 6251: my $formaction = "/priv/$udom/$uname/$thisdisfn";
6252: $formaction =~ s{/+}{/}g;
1.822 bisitz 6253:
6254: my $parentpath = '';
6255: my $lastitem = '';
6256: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
6257: $parentpath = $1;
6258: $lastitem = $2;
6259: } else {
6260: $lastitem = $thisdisfn;
6261: }
1.921 bisitz 6262:
1.1246 raeburn 6263: my ($crsauthor,$title);
6264: if (($env{'request.course.id'}) &&
6265: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 6266: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 6267: $crsauthor = 1;
6268: $title = &mt('Course Authoring Space');
6269: } else {
6270: $title = &mt('Authoring Space');
6271: }
6272:
1.1314 raeburn 6273: my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent"
1.1313 raeburn 6274: if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314 raeburn 6275: $target = '';
6276: $crumbtarget = '';
1.1313 raeburn 6277: }
1.1378 ! raeburn 6278: if (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
! 6279: $target = ' target="'.$env{'request.deeplink.target'}.'"';
! 6280: $crumbtarget = $env{'request.deeplink.target'};
! 6281: }
1.1313 raeburn 6282:
1.921 bisitz 6283: my $output =
1.822 bisitz 6284: '<div>'
6285: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 6286: .'<b>'.$title.'</b> '
1.1314 raeburn 6287: .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
6288: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 6289:
6290: if ($lastitem) {
6291: $output .=
6292: '<span class="LC_filename">'
6293: .$lastitem
6294: .'</span>';
6295: }
1.1245 raeburn 6296:
1.1246 raeburn 6297: if ($crsauthor) {
6298: $output .= '</form>'.&Apache::lonmenu::constspaceform();
6299: } else {
6300: $output .=
6301: '<br />'
1.1314 raeburn 6302: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246 raeburn 6303: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
6304: .'</form>'
6305: .&Apache::lonmenu::constspaceform();
6306: }
6307: $output .= '</div>';
1.921 bisitz 6308:
6309: return $output;
1.822 bisitz 6310: }
6311:
1.60 matthew 6312: ###############################################
6313: ###############################################
6314:
6315: =pod
6316:
1.112 bowersj2 6317: =back
6318:
1.549 albertel 6319: =head1 HTML Helpers
1.112 bowersj2 6320:
6321: =over 4
6322:
6323: =item * &bodytag()
1.60 matthew 6324:
6325: Returns a uniform header for LON-CAPA web pages.
6326:
6327: Inputs:
6328:
1.112 bowersj2 6329: =over 4
6330:
6331: =item * $title, A title to be displayed on the page.
6332:
6333: =item * $function, the current role (can be undef).
6334:
6335: =item * $addentries, extra parameters for the <body> tag.
6336:
6337: =item * $bodyonly, if defined, only return the <body> tag.
6338:
6339: =item * $domain, if defined, force a given domain.
6340:
6341: =item * $forcereg, if page should register as content page (relevant for
1.86 www 6342: text interface only)
1.60 matthew 6343:
1.814 bisitz 6344: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
6345: navigational links
1.317 albertel 6346:
1.338 albertel 6347: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
6348:
1.460 albertel 6349: =item * $args, optional argument valid values are
6350: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 6351: use_absolute -> for external resource or syllabus, this will
6352: contain https://<hostname> if server uses
6353: https (as per hosts.tab), but request is for http
6354: hostname -> hostname, from $r->hostname().
1.460 albertel 6355:
1.1096 raeburn 6356: =item * $advtoolsref, optional argument, ref to an array containing
6357: inlineremote items to be added in "Functions" menu below
6358: breadcrumbs.
6359:
1.1316 raeburn 6360: =item * $ltiscope, optional argument, will be one of: resource, map or
6361: course, if LON-CAPA is in LTI Provider context. Value is
6362: the scope of use, i.e., launch was for access to a single, a map
6363: or the entire course.
6364:
6365: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
6366: context, this will contain the URL for the landing item in
6367: the course, after launch from an LTI Consumer
6368:
1.1318 raeburn 6369: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
6370: context, this will contain a reference to hash of items
6371: to be included in the page header and/or inline menu.
6372:
1.112 bowersj2 6373: =back
6374:
1.60 matthew 6375: Returns: A uniform header for LON-CAPA web pages.
6376: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
6377: If $bodyonly is undef or zero, an html string containing a <body> tag and
6378: other decorations will be returned.
6379:
6380: =cut
6381:
1.54 www 6382: sub bodytag {
1.831 bisitz 6383: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1359 raeburn 6384: $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
6385: $ltimenu,$menucoll,$menuref)=@_;
1.339 albertel 6386:
1.954 raeburn 6387: my $public;
6388: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
6389: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
6390: $public = 1;
6391: }
1.460 albertel 6392: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 6393: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 6394: my $hostname = $args->{'hostname'};
1.339 albertel 6395:
1.183 matthew 6396: $function = &get_users_function() if (!$function);
1.339 albertel 6397: my $img = &designparm($function.'.img',$domain);
6398: my $font = &designparm($function.'.font',$domain);
6399: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
6400:
1.803 bisitz 6401: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 6402: 'bgcolor' => $pgbg,
1.339 albertel 6403: 'text' => $font,
6404: 'alink' => &designparm($function.'.alink',$domain),
6405: 'vlink' => &designparm($function.'.vlink',$domain),
6406: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 6407: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 6408:
1.63 www 6409: # role and realm
1.1178 raeburn 6410: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
6411: if ($realm) {
6412: $realm = '/'.$realm;
6413: }
1.1357 raeburn 6414: if ($role eq 'ca') {
1.479 albertel 6415: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 6416: $realm = &plainname($rname,$rdom);
1.378 raeburn 6417: }
1.55 www 6418: # realm
1.1357 raeburn 6419: my ($cid,$sec);
1.258 albertel 6420: if ($env{'request.course.id'}) {
1.1357 raeburn 6421: $cid = $env{'request.course.id'};
6422: if ($env{'request.course.sec'}) {
6423: $sec = $env{'request.course.sec'};
6424: }
6425: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
6426: if (&Apache::lonnet::is_course($1,$2)) {
6427: $cid = $1.'_'.$2;
6428: $sec = $3;
6429: }
6430: }
6431: if ($cid) {
1.378 raeburn 6432: if ($env{'request.role'} !~ /^cr/) {
6433: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 6434: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 6435: if ($env{'request.role.desc'}) {
6436: $role = $env{'request.role.desc'};
6437: } else {
6438: $role = &mt('Helpdesk[_1]',' '.$2);
6439: }
1.1257 raeburn 6440: } else {
6441: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 6442: }
1.1357 raeburn 6443: if ($sec) {
6444: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 6445: }
1.1357 raeburn 6446: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 6447: } else {
6448: $role = &Apache::lonnet::plaintext($role);
1.54 www 6449: }
1.433 albertel 6450:
1.359 albertel 6451: if (!$realm) { $realm=' '; }
1.330 albertel 6452:
1.438 albertel 6453: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6454:
1.101 www 6455: # construct main body tag
1.359 albertel 6456: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 6457: &Apache::lontexconvert::init_math_support();
1.252 albertel 6458:
1.1131 raeburn 6459: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6460:
1.1130 raeburn 6461: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6462: return $bodytag;
1.1130 raeburn 6463: }
1.359 albertel 6464:
1.954 raeburn 6465: if ($public) {
1.433 albertel 6466: undef($role);
6467: }
1.1318 raeburn 6468:
1.1359 raeburn 6469: my $showcrstitle = 1;
1.1357 raeburn 6470: if (($cid) && ($env{'request.lti.login'})) {
1.1318 raeburn 6471: if (ref($ltimenu) eq 'HASH') {
6472: unless ($ltimenu->{'role'}) {
6473: undef($role);
6474: }
6475: unless ($ltimenu->{'coursetitle'}) {
6476: $realm=' ';
1.1359 raeburn 6477: $showcrstitle = 0;
6478: }
6479: }
6480: } elsif (($cid) && ($menucoll)) {
6481: if (ref($menuref) eq 'HASH') {
6482: unless ($menuref->{'role'}) {
6483: undef($role);
6484: }
6485: unless ($menuref->{'crs'}) {
6486: $realm=' ';
6487: $showcrstitle = 0;
1.1318 raeburn 6488: }
6489: }
6490: }
6491:
1.762 bisitz 6492: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6493: #
6494: # Extra info if you are the DC
6495: my $dc_info = '';
1.1359 raeburn 6496: if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1357 raeburn 6497: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 6498: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6499: $dc_info =~ s/\s+$//;
1.359 albertel 6500: }
6501:
1.1237 raeburn 6502: my $crstype;
1.1357 raeburn 6503: if ($cid) {
6504: $crstype = $env{'course.'.$cid.'.type'};
1.1237 raeburn 6505: } elsif ($args->{'crstype'}) {
6506: $crstype = $args->{'crstype'};
6507: }
6508: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
6509: undef($role);
6510: } else {
1.1242 raeburn 6511: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 6512: }
1.853 droeschl 6513:
1.903 droeschl 6514: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6515:
6516: # if ($env{'request.state'} eq 'construct') {
6517: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6518: # }
6519:
1.1130 raeburn 6520: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 6521: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 6522:
1.1318 raeburn 6523: unless ($args->{'no_primary_menu'}) {
1.1369 raeburn 6524: my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
6525: $args->{'links_disabled'});
1.359 albertel 6526:
1.1318 raeburn 6527: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
6528: if ($dc_info) {
6529: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6530: }
6531: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
6532: <em>$realm</em> $dc_info</div>|;
6533: return $bodytag;
6534: }
1.894 droeschl 6535:
1.1318 raeburn 6536: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
6537: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
6538: }
1.916 droeschl 6539:
1.1318 raeburn 6540: $bodytag .= $right;
1.852 droeschl 6541:
1.1318 raeburn 6542: if ($dc_info) {
6543: $dc_info = &dc_courseid_toggle($dc_info);
6544: }
6545: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 6546: }
1.916 droeschl 6547:
1.1169 raeburn 6548: #if directed to not display the secondary menu, don't.
1.1168 raeburn 6549: if ($args->{'no_secondary_menu'}) {
6550: return $bodytag;
6551: }
1.1169 raeburn 6552: #don't show menus for public users
1.954 raeburn 6553: if (!$public){
1.1318 raeburn 6554: unless ($args->{'no_inline_menu'}) {
6555: $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
1.1359 raeburn 6556: $args->{'no_primary_menu'},
1.1369 raeburn 6557: $menucoll,$menuref,
6558: $args->{'links_disabled'});
1.1318 raeburn 6559: }
1.903 droeschl 6560: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6561: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6562: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6563: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1316 raeburn 6564: $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
1.1096 raeburn 6565: } elsif ($forcereg) {
6566: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1258 raeburn 6567: $args->{'group'},
1.1274 raeburn 6568: $args->{'hide_buttons'},
1.1316 raeburn 6569: $hostname,$ltiscope,$ltiuri);
1.1096 raeburn 6570: } else {
6571: $bodytag .=
6572: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6573: $forcereg,$args->{'group'},
6574: $args->{'bread_crumbs'},
1.1274 raeburn 6575: $advtoolsref,'',$hostname);
1.920 raeburn 6576: }
1.903 droeschl 6577: }else{
6578: # this is to seperate menu from content when there's no secondary
6579: # menu. Especially needed for public accessible ressources.
6580: $bodytag .= '<hr style="clear:both" />';
6581: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6582: }
1.903 droeschl 6583:
1.235 raeburn 6584: return $bodytag;
1.182 matthew 6585: }
6586:
1.917 raeburn 6587: sub dc_courseid_toggle {
6588: my ($dc_info) = @_;
1.980 raeburn 6589: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6590: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6591: &mt('(More ...)').'</a></span>'.
6592: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6593: }
6594:
1.330 albertel 6595: sub make_attr_string {
6596: my ($register,$attr_ref) = @_;
6597:
6598: if ($attr_ref && !ref($attr_ref)) {
6599: die("addentries Must be a hash ref ".
6600: join(':',caller(1))." ".
6601: join(':',caller(0))." ");
6602: }
6603:
6604: if ($register) {
1.339 albertel 6605: my ($on_load,$on_unload);
6606: foreach my $key (keys(%{$attr_ref})) {
6607: if (lc($key) eq 'onload') {
6608: $on_load.=$attr_ref->{$key}.';';
6609: delete($attr_ref->{$key});
6610:
6611: } elsif (lc($key) eq 'onunload') {
6612: $on_unload.=$attr_ref->{$key}.';';
6613: delete($attr_ref->{$key});
6614: }
6615: }
1.953 droeschl 6616: $attr_ref->{'onload'} = $on_load;
6617: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6618: }
1.339 albertel 6619:
1.330 albertel 6620: my $attr_string;
1.1159 raeburn 6621: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6622: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6623: }
6624: return $attr_string;
6625: }
6626:
6627:
1.182 matthew 6628: ###############################################
1.251 albertel 6629: ###############################################
6630:
6631: =pod
6632:
6633: =item * &endbodytag()
6634:
6635: Returns a uniform footer for LON-CAPA web pages.
6636:
1.635 raeburn 6637: Inputs: 1 - optional reference to an args hash
6638: If in the hash, key for noredirectlink has a value which evaluates to true,
6639: a 'Continue' link is not displayed if the page contains an
6640: internal redirect in the <head></head> section,
6641: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6642:
6643: =cut
6644:
6645: sub endbodytag {
1.635 raeburn 6646: my ($args) = @_;
1.1080 raeburn 6647: my $endbodytag;
6648: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6649: $endbodytag='</body>';
6650: }
1.315 albertel 6651: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6652: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6653: $endbodytag=
6654: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6655: &mt('Continue').'</a>'.
6656: $endbodytag;
6657: }
1.315 albertel 6658: }
1.251 albertel 6659: return $endbodytag;
6660: }
6661:
1.352 albertel 6662: =pod
6663:
6664: =item * &standard_css()
6665:
6666: Returns a style sheet
6667:
6668: Inputs: (all optional)
6669: domain -> force to color decorate a page for a specific
6670: domain
6671: function -> force usage of a specific rolish color scheme
6672: bgcolor -> override the default page bgcolor
6673:
6674: =cut
6675:
1.343 albertel 6676: sub standard_css {
1.345 albertel 6677: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6678: $function = &get_users_function() if (!$function);
6679: my $img = &designparm($function.'.img', $domain);
6680: my $tabbg = &designparm($function.'.tabbg', $domain);
6681: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6682: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6683: #second colour for later usage
1.345 albertel 6684: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6685: my $pgbg_or_bgcolor =
6686: $bgcolor ||
1.352 albertel 6687: &designparm($function.'.pgbg', $domain);
1.382 albertel 6688: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6689: my $alink = &designparm($function.'.alink', $domain);
6690: my $vlink = &designparm($function.'.vlink', $domain);
6691: my $link = &designparm($function.'.link', $domain);
6692:
1.602 albertel 6693: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6694: my $mono = 'monospace';
1.850 bisitz 6695: my $data_table_head = $sidebg;
6696: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6697: my $data_table_dark = '#E0E0E0';
1.470 banghart 6698: my $data_table_darker = '#CCCCCC';
1.349 albertel 6699: my $data_table_highlight = '#FFFF00';
1.352 albertel 6700: my $mail_new = '#FFBB77';
6701: my $mail_new_hover = '#DD9955';
6702: my $mail_read = '#BBBB77';
6703: my $mail_read_hover = '#999944';
6704: my $mail_replied = '#AAAA88';
6705: my $mail_replied_hover = '#888855';
6706: my $mail_other = '#99BBBB';
6707: my $mail_other_hover = '#669999';
1.391 albertel 6708: my $table_header = '#DDDDDD';
1.489 raeburn 6709: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6710: my $lg_border_color = '#C8C8C8';
1.952 onken 6711: my $button_hover = '#BF2317';
1.392 albertel 6712:
1.608 albertel 6713: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6714: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6715: : '0 3px 0 4px';
1.448 albertel 6716:
1.523 albertel 6717:
1.343 albertel 6718: return <<END;
1.947 droeschl 6719:
6720: /* needed for iframe to allow 100% height in FF */
6721: body, html {
6722: margin: 0;
6723: padding: 0 0.5%;
6724: height: 99%; /* to avoid scrollbars */
6725: }
6726:
1.795 www 6727: body {
1.911 bisitz 6728: font-family: $sans;
6729: line-height:130%;
6730: font-size:0.83em;
6731: color:$font;
1.795 www 6732: }
6733:
1.959 onken 6734: a:focus,
6735: a:focus img {
1.795 www 6736: color: red;
6737: }
1.698 harmsja 6738:
1.911 bisitz 6739: form, .inline {
6740: display: inline;
1.795 www 6741: }
1.721 harmsja 6742:
1.795 www 6743: .LC_right {
1.911 bisitz 6744: text-align:right;
1.795 www 6745: }
6746:
6747: .LC_middle {
1.911 bisitz 6748: vertical-align:middle;
1.795 www 6749: }
1.721 harmsja 6750:
1.1130 raeburn 6751: .LC_floatleft {
6752: float: left;
6753: }
6754:
6755: .LC_floatright {
6756: float: right;
6757: }
6758:
1.911 bisitz 6759: .LC_400Box {
6760: width:400px;
6761: }
1.721 harmsja 6762:
1.947 droeschl 6763: .LC_iframecontainer {
6764: width: 98%;
6765: margin: 0;
6766: position: fixed;
6767: top: 8.5em;
6768: bottom: 0;
6769: }
6770:
6771: .LC_iframecontainer iframe{
6772: border: none;
6773: width: 100%;
6774: height: 100%;
6775: }
6776:
1.778 bisitz 6777: .LC_filename {
6778: font-family: $mono;
6779: white-space:pre;
1.921 bisitz 6780: font-size: 120%;
1.778 bisitz 6781: }
6782:
6783: .LC_fileicon {
6784: border: none;
6785: height: 1.3em;
6786: vertical-align: text-bottom;
6787: margin-right: 0.3em;
6788: text-decoration:none;
6789: }
6790:
1.1008 www 6791: .LC_setting {
6792: text-decoration:underline;
6793: }
6794:
1.350 albertel 6795: .LC_error {
6796: color: red;
6797: }
1.795 www 6798:
1.1097 bisitz 6799: .LC_warning {
6800: color: darkorange;
6801: }
6802:
1.457 albertel 6803: .LC_diff_removed {
1.733 bisitz 6804: color: red;
1.394 albertel 6805: }
1.532 albertel 6806:
6807: .LC_info,
1.457 albertel 6808: .LC_success,
6809: .LC_diff_added {
1.350 albertel 6810: color: green;
6811: }
1.795 www 6812:
1.802 bisitz 6813: div.LC_confirm_box {
6814: background-color: #FAFAFA;
6815: border: 1px solid $lg_border_color;
6816: margin-right: 0;
6817: padding: 5px;
6818: }
6819:
6820: div.LC_confirm_box .LC_error img,
6821: div.LC_confirm_box .LC_success img {
6822: vertical-align: middle;
6823: }
6824:
1.1242 raeburn 6825: .LC_maxwidth {
6826: max-width: 100%;
6827: height: auto;
6828: }
6829:
1.1243 raeburn 6830: .LC_textsize_mobile {
6831: \@media only screen and (max-device-width: 480px) {
6832: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6833: }
6834: }
6835:
1.440 albertel 6836: .LC_icon {
1.771 droeschl 6837: border: none;
1.790 droeschl 6838: vertical-align: middle;
1.771 droeschl 6839: }
6840:
1.543 albertel 6841: .LC_docs_spacer {
6842: width: 25px;
6843: height: 1px;
1.771 droeschl 6844: border: none;
1.543 albertel 6845: }
1.346 albertel 6846:
1.532 albertel 6847: .LC_internal_info {
1.735 bisitz 6848: color: #999999;
1.532 albertel 6849: }
6850:
1.794 www 6851: .LC_discussion {
1.1050 www 6852: background: $data_table_dark;
1.911 bisitz 6853: border: 1px solid black;
6854: margin: 2px;
1.794 www 6855: }
6856:
6857: .LC_disc_action_left {
1.1050 www 6858: background: $sidebg;
1.911 bisitz 6859: text-align: left;
1.1050 www 6860: padding: 4px;
6861: margin: 2px;
1.794 www 6862: }
6863:
6864: .LC_disc_action_right {
1.1050 www 6865: background: $sidebg;
1.911 bisitz 6866: text-align: right;
1.1050 www 6867: padding: 4px;
6868: margin: 2px;
1.794 www 6869: }
6870:
6871: .LC_disc_new_item {
1.911 bisitz 6872: background: white;
6873: border: 2px solid red;
1.1050 www 6874: margin: 4px;
6875: padding: 4px;
1.794 www 6876: }
6877:
6878: .LC_disc_old_item {
1.911 bisitz 6879: background: white;
1.1050 www 6880: margin: 4px;
6881: padding: 4px;
1.794 www 6882: }
6883:
1.458 albertel 6884: table.LC_pastsubmission {
6885: border: 1px solid black;
6886: margin: 2px;
6887: }
6888:
1.924 bisitz 6889: table#LC_menubuttons {
1.345 albertel 6890: width: 100%;
6891: background: $pgbg;
1.392 albertel 6892: border: 2px;
1.402 albertel 6893: border-collapse: separate;
1.803 bisitz 6894: padding: 0;
1.345 albertel 6895: }
1.392 albertel 6896:
1.801 tempelho 6897: table#LC_title_bar a {
6898: color: $fontmenu;
6899: }
1.836 bisitz 6900:
1.807 droeschl 6901: table#LC_title_bar {
1.819 tempelho 6902: clear: both;
1.836 bisitz 6903: display: none;
1.807 droeschl 6904: }
6905:
1.795 www 6906: table#LC_title_bar,
1.933 droeschl 6907: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6908: table#LC_title_bar.LC_with_remote {
1.359 albertel 6909: width: 100%;
1.392 albertel 6910: border-color: $pgbg;
6911: border-style: solid;
6912: border-width: $border;
1.379 albertel 6913: background: $pgbg;
1.801 tempelho 6914: color: $fontmenu;
1.392 albertel 6915: border-collapse: collapse;
1.803 bisitz 6916: padding: 0;
1.819 tempelho 6917: margin: 0;
1.359 albertel 6918: }
1.795 www 6919:
1.933 droeschl 6920: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6921: margin: 0;
6922: padding: 0;
1.933 droeschl 6923: position: relative;
6924: list-style: none;
1.913 droeschl 6925: }
1.933 droeschl 6926: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6927: display: inline;
6928: }
1.933 droeschl 6929:
6930: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6931: padding: 0;
1.933 droeschl 6932: margin: 0;
6933: float: left;
1.913 droeschl 6934: }
1.933 droeschl 6935: .LC_breadcrumb_tools_tools {
6936: padding: 0;
6937: margin: 0;
1.913 droeschl 6938: float: right;
6939: }
6940:
1.1240 raeburn 6941: .LC_placement_prog {
6942: padding-right: 20px;
6943: font-weight: bold;
6944: font-size: 90%;
6945: }
6946:
1.359 albertel 6947: table#LC_title_bar td {
6948: background: $tabbg;
6949: }
1.795 www 6950:
1.911 bisitz 6951: table#LC_menubuttons img {
1.803 bisitz 6952: border: none;
1.346 albertel 6953: }
1.795 www 6954:
1.842 droeschl 6955: .LC_breadcrumbs_component {
1.911 bisitz 6956: float: right;
6957: margin: 0 1em;
1.357 albertel 6958: }
1.842 droeschl 6959: .LC_breadcrumbs_component img {
1.911 bisitz 6960: vertical-align: middle;
1.777 tempelho 6961: }
1.795 www 6962:
1.1243 raeburn 6963: .LC_breadcrumbs_hoverable {
6964: background: $sidebg;
6965: }
6966:
1.383 albertel 6967: td.LC_table_cell_checkbox {
6968: text-align: center;
6969: }
1.795 www 6970:
6971: .LC_fontsize_small {
1.911 bisitz 6972: font-size: 70%;
1.705 tempelho 6973: }
6974:
1.844 bisitz 6975: #LC_breadcrumbs {
1.911 bisitz 6976: clear:both;
6977: background: $sidebg;
6978: border-bottom: 1px solid $lg_border_color;
6979: line-height: 2.5em;
1.933 droeschl 6980: overflow: hidden;
1.911 bisitz 6981: margin: 0;
6982: padding: 0;
1.995 raeburn 6983: text-align: left;
1.819 tempelho 6984: }
1.862 bisitz 6985:
1.1098 bisitz 6986: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6987: clear:both;
6988: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6989: border: 1px solid $sidebg;
1.1098 bisitz 6990: margin: 0 0 10px 0;
1.966 bisitz 6991: padding: 3px;
1.995 raeburn 6992: text-align: left;
1.822 bisitz 6993: }
6994:
1.795 www 6995: .LC_fontsize_medium {
1.911 bisitz 6996: font-size: 85%;
1.705 tempelho 6997: }
6998:
1.795 www 6999: .LC_fontsize_large {
1.911 bisitz 7000: font-size: 120%;
1.705 tempelho 7001: }
7002:
1.346 albertel 7003: .LC_menubuttons_inline_text {
7004: color: $font;
1.698 harmsja 7005: font-size: 90%;
1.701 harmsja 7006: padding-left:3px;
1.346 albertel 7007: }
7008:
1.934 droeschl 7009: .LC_menubuttons_inline_text img{
7010: vertical-align: middle;
7011: }
7012:
1.1051 www 7013: li.LC_menubuttons_inline_text img {
1.951 onken 7014: cursor:pointer;
1.1002 droeschl 7015: text-decoration: none;
1.951 onken 7016: }
7017:
1.526 www 7018: .LC_menubuttons_link {
7019: text-decoration: none;
7020: }
1.795 www 7021:
1.522 albertel 7022: .LC_menubuttons_category {
1.521 www 7023: color: $font;
1.526 www 7024: background: $pgbg;
1.521 www 7025: font-size: larger;
7026: font-weight: bold;
7027: }
7028:
1.346 albertel 7029: td.LC_menubuttons_text {
1.911 bisitz 7030: color: $font;
1.346 albertel 7031: }
1.706 harmsja 7032:
1.346 albertel 7033: .LC_current_location {
7034: background: $tabbg;
7035: }
1.795 www 7036:
1.1286 raeburn 7037: td.LC_zero_height {
7038: line-height: 0;
7039: cellpadding: 0;
7040: }
7041:
1.938 bisitz 7042: table.LC_data_table {
1.347 albertel 7043: border: 1px solid #000000;
1.402 albertel 7044: border-collapse: separate;
1.426 albertel 7045: border-spacing: 1px;
1.610 albertel 7046: background: $pgbg;
1.347 albertel 7047: }
1.795 www 7048:
1.422 albertel 7049: .LC_data_table_dense {
7050: font-size: small;
7051: }
1.795 www 7052:
1.507 raeburn 7053: table.LC_nested_outer {
7054: border: 1px solid #000000;
1.589 raeburn 7055: border-collapse: collapse;
1.803 bisitz 7056: border-spacing: 0;
1.507 raeburn 7057: width: 100%;
7058: }
1.795 www 7059:
1.879 raeburn 7060: table.LC_innerpickbox,
1.507 raeburn 7061: table.LC_nested {
1.803 bisitz 7062: border: none;
1.589 raeburn 7063: border-collapse: collapse;
1.803 bisitz 7064: border-spacing: 0;
1.507 raeburn 7065: width: 100%;
7066: }
1.795 www 7067:
1.911 bisitz 7068: table.LC_data_table tr th,
7069: table.LC_calendar tr th,
1.879 raeburn 7070: table.LC_prior_tries tr th,
7071: table.LC_innerpickbox tr th {
1.349 albertel 7072: font-weight: bold;
7073: background-color: $data_table_head;
1.801 tempelho 7074: color:$fontmenu;
1.701 harmsja 7075: font-size:90%;
1.347 albertel 7076: }
1.795 www 7077:
1.879 raeburn 7078: table.LC_innerpickbox tr th,
7079: table.LC_innerpickbox tr td {
7080: vertical-align: top;
7081: }
7082:
1.711 raeburn 7083: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 7084: background-color: #CCCCCC;
1.711 raeburn 7085: font-weight: bold;
7086: text-align: left;
7087: }
1.795 www 7088:
1.912 bisitz 7089: table.LC_data_table tr.LC_odd_row > td {
7090: background-color: $data_table_light;
7091: padding: 2px;
7092: vertical-align: top;
7093: }
7094:
1.809 bisitz 7095: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 7096: background-color: $data_table_light;
1.912 bisitz 7097: vertical-align: top;
7098: }
7099:
7100: table.LC_data_table tr.LC_even_row > td {
7101: background-color: $data_table_dark;
1.425 albertel 7102: padding: 2px;
1.900 bisitz 7103: vertical-align: top;
1.347 albertel 7104: }
1.795 www 7105:
1.809 bisitz 7106: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 7107: background-color: $data_table_dark;
1.900 bisitz 7108: vertical-align: top;
1.347 albertel 7109: }
1.795 www 7110:
1.425 albertel 7111: table.LC_data_table tr.LC_data_table_highlight td {
7112: background-color: $data_table_darker;
7113: }
1.795 www 7114:
1.639 raeburn 7115: table.LC_data_table tr td.LC_leftcol_header {
7116: background-color: $data_table_head;
7117: font-weight: bold;
7118: }
1.795 www 7119:
1.451 albertel 7120: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 7121: table.LC_nested tr.LC_empty_row td {
1.421 albertel 7122: font-weight: bold;
7123: font-style: italic;
7124: text-align: center;
7125: padding: 8px;
1.347 albertel 7126: }
1.795 www 7127:
1.1114 raeburn 7128: table.LC_data_table tr.LC_empty_row td,
7129: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 7130: background-color: $sidebg;
7131: }
7132:
7133: table.LC_nested tr.LC_empty_row td {
7134: background-color: #FFFFFF;
7135: }
7136:
1.890 droeschl 7137: table.LC_caption {
7138: }
7139:
1.507 raeburn 7140: table.LC_nested tr.LC_empty_row td {
1.465 albertel 7141: padding: 4ex
7142: }
1.795 www 7143:
1.507 raeburn 7144: table.LC_nested_outer tr th {
7145: font-weight: bold;
1.801 tempelho 7146: color:$fontmenu;
1.507 raeburn 7147: background-color: $data_table_head;
1.701 harmsja 7148: font-size: small;
1.507 raeburn 7149: border-bottom: 1px solid #000000;
7150: }
1.795 www 7151:
1.507 raeburn 7152: table.LC_nested_outer tr td.LC_subheader {
7153: background-color: $data_table_head;
7154: font-weight: bold;
7155: font-size: small;
7156: border-bottom: 1px solid #000000;
7157: text-align: right;
1.451 albertel 7158: }
1.795 www 7159:
1.507 raeburn 7160: table.LC_nested tr.LC_info_row td {
1.735 bisitz 7161: background-color: #CCCCCC;
1.451 albertel 7162: font-weight: bold;
7163: font-size: small;
1.507 raeburn 7164: text-align: center;
7165: }
1.795 www 7166:
1.589 raeburn 7167: table.LC_nested tr.LC_info_row td.LC_left_item,
7168: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 7169: text-align: left;
1.451 albertel 7170: }
1.795 www 7171:
1.507 raeburn 7172: table.LC_nested td {
1.735 bisitz 7173: background-color: #FFFFFF;
1.451 albertel 7174: font-size: small;
1.507 raeburn 7175: }
1.795 www 7176:
1.507 raeburn 7177: table.LC_nested_outer tr th.LC_right_item,
7178: table.LC_nested tr.LC_info_row td.LC_right_item,
7179: table.LC_nested tr.LC_odd_row td.LC_right_item,
7180: table.LC_nested tr td.LC_right_item {
1.451 albertel 7181: text-align: right;
7182: }
7183:
1.507 raeburn 7184: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 7185: background-color: #EEEEEE;
1.451 albertel 7186: }
7187:
1.473 raeburn 7188: table.LC_createuser {
7189: }
7190:
7191: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 7192: font-size: small;
1.473 raeburn 7193: }
7194:
7195: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 7196: background-color: #CCCCCC;
1.473 raeburn 7197: font-weight: bold;
7198: text-align: center;
7199: }
7200:
1.349 albertel 7201: table.LC_calendar {
7202: border: 1px solid #000000;
7203: border-collapse: collapse;
1.917 raeburn 7204: width: 98%;
1.349 albertel 7205: }
1.795 www 7206:
1.349 albertel 7207: table.LC_calendar_pickdate {
7208: font-size: xx-small;
7209: }
1.795 www 7210:
1.349 albertel 7211: table.LC_calendar tr td {
7212: border: 1px solid #000000;
7213: vertical-align: top;
1.917 raeburn 7214: width: 14%;
1.349 albertel 7215: }
1.795 www 7216:
1.349 albertel 7217: table.LC_calendar tr td.LC_calendar_day_empty {
7218: background-color: $data_table_dark;
7219: }
1.795 www 7220:
1.779 bisitz 7221: table.LC_calendar tr td.LC_calendar_day_current {
7222: background-color: $data_table_highlight;
1.777 tempelho 7223: }
1.795 www 7224:
1.938 bisitz 7225: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 7226: background-color: $mail_new;
7227: }
1.795 www 7228:
1.938 bisitz 7229: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 7230: background-color: $mail_new_hover;
7231: }
1.795 www 7232:
1.938 bisitz 7233: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 7234: background-color: $mail_read;
7235: }
1.795 www 7236:
1.938 bisitz 7237: /*
7238: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 7239: background-color: $mail_read_hover;
7240: }
1.938 bisitz 7241: */
1.795 www 7242:
1.938 bisitz 7243: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 7244: background-color: $mail_replied;
7245: }
1.795 www 7246:
1.938 bisitz 7247: /*
7248: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 7249: background-color: $mail_replied_hover;
7250: }
1.938 bisitz 7251: */
1.795 www 7252:
1.938 bisitz 7253: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 7254: background-color: $mail_other;
7255: }
1.795 www 7256:
1.938 bisitz 7257: /*
7258: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 7259: background-color: $mail_other_hover;
7260: }
1.938 bisitz 7261: */
1.494 raeburn 7262:
1.777 tempelho 7263: table.LC_data_table tr > td.LC_browser_file,
7264: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 7265: background: #AAEE77;
1.389 albertel 7266: }
1.795 www 7267:
1.777 tempelho 7268: table.LC_data_table tr > td.LC_browser_file_locked,
7269: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 7270: background: #FFAA99;
1.387 albertel 7271: }
1.795 www 7272:
1.777 tempelho 7273: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 7274: background: #888888;
1.779 bisitz 7275: }
1.795 www 7276:
1.777 tempelho 7277: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 7278: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 7279: background: #F8F866;
1.777 tempelho 7280: }
1.795 www 7281:
1.696 bisitz 7282: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 7283: background: #E0E8FF;
1.387 albertel 7284: }
1.696 bisitz 7285:
1.707 bisitz 7286: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 7287: /* background: #77FF77; */
1.707 bisitz 7288: }
1.795 www 7289:
1.707 bisitz 7290: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 7291: border-right: 8px solid #FFFF77;
1.707 bisitz 7292: }
1.795 www 7293:
1.707 bisitz 7294: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 7295: border-right: 8px solid #FFAA77;
1.707 bisitz 7296: }
1.795 www 7297:
1.707 bisitz 7298: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 7299: border-right: 8px solid #FF7777;
1.707 bisitz 7300: }
1.795 www 7301:
1.707 bisitz 7302: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 7303: border-right: 8px solid #AAFF77;
1.707 bisitz 7304: }
1.795 www 7305:
1.707 bisitz 7306: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 7307: border-right: 8px solid #11CC55;
1.707 bisitz 7308: }
7309:
1.388 albertel 7310: span.LC_current_location {
1.701 harmsja 7311: font-size:larger;
1.388 albertel 7312: background: $pgbg;
7313: }
1.387 albertel 7314:
1.1029 www 7315: span.LC_current_nav_location {
7316: font-weight:bold;
7317: background: $sidebg;
7318: }
7319:
1.395 albertel 7320: span.LC_parm_menu_item {
7321: font-size: larger;
7322: }
1.795 www 7323:
1.395 albertel 7324: span.LC_parm_scope_all {
7325: color: red;
7326: }
1.795 www 7327:
1.395 albertel 7328: span.LC_parm_scope_folder {
7329: color: green;
7330: }
1.795 www 7331:
1.395 albertel 7332: span.LC_parm_scope_resource {
7333: color: orange;
7334: }
1.795 www 7335:
1.395 albertel 7336: span.LC_parm_part {
7337: color: blue;
7338: }
1.795 www 7339:
1.911 bisitz 7340: span.LC_parm_folder,
7341: span.LC_parm_symb {
1.395 albertel 7342: font-size: x-small;
7343: font-family: $mono;
7344: color: #AAAAAA;
7345: }
7346:
1.977 bisitz 7347: ul.LC_parm_parmlist li {
7348: display: inline-block;
7349: padding: 0.3em 0.8em;
7350: vertical-align: top;
7351: width: 150px;
7352: border-top:1px solid $lg_border_color;
7353: }
7354:
1.795 www 7355: td.LC_parm_overview_level_menu,
7356: td.LC_parm_overview_map_menu,
7357: td.LC_parm_overview_parm_selectors,
7358: td.LC_parm_overview_restrictions {
1.396 albertel 7359: border: 1px solid black;
7360: border-collapse: collapse;
7361: }
1.795 www 7362:
1.1285 raeburn 7363: span.LC_parm_recursive,
7364: td.LC_parm_recursive {
7365: font-weight: bold;
7366: font-size: smaller;
7367: }
7368:
1.396 albertel 7369: table.LC_parm_overview_restrictions td {
7370: border-width: 1px 4px 1px 4px;
7371: border-style: solid;
7372: border-color: $pgbg;
7373: text-align: center;
7374: }
1.795 www 7375:
1.396 albertel 7376: table.LC_parm_overview_restrictions th {
7377: background: $tabbg;
7378: border-width: 1px 4px 1px 4px;
7379: border-style: solid;
7380: border-color: $pgbg;
7381: }
1.795 www 7382:
1.398 albertel 7383: table#LC_helpmenu {
1.803 bisitz 7384: border: none;
1.398 albertel 7385: height: 55px;
1.803 bisitz 7386: border-spacing: 0;
1.398 albertel 7387: }
7388:
7389: table#LC_helpmenu fieldset legend {
7390: font-size: larger;
7391: }
1.795 www 7392:
1.397 albertel 7393: table#LC_helpmenu_links {
7394: width: 100%;
7395: border: 1px solid black;
7396: background: $pgbg;
1.803 bisitz 7397: padding: 0;
1.397 albertel 7398: border-spacing: 1px;
7399: }
1.795 www 7400:
1.397 albertel 7401: table#LC_helpmenu_links tr td {
7402: padding: 1px;
7403: background: $tabbg;
1.399 albertel 7404: text-align: center;
7405: font-weight: bold;
1.397 albertel 7406: }
1.396 albertel 7407:
1.795 www 7408: table#LC_helpmenu_links a:link,
7409: table#LC_helpmenu_links a:visited,
1.397 albertel 7410: table#LC_helpmenu_links a:active {
7411: text-decoration: none;
7412: color: $font;
7413: }
1.795 www 7414:
1.397 albertel 7415: table#LC_helpmenu_links a:hover {
7416: text-decoration: underline;
7417: color: $vlink;
7418: }
1.396 albertel 7419:
1.417 albertel 7420: .LC_chrt_popup_exists {
7421: border: 1px solid #339933;
7422: margin: -1px;
7423: }
1.795 www 7424:
1.417 albertel 7425: .LC_chrt_popup_up {
7426: border: 1px solid yellow;
7427: margin: -1px;
7428: }
1.795 www 7429:
1.417 albertel 7430: .LC_chrt_popup {
7431: border: 1px solid #8888FF;
7432: background: #CCCCFF;
7433: }
1.795 www 7434:
1.421 albertel 7435: table.LC_pick_box {
7436: border-collapse: separate;
7437: background: white;
7438: border: 1px solid black;
7439: border-spacing: 1px;
7440: }
1.795 www 7441:
1.421 albertel 7442: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 7443: background: $sidebg;
1.421 albertel 7444: font-weight: bold;
1.900 bisitz 7445: text-align: left;
1.740 bisitz 7446: vertical-align: top;
1.421 albertel 7447: width: 184px;
7448: padding: 8px;
7449: }
1.795 www 7450:
1.579 raeburn 7451: table.LC_pick_box td.LC_pick_box_value {
7452: text-align: left;
7453: padding: 8px;
7454: }
1.795 www 7455:
1.579 raeburn 7456: table.LC_pick_box td.LC_pick_box_select {
7457: text-align: left;
7458: padding: 8px;
7459: }
1.795 www 7460:
1.424 albertel 7461: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 7462: padding: 0;
1.421 albertel 7463: height: 1px;
7464: background: black;
7465: }
1.795 www 7466:
1.421 albertel 7467: table.LC_pick_box td.LC_pick_box_submit {
7468: text-align: right;
7469: }
1.795 www 7470:
1.579 raeburn 7471: table.LC_pick_box td.LC_evenrow_value {
7472: text-align: left;
7473: padding: 8px;
7474: background-color: $data_table_light;
7475: }
1.795 www 7476:
1.579 raeburn 7477: table.LC_pick_box td.LC_oddrow_value {
7478: text-align: left;
7479: padding: 8px;
7480: background-color: $data_table_light;
7481: }
1.795 www 7482:
1.579 raeburn 7483: span.LC_helpform_receipt_cat {
7484: font-weight: bold;
7485: }
1.795 www 7486:
1.424 albertel 7487: table.LC_group_priv_box {
7488: background: white;
7489: border: 1px solid black;
7490: border-spacing: 1px;
7491: }
1.795 www 7492:
1.424 albertel 7493: table.LC_group_priv_box td.LC_pick_box_title {
7494: background: $tabbg;
7495: font-weight: bold;
7496: text-align: right;
7497: width: 184px;
7498: }
1.795 www 7499:
1.424 albertel 7500: table.LC_group_priv_box td.LC_groups_fixed {
7501: background: $data_table_light;
7502: text-align: center;
7503: }
1.795 www 7504:
1.424 albertel 7505: table.LC_group_priv_box td.LC_groups_optional {
7506: background: $data_table_dark;
7507: text-align: center;
7508: }
1.795 www 7509:
1.424 albertel 7510: table.LC_group_priv_box td.LC_groups_functionality {
7511: background: $data_table_darker;
7512: text-align: center;
7513: font-weight: bold;
7514: }
1.795 www 7515:
1.424 albertel 7516: table.LC_group_priv td {
7517: text-align: left;
1.803 bisitz 7518: padding: 0;
1.424 albertel 7519: }
7520:
7521: .LC_navbuttons {
7522: margin: 2ex 0ex 2ex 0ex;
7523: }
1.795 www 7524:
1.423 albertel 7525: .LC_topic_bar {
7526: font-weight: bold;
7527: background: $tabbg;
1.918 wenzelju 7528: margin: 1em 0em 1em 2em;
1.805 bisitz 7529: padding: 3px;
1.918 wenzelju 7530: font-size: 1.2em;
1.423 albertel 7531: }
1.795 www 7532:
1.423 albertel 7533: .LC_topic_bar span {
1.918 wenzelju 7534: left: 0.5em;
7535: position: absolute;
1.423 albertel 7536: vertical-align: middle;
1.918 wenzelju 7537: font-size: 1.2em;
1.423 albertel 7538: }
1.795 www 7539:
1.423 albertel 7540: table.LC_course_group_status {
7541: margin: 20px;
7542: }
1.795 www 7543:
1.423 albertel 7544: table.LC_status_selector td {
7545: vertical-align: top;
7546: text-align: center;
1.424 albertel 7547: padding: 4px;
7548: }
1.795 www 7549:
1.599 albertel 7550: div.LC_feedback_link {
1.616 albertel 7551: clear: both;
1.829 kalberla 7552: background: $sidebg;
1.779 bisitz 7553: width: 100%;
1.829 kalberla 7554: padding-bottom: 10px;
7555: border: 1px $tabbg solid;
1.833 kalberla 7556: height: 22px;
7557: line-height: 22px;
7558: padding-top: 5px;
7559: }
7560:
7561: div.LC_feedback_link img {
7562: height: 22px;
1.867 kalberla 7563: vertical-align:middle;
1.829 kalberla 7564: }
7565:
1.911 bisitz 7566: div.LC_feedback_link a {
1.829 kalberla 7567: text-decoration: none;
1.489 raeburn 7568: }
1.795 www 7569:
1.867 kalberla 7570: div.LC_comblock {
1.911 bisitz 7571: display:inline;
1.867 kalberla 7572: color:$font;
7573: font-size:90%;
7574: }
7575:
7576: div.LC_feedback_link div.LC_comblock {
7577: padding-left:5px;
7578: }
7579:
7580: div.LC_feedback_link div.LC_comblock a {
7581: color:$font;
7582: }
7583:
1.489 raeburn 7584: span.LC_feedback_link {
1.858 bisitz 7585: /* background: $feedback_link_bg; */
1.599 albertel 7586: font-size: larger;
7587: }
1.795 www 7588:
1.599 albertel 7589: span.LC_message_link {
1.858 bisitz 7590: /* background: $feedback_link_bg; */
1.599 albertel 7591: font-size: larger;
7592: position: absolute;
7593: right: 1em;
1.489 raeburn 7594: }
1.421 albertel 7595:
1.515 albertel 7596: table.LC_prior_tries {
1.524 albertel 7597: border: 1px solid #000000;
7598: border-collapse: separate;
7599: border-spacing: 1px;
1.515 albertel 7600: }
1.523 albertel 7601:
1.515 albertel 7602: table.LC_prior_tries td {
1.524 albertel 7603: padding: 2px;
1.515 albertel 7604: }
1.523 albertel 7605:
7606: .LC_answer_correct {
1.795 www 7607: background: lightgreen;
7608: color: darkgreen;
7609: padding: 6px;
1.523 albertel 7610: }
1.795 www 7611:
1.523 albertel 7612: .LC_answer_charged_try {
1.797 www 7613: background: #FFAAAA;
1.795 www 7614: color: darkred;
7615: padding: 6px;
1.523 albertel 7616: }
1.795 www 7617:
1.779 bisitz 7618: .LC_answer_not_charged_try,
1.523 albertel 7619: .LC_answer_no_grade,
7620: .LC_answer_late {
1.795 www 7621: background: lightyellow;
1.523 albertel 7622: color: black;
1.795 www 7623: padding: 6px;
1.523 albertel 7624: }
1.795 www 7625:
1.523 albertel 7626: .LC_answer_previous {
1.795 www 7627: background: lightblue;
7628: color: darkblue;
7629: padding: 6px;
1.523 albertel 7630: }
1.795 www 7631:
1.779 bisitz 7632: .LC_answer_no_message {
1.777 tempelho 7633: background: #FFFFFF;
7634: color: black;
1.795 www 7635: padding: 6px;
1.779 bisitz 7636: }
1.795 www 7637:
1.1334 raeburn 7638: .LC_answer_unknown,
7639: .LC_answer_warning {
1.779 bisitz 7640: background: orange;
7641: color: black;
1.795 www 7642: padding: 6px;
1.777 tempelho 7643: }
1.795 www 7644:
1.529 albertel 7645: span.LC_prior_numerical,
7646: span.LC_prior_string,
7647: span.LC_prior_custom,
7648: span.LC_prior_reaction,
7649: span.LC_prior_math {
1.925 bisitz 7650: font-family: $mono;
1.523 albertel 7651: white-space: pre;
7652: }
7653:
1.525 albertel 7654: span.LC_prior_string {
1.925 bisitz 7655: font-family: $mono;
1.525 albertel 7656: white-space: pre;
7657: }
7658:
1.523 albertel 7659: table.LC_prior_option {
7660: width: 100%;
7661: border-collapse: collapse;
7662: }
1.795 www 7663:
1.911 bisitz 7664: table.LC_prior_rank,
1.795 www 7665: table.LC_prior_match {
1.528 albertel 7666: border-collapse: collapse;
7667: }
1.795 www 7668:
1.528 albertel 7669: table.LC_prior_option tr td,
7670: table.LC_prior_rank tr td,
7671: table.LC_prior_match tr td {
1.524 albertel 7672: border: 1px solid #000000;
1.515 albertel 7673: }
7674:
1.855 bisitz 7675: .LC_nobreak {
1.544 albertel 7676: white-space: nowrap;
1.519 raeburn 7677: }
7678:
1.576 raeburn 7679: span.LC_cusr_emph {
7680: font-style: italic;
7681: }
7682:
1.633 raeburn 7683: span.LC_cusr_subheading {
7684: font-weight: normal;
7685: font-size: 85%;
7686: }
7687:
1.861 bisitz 7688: div.LC_docs_entry_move {
1.859 bisitz 7689: border: 1px solid #BBBBBB;
1.545 albertel 7690: background: #DDDDDD;
1.861 bisitz 7691: width: 22px;
1.859 bisitz 7692: padding: 1px;
7693: margin: 0;
1.545 albertel 7694: }
7695:
1.861 bisitz 7696: table.LC_data_table tr > td.LC_docs_entry_commands,
7697: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7698: font-size: x-small;
7699: }
1.795 www 7700:
1.861 bisitz 7701: .LC_docs_entry_parameter {
7702: white-space: nowrap;
7703: }
7704:
1.544 albertel 7705: .LC_docs_copy {
1.545 albertel 7706: color: #000099;
1.544 albertel 7707: }
1.795 www 7708:
1.544 albertel 7709: .LC_docs_cut {
1.545 albertel 7710: color: #550044;
1.544 albertel 7711: }
1.795 www 7712:
1.544 albertel 7713: .LC_docs_rename {
1.545 albertel 7714: color: #009900;
1.544 albertel 7715: }
1.795 www 7716:
1.544 albertel 7717: .LC_docs_remove {
1.545 albertel 7718: color: #990000;
7719: }
7720:
1.1284 raeburn 7721: .LC_docs_alias {
7722: color: #440055;
7723: }
7724:
1.1286 raeburn 7725: .LC_domprefs_email,
1.1284 raeburn 7726: .LC_docs_alias_name,
1.547 albertel 7727: .LC_docs_reinit_warn,
7728: .LC_docs_ext_edit {
7729: font-size: x-small;
7730: }
7731:
1.545 albertel 7732: table.LC_docs_adddocs td,
7733: table.LC_docs_adddocs th {
7734: border: 1px solid #BBBBBB;
7735: padding: 4px;
7736: background: #DDDDDD;
1.543 albertel 7737: }
7738:
1.584 albertel 7739: table.LC_sty_begin {
7740: background: #BBFFBB;
7741: }
1.795 www 7742:
1.584 albertel 7743: table.LC_sty_end {
7744: background: #FFBBBB;
7745: }
7746:
1.589 raeburn 7747: table.LC_double_column {
1.803 bisitz 7748: border-width: 0;
1.589 raeburn 7749: border-collapse: collapse;
7750: width: 100%;
7751: padding: 2px;
7752: }
7753:
7754: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7755: top: 2px;
1.589 raeburn 7756: left: 2px;
7757: width: 47%;
7758: vertical-align: top;
7759: }
7760:
7761: table.LC_double_column tr td.LC_right_col {
7762: top: 2px;
1.779 bisitz 7763: right: 2px;
1.589 raeburn 7764: width: 47%;
7765: vertical-align: top;
7766: }
7767:
1.591 raeburn 7768: div.LC_left_float {
7769: float: left;
7770: padding-right: 5%;
1.597 albertel 7771: padding-bottom: 4px;
1.591 raeburn 7772: }
7773:
7774: div.LC_clear_float_header {
1.597 albertel 7775: padding-bottom: 2px;
1.591 raeburn 7776: }
7777:
7778: div.LC_clear_float_footer {
1.597 albertel 7779: padding-top: 10px;
1.591 raeburn 7780: clear: both;
7781: }
7782:
1.597 albertel 7783: div.LC_grade_show_user {
1.941 bisitz 7784: /* border-left: 5px solid $sidebg; */
7785: border-top: 5px solid #000000;
7786: margin: 50px 0 0 0;
1.936 bisitz 7787: padding: 15px 0 5px 10px;
1.597 albertel 7788: }
1.795 www 7789:
1.936 bisitz 7790: div.LC_grade_show_user_odd_row {
1.941 bisitz 7791: /* border-left: 5px solid #000000; */
7792: }
7793:
7794: div.LC_grade_show_user div.LC_Box {
7795: margin-right: 50px;
1.597 albertel 7796: }
7797:
7798: div.LC_grade_submissions,
7799: div.LC_grade_message_center,
1.936 bisitz 7800: div.LC_grade_info_links {
1.597 albertel 7801: margin: 5px;
7802: width: 99%;
7803: background: #FFFFFF;
7804: }
1.795 www 7805:
1.597 albertel 7806: div.LC_grade_submissions_header,
1.936 bisitz 7807: div.LC_grade_message_center_header {
1.705 tempelho 7808: font-weight: bold;
7809: font-size: large;
1.597 albertel 7810: }
1.795 www 7811:
1.597 albertel 7812: div.LC_grade_submissions_body,
1.936 bisitz 7813: div.LC_grade_message_center_body {
1.597 albertel 7814: border: 1px solid black;
7815: width: 99%;
7816: background: #FFFFFF;
7817: }
1.795 www 7818:
1.613 albertel 7819: table.LC_scantron_action {
7820: width: 100%;
7821: }
1.795 www 7822:
1.613 albertel 7823: table.LC_scantron_action tr th {
1.698 harmsja 7824: font-weight:bold;
7825: font-style:normal;
1.613 albertel 7826: }
1.795 www 7827:
1.779 bisitz 7828: .LC_edit_problem_header,
1.614 albertel 7829: div.LC_edit_problem_footer {
1.705 tempelho 7830: font-weight: normal;
7831: font-size: medium;
1.602 albertel 7832: margin: 2px;
1.1060 bisitz 7833: background-color: $sidebg;
1.600 albertel 7834: }
1.795 www 7835:
1.600 albertel 7836: div.LC_edit_problem_header,
1.602 albertel 7837: div.LC_edit_problem_header div,
1.614 albertel 7838: div.LC_edit_problem_footer,
7839: div.LC_edit_problem_footer div,
1.602 albertel 7840: div.LC_edit_problem_editxml_header,
7841: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7842: z-index: 100;
1.600 albertel 7843: }
1.795 www 7844:
1.600 albertel 7845: div.LC_edit_problem_header_title {
1.705 tempelho 7846: font-weight: bold;
7847: font-size: larger;
1.602 albertel 7848: background: $tabbg;
7849: padding: 3px;
1.1060 bisitz 7850: margin: 0 0 5px 0;
1.602 albertel 7851: }
1.795 www 7852:
1.602 albertel 7853: table.LC_edit_problem_header_title {
7854: width: 100%;
1.600 albertel 7855: background: $tabbg;
1.602 albertel 7856: }
7857:
1.1205 golterma 7858: div.LC_edit_actionbar {
7859: background-color: $sidebg;
1.1218 droeschl 7860: margin: 0;
7861: padding: 0;
7862: line-height: 200%;
1.602 albertel 7863: }
1.795 www 7864:
1.1218 droeschl 7865: div.LC_edit_actionbar div{
7866: padding: 0;
7867: margin: 0;
7868: display: inline-block;
1.600 albertel 7869: }
1.795 www 7870:
1.1124 bisitz 7871: .LC_edit_opt {
7872: padding-left: 1em;
7873: white-space: nowrap;
7874: }
7875:
1.1152 golterma 7876: .LC_edit_problem_latexhelper{
7877: text-align: right;
7878: }
7879:
7880: #LC_edit_problem_colorful div{
7881: margin-left: 40px;
7882: }
7883:
1.1205 golterma 7884: #LC_edit_problem_codemirror div{
7885: margin-left: 0px;
7886: }
7887:
1.911 bisitz 7888: img.stift {
1.803 bisitz 7889: border-width: 0;
7890: vertical-align: middle;
1.677 riegler 7891: }
1.680 riegler 7892:
1.923 bisitz 7893: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7894: vertical-align: top;
1.777 tempelho 7895: }
1.795 www 7896:
1.716 raeburn 7897: div.LC_createcourse {
1.911 bisitz 7898: margin: 10px 10px 10px 10px;
1.716 raeburn 7899: }
7900:
1.917 raeburn 7901: .LC_dccid {
1.1130 raeburn 7902: float: right;
1.917 raeburn 7903: margin: 0.2em 0 0 0;
7904: padding: 0;
7905: font-size: 90%;
7906: display:none;
7907: }
7908:
1.897 wenzelju 7909: ol.LC_primary_menu a:hover,
1.721 harmsja 7910: ol#LC_MenuBreadcrumbs a:hover,
7911: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7912: ul#LC_secondary_menu a:hover,
1.721 harmsja 7913: .LC_FormSectionClearButton input:hover
1.795 www 7914: ul.LC_TabContent li:hover a {
1.952 onken 7915: color:$button_hover;
1.911 bisitz 7916: text-decoration:none;
1.693 droeschl 7917: }
7918:
1.779 bisitz 7919: h1 {
1.911 bisitz 7920: padding: 0;
7921: line-height:130%;
1.693 droeschl 7922: }
1.698 harmsja 7923:
1.911 bisitz 7924: h2,
7925: h3,
7926: h4,
7927: h5,
7928: h6 {
7929: margin: 5px 0 5px 0;
7930: padding: 0;
7931: line-height:130%;
1.693 droeschl 7932: }
1.795 www 7933:
7934: .LC_hcell {
1.911 bisitz 7935: padding:3px 15px 3px 15px;
7936: margin: 0;
7937: background-color:$tabbg;
7938: color:$fontmenu;
7939: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7940: }
1.795 www 7941:
1.840 bisitz 7942: .LC_Box > .LC_hcell {
1.911 bisitz 7943: margin: 0 -10px 10px -10px;
1.835 bisitz 7944: }
7945:
1.721 harmsja 7946: .LC_noBorder {
1.911 bisitz 7947: border: 0;
1.698 harmsja 7948: }
1.693 droeschl 7949:
1.721 harmsja 7950: .LC_FormSectionClearButton input {
1.911 bisitz 7951: background-color:transparent;
7952: border: none;
7953: cursor:pointer;
7954: text-decoration:underline;
1.693 droeschl 7955: }
1.763 bisitz 7956:
7957: .LC_help_open_topic {
1.911 bisitz 7958: color: #FFFFFF;
7959: background-color: #EEEEFF;
7960: margin: 1px;
7961: padding: 4px;
7962: border: 1px solid #000033;
7963: white-space: nowrap;
7964: /* vertical-align: middle; */
1.759 neumanie 7965: }
1.693 droeschl 7966:
1.911 bisitz 7967: dl,
7968: ul,
7969: div,
7970: fieldset {
7971: margin: 10px 10px 10px 0;
7972: /* overflow: hidden; */
1.693 droeschl 7973: }
1.795 www 7974:
1.1211 raeburn 7975: article.geogebraweb div {
7976: margin: 0;
7977: }
7978:
1.838 bisitz 7979: fieldset > legend {
1.911 bisitz 7980: font-weight: bold;
7981: padding: 0 5px 0 5px;
1.838 bisitz 7982: }
7983:
1.813 bisitz 7984: #LC_nav_bar {
1.911 bisitz 7985: float: left;
1.995 raeburn 7986: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7987: margin: 0 0 2px 0;
1.807 droeschl 7988: }
7989:
1.916 droeschl 7990: #LC_realm {
7991: margin: 0.2em 0 0 0;
7992: padding: 0;
7993: font-weight: bold;
7994: text-align: center;
1.995 raeburn 7995: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7996: }
7997:
1.911 bisitz 7998: #LC_nav_bar em {
7999: font-weight: bold;
8000: font-style: normal;
1.807 droeschl 8001: }
8002:
1.897 wenzelju 8003: ol.LC_primary_menu {
1.934 droeschl 8004: margin: 0;
1.1076 raeburn 8005: padding: 0;
1.807 droeschl 8006: }
8007:
1.852 droeschl 8008: ol#LC_PathBreadcrumbs {
1.911 bisitz 8009: margin: 0;
1.693 droeschl 8010: }
8011:
1.897 wenzelju 8012: ol.LC_primary_menu li {
1.1076 raeburn 8013: color: RGB(80, 80, 80);
8014: vertical-align: middle;
8015: text-align: left;
8016: list-style: none;
1.1205 golterma 8017: position: relative;
1.1076 raeburn 8018: float: left;
1.1205 golterma 8019: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
8020: line-height: 1.5em;
1.1076 raeburn 8021: }
8022:
1.1205 golterma 8023: ol.LC_primary_menu li a,
8024: ol.LC_primary_menu li p {
1.1076 raeburn 8025: display: block;
8026: margin: 0;
8027: padding: 0 5px 0 10px;
8028: text-decoration: none;
8029: }
8030:
1.1205 golterma 8031: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
8032: display: inline-block;
8033: width: 95%;
8034: text-align: left;
8035: }
8036:
8037: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
8038: display: inline-block;
8039: width: 5%;
8040: float: right;
8041: text-align: right;
8042: font-size: 70%;
8043: }
8044:
8045: ol.LC_primary_menu ul {
1.1076 raeburn 8046: display: none;
1.1205 golterma 8047: width: 15em;
1.1076 raeburn 8048: background-color: $data_table_light;
1.1205 golterma 8049: position: absolute;
8050: top: 100%;
1.1076 raeburn 8051: }
8052:
1.1205 golterma 8053: ol.LC_primary_menu ul ul {
8054: left: 100%;
8055: top: 0;
8056: }
8057:
8058: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 8059: display: block;
8060: position: absolute;
8061: margin: 0;
8062: padding: 0;
1.1078 raeburn 8063: z-index: 2;
1.1076 raeburn 8064: }
8065:
8066: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 8067: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 8068: font-size: 90%;
1.911 bisitz 8069: vertical-align: top;
1.1076 raeburn 8070: float: none;
1.1079 raeburn 8071: border-left: 1px solid black;
8072: border-right: 1px solid black;
1.1205 golterma 8073: /* A dark bottom border to visualize different menu options;
8074: overwritten in the create_submenu routine for the last border-bottom of the menu */
8075: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 8076: }
8077:
1.1205 golterma 8078: ol.LC_primary_menu li li p:hover {
8079: color:$button_hover;
8080: text-decoration:none;
8081: background-color:$data_table_dark;
1.1076 raeburn 8082: }
8083:
8084: ol.LC_primary_menu li li a:hover {
8085: color:$button_hover;
8086: background-color:$data_table_dark;
1.693 droeschl 8087: }
8088:
1.1205 golterma 8089: /* Font-size equal to the size of the predecessors*/
8090: ol.LC_primary_menu li:hover li li {
8091: font-size: 100%;
8092: }
8093:
1.897 wenzelju 8094: ol.LC_primary_menu li img {
1.911 bisitz 8095: vertical-align: bottom;
1.934 droeschl 8096: height: 1.1em;
1.1077 raeburn 8097: margin: 0.2em 0 0 0;
1.693 droeschl 8098: }
8099:
1.897 wenzelju 8100: ol.LC_primary_menu a {
1.911 bisitz 8101: color: RGB(80, 80, 80);
8102: text-decoration: none;
1.693 droeschl 8103: }
1.795 www 8104:
1.949 droeschl 8105: ol.LC_primary_menu a.LC_new_message {
8106: font-weight:bold;
8107: color: darkred;
8108: }
8109:
1.975 raeburn 8110: ol.LC_docs_parameters {
8111: margin-left: 0;
8112: padding: 0;
8113: list-style: none;
8114: }
8115:
8116: ol.LC_docs_parameters li {
8117: margin: 0;
8118: padding-right: 20px;
8119: display: inline;
8120: }
8121:
1.976 raeburn 8122: ol.LC_docs_parameters li:before {
8123: content: "\\002022 \\0020";
8124: }
8125:
8126: li.LC_docs_parameters_title {
8127: font-weight: bold;
8128: }
8129:
8130: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
8131: content: "";
8132: }
8133:
1.897 wenzelju 8134: ul#LC_secondary_menu {
1.1107 raeburn 8135: clear: right;
1.911 bisitz 8136: color: $fontmenu;
8137: background: $tabbg;
8138: list-style: none;
8139: padding: 0;
8140: margin: 0;
8141: width: 100%;
1.995 raeburn 8142: text-align: left;
1.1107 raeburn 8143: float: left;
1.808 droeschl 8144: }
8145:
1.897 wenzelju 8146: ul#LC_secondary_menu li {
1.911 bisitz 8147: font-weight: bold;
8148: line-height: 1.8em;
1.1107 raeburn 8149: border-right: 1px solid black;
8150: float: left;
8151: }
8152:
8153: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
8154: background-color: $data_table_light;
8155: }
8156:
8157: ul#LC_secondary_menu li a {
1.911 bisitz 8158: padding: 0 0.8em;
1.1107 raeburn 8159: }
8160:
8161: ul#LC_secondary_menu li ul {
8162: display: none;
8163: }
8164:
8165: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
8166: display: block;
8167: position: absolute;
8168: margin: 0;
8169: padding: 0;
8170: list-style:none;
8171: float: none;
8172: background-color: $data_table_light;
8173: z-index: 2;
8174: margin-left: -1px;
8175: }
8176:
8177: ul#LC_secondary_menu li ul li {
8178: font-size: 90%;
8179: vertical-align: top;
8180: border-left: 1px solid black;
1.911 bisitz 8181: border-right: 1px solid black;
1.1119 raeburn 8182: background-color: $data_table_light;
1.1107 raeburn 8183: list-style:none;
8184: float: none;
8185: }
8186:
8187: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
8188: background-color: $data_table_dark;
1.807 droeschl 8189: }
8190:
1.847 tempelho 8191: ul.LC_TabContent {
1.911 bisitz 8192: display:block;
8193: background: $sidebg;
8194: border-bottom: solid 1px $lg_border_color;
8195: list-style:none;
1.1020 raeburn 8196: margin: -1px -10px 0 -10px;
1.911 bisitz 8197: padding: 0;
1.693 droeschl 8198: }
8199:
1.795 www 8200: ul.LC_TabContent li,
8201: ul.LC_TabContentBigger li {
1.911 bisitz 8202: float:left;
1.741 harmsja 8203: }
1.795 www 8204:
1.897 wenzelju 8205: ul#LC_secondary_menu li a {
1.911 bisitz 8206: color: $fontmenu;
8207: text-decoration: none;
1.693 droeschl 8208: }
1.795 www 8209:
1.721 harmsja 8210: ul.LC_TabContent {
1.952 onken 8211: min-height:20px;
1.721 harmsja 8212: }
1.795 www 8213:
8214: ul.LC_TabContent li {
1.911 bisitz 8215: vertical-align:middle;
1.959 onken 8216: padding: 0 16px 0 10px;
1.911 bisitz 8217: background-color:$tabbg;
8218: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 8219: border-left: solid 1px $font;
1.721 harmsja 8220: }
1.795 www 8221:
1.847 tempelho 8222: ul.LC_TabContent .right {
1.911 bisitz 8223: float:right;
1.847 tempelho 8224: }
8225:
1.911 bisitz 8226: ul.LC_TabContent li a,
8227: ul.LC_TabContent li {
8228: color:rgb(47,47,47);
8229: text-decoration:none;
8230: font-size:95%;
8231: font-weight:bold;
1.952 onken 8232: min-height:20px;
8233: }
8234:
1.959 onken 8235: ul.LC_TabContent li a:hover,
8236: ul.LC_TabContent li a:focus {
1.952 onken 8237: color: $button_hover;
1.959 onken 8238: background:none;
8239: outline:none;
1.952 onken 8240: }
8241:
8242: ul.LC_TabContent li:hover {
8243: color: $button_hover;
8244: cursor:pointer;
1.721 harmsja 8245: }
1.795 www 8246:
1.911 bisitz 8247: ul.LC_TabContent li.active {
1.952 onken 8248: color: $font;
1.911 bisitz 8249: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 8250: border-bottom:solid 1px #FFFFFF;
8251: cursor: default;
1.744 ehlerst 8252: }
1.795 www 8253:
1.959 onken 8254: ul.LC_TabContent li.active a {
8255: color:$font;
8256: background:#FFFFFF;
8257: outline: none;
8258: }
1.1047 raeburn 8259:
8260: ul.LC_TabContent li.goback {
8261: float: left;
8262: border-left: none;
8263: }
8264:
1.870 tempelho 8265: #maincoursedoc {
1.911 bisitz 8266: clear:both;
1.870 tempelho 8267: }
8268:
8269: ul.LC_TabContentBigger {
1.911 bisitz 8270: display:block;
8271: list-style:none;
8272: padding: 0;
1.870 tempelho 8273: }
8274:
1.795 www 8275: ul.LC_TabContentBigger li {
1.911 bisitz 8276: vertical-align:bottom;
8277: height: 30px;
8278: font-size:110%;
8279: font-weight:bold;
8280: color: #737373;
1.841 tempelho 8281: }
8282:
1.957 onken 8283: ul.LC_TabContentBigger li.active {
8284: position: relative;
8285: top: 1px;
8286: }
8287:
1.870 tempelho 8288: ul.LC_TabContentBigger li a {
1.911 bisitz 8289: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
8290: height: 30px;
8291: line-height: 30px;
8292: text-align: center;
8293: display: block;
8294: text-decoration: none;
1.958 onken 8295: outline: none;
1.741 harmsja 8296: }
1.795 www 8297:
1.870 tempelho 8298: ul.LC_TabContentBigger li.active a {
1.911 bisitz 8299: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
8300: color:$font;
1.744 ehlerst 8301: }
1.795 www 8302:
1.870 tempelho 8303: ul.LC_TabContentBigger li b {
1.911 bisitz 8304: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
8305: display: block;
8306: float: left;
8307: padding: 0 30px;
1.957 onken 8308: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 8309: }
8310:
1.956 onken 8311: ul.LC_TabContentBigger li:hover b {
8312: color:$button_hover;
8313: }
8314:
1.870 tempelho 8315: ul.LC_TabContentBigger li.active b {
1.911 bisitz 8316: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
8317: color:$font;
1.957 onken 8318: border: 0;
1.741 harmsja 8319: }
1.693 droeschl 8320:
1.870 tempelho 8321:
1.862 bisitz 8322: ul.LC_CourseBreadcrumbs {
8323: background: $sidebg;
1.1020 raeburn 8324: height: 2em;
1.862 bisitz 8325: padding-left: 10px;
1.1020 raeburn 8326: margin: 0;
1.862 bisitz 8327: list-style-position: inside;
8328: }
8329:
1.911 bisitz 8330: ol#LC_MenuBreadcrumbs,
1.862 bisitz 8331: ol#LC_PathBreadcrumbs {
1.911 bisitz 8332: padding-left: 10px;
8333: margin: 0;
1.933 droeschl 8334: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 8335: }
8336:
1.911 bisitz 8337: ol#LC_MenuBreadcrumbs li,
8338: ol#LC_PathBreadcrumbs li,
1.862 bisitz 8339: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 8340: display: inline;
1.933 droeschl 8341: white-space: normal;
1.693 droeschl 8342: }
8343:
1.823 bisitz 8344: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 8345: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 8346: text-decoration: none;
8347: font-size:90%;
1.693 droeschl 8348: }
1.795 www 8349:
1.969 droeschl 8350: ol#LC_MenuBreadcrumbs h1 {
8351: display: inline;
8352: font-size: 90%;
8353: line-height: 2.5em;
8354: margin: 0;
8355: padding: 0;
8356: }
8357:
1.795 www 8358: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 8359: text-decoration:none;
8360: font-size:100%;
8361: font-weight:bold;
1.693 droeschl 8362: }
1.795 www 8363:
1.840 bisitz 8364: .LC_Box {
1.911 bisitz 8365: border: solid 1px $lg_border_color;
8366: padding: 0 10px 10px 10px;
1.746 neumanie 8367: }
1.795 www 8368:
1.1020 raeburn 8369: .LC_DocsBox {
8370: border: solid 1px $lg_border_color;
8371: padding: 0 0 10px 10px;
8372: }
8373:
1.795 www 8374: .LC_AboutMe_Image {
1.911 bisitz 8375: float:left;
8376: margin-right:10px;
1.747 neumanie 8377: }
1.795 www 8378:
8379: .LC_Clear_AboutMe_Image {
1.911 bisitz 8380: clear:left;
1.747 neumanie 8381: }
1.795 www 8382:
1.721 harmsja 8383: dl.LC_ListStyleClean dt {
1.911 bisitz 8384: padding-right: 5px;
8385: display: table-header-group;
1.693 droeschl 8386: }
8387:
1.721 harmsja 8388: dl.LC_ListStyleClean dd {
1.911 bisitz 8389: display: table-row;
1.693 droeschl 8390: }
8391:
1.721 harmsja 8392: .LC_ListStyleClean,
8393: .LC_ListStyleSimple,
8394: .LC_ListStyleNormal,
1.795 www 8395: .LC_ListStyleSpecial {
1.911 bisitz 8396: /* display:block; */
8397: list-style-position: inside;
8398: list-style-type: none;
8399: overflow: hidden;
8400: padding: 0;
1.693 droeschl 8401: }
8402:
1.721 harmsja 8403: .LC_ListStyleSimple li,
8404: .LC_ListStyleSimple dd,
8405: .LC_ListStyleNormal li,
8406: .LC_ListStyleNormal dd,
8407: .LC_ListStyleSpecial li,
1.795 www 8408: .LC_ListStyleSpecial dd {
1.911 bisitz 8409: margin: 0;
8410: padding: 5px 5px 5px 10px;
8411: clear: both;
1.693 droeschl 8412: }
8413:
1.721 harmsja 8414: .LC_ListStyleClean li,
8415: .LC_ListStyleClean dd {
1.911 bisitz 8416: padding-top: 0;
8417: padding-bottom: 0;
1.693 droeschl 8418: }
8419:
1.721 harmsja 8420: .LC_ListStyleSimple dd,
1.795 www 8421: .LC_ListStyleSimple li {
1.911 bisitz 8422: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 8423: }
8424:
1.721 harmsja 8425: .LC_ListStyleSpecial li,
8426: .LC_ListStyleSpecial dd {
1.911 bisitz 8427: list-style-type: none;
8428: background-color: RGB(220, 220, 220);
8429: margin-bottom: 4px;
1.693 droeschl 8430: }
8431:
1.721 harmsja 8432: table.LC_SimpleTable {
1.911 bisitz 8433: margin:5px;
8434: border:solid 1px $lg_border_color;
1.795 www 8435: }
1.693 droeschl 8436:
1.721 harmsja 8437: table.LC_SimpleTable tr {
1.911 bisitz 8438: padding: 0;
8439: border:solid 1px $lg_border_color;
1.693 droeschl 8440: }
1.795 www 8441:
8442: table.LC_SimpleTable thead {
1.911 bisitz 8443: background:rgb(220,220,220);
1.693 droeschl 8444: }
8445:
1.721 harmsja 8446: div.LC_columnSection {
1.911 bisitz 8447: display: block;
8448: clear: both;
8449: overflow: hidden;
8450: margin: 0;
1.693 droeschl 8451: }
8452:
1.721 harmsja 8453: div.LC_columnSection>* {
1.911 bisitz 8454: float: left;
8455: margin: 10px 20px 10px 0;
8456: overflow:hidden;
1.693 droeschl 8457: }
1.721 harmsja 8458:
1.795 www 8459: table em {
1.911 bisitz 8460: font-weight: bold;
8461: font-style: normal;
1.748 schulted 8462: }
1.795 www 8463:
1.779 bisitz 8464: table.LC_tableBrowseRes,
1.795 www 8465: table.LC_tableOfContent {
1.911 bisitz 8466: border:none;
8467: border-spacing: 1px;
8468: padding: 3px;
8469: background-color: #FFFFFF;
8470: font-size: 90%;
1.753 droeschl 8471: }
1.789 droeschl 8472:
1.911 bisitz 8473: table.LC_tableOfContent {
8474: border-collapse: collapse;
1.789 droeschl 8475: }
8476:
1.771 droeschl 8477: table.LC_tableBrowseRes a,
1.768 schulted 8478: table.LC_tableOfContent a {
1.911 bisitz 8479: background-color: transparent;
8480: text-decoration: none;
1.753 droeschl 8481: }
8482:
1.795 www 8483: table.LC_tableOfContent img {
1.911 bisitz 8484: border: none;
8485: height: 1.3em;
8486: vertical-align: text-bottom;
8487: margin-right: 0.3em;
1.753 droeschl 8488: }
1.757 schulted 8489:
1.795 www 8490: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8491: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8492: }
8493:
1.795 www 8494: a#LC_content_toolbar_everything {
1.911 bisitz 8495: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8496: }
8497:
1.795 www 8498: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8499: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8500: }
8501:
1.795 www 8502: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8503: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8504: }
8505:
1.795 www 8506: a#LC_content_toolbar_changefolder {
1.911 bisitz 8507: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8508: }
8509:
1.795 www 8510: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8511: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8512: }
8513:
1.1043 raeburn 8514: a#LC_content_toolbar_edittoplevel {
8515: background-image:url(/res/adm/pages/edittoplevel.gif);
8516: }
8517:
1.795 www 8518: ul#LC_toolbar li a:hover {
1.911 bisitz 8519: background-position: bottom center;
1.757 schulted 8520: }
8521:
1.795 www 8522: ul#LC_toolbar {
1.911 bisitz 8523: padding: 0;
8524: margin: 2px;
8525: list-style:none;
8526: position:relative;
8527: background-color:white;
1.1082 raeburn 8528: overflow: auto;
1.757 schulted 8529: }
8530:
1.795 www 8531: ul#LC_toolbar li {
1.911 bisitz 8532: border:1px solid white;
8533: padding: 0;
8534: margin: 0;
8535: float: left;
8536: display:inline;
8537: vertical-align:middle;
1.1082 raeburn 8538: white-space: nowrap;
1.911 bisitz 8539: }
1.757 schulted 8540:
1.783 amueller 8541:
1.795 www 8542: a.LC_toolbarItem {
1.911 bisitz 8543: display:block;
8544: padding: 0;
8545: margin: 0;
8546: height: 32px;
8547: width: 32px;
8548: color:white;
8549: border: none;
8550: background-repeat:no-repeat;
8551: background-color:transparent;
1.757 schulted 8552: }
8553:
1.915 droeschl 8554: ul.LC_funclist {
8555: margin: 0;
8556: padding: 0.5em 1em 0.5em 0;
8557: }
8558:
1.933 droeschl 8559: ul.LC_funclist > li:first-child {
8560: font-weight:bold;
8561: margin-left:0.8em;
8562: }
8563:
1.915 droeschl 8564: ul.LC_funclist + ul.LC_funclist {
8565: /*
8566: left border as a seperator if we have more than
8567: one list
8568: */
8569: border-left: 1px solid $sidebg;
8570: /*
8571: this hides the left border behind the border of the
8572: outer box if element is wrapped to the next 'line'
8573: */
8574: margin-left: -1px;
8575: }
8576:
1.843 bisitz 8577: ul.LC_funclist li {
1.915 droeschl 8578: display: inline;
1.782 bisitz 8579: white-space: nowrap;
1.915 droeschl 8580: margin: 0 0 0 25px;
8581: line-height: 150%;
1.782 bisitz 8582: }
8583:
1.974 wenzelju 8584: .LC_hidden {
8585: display: none;
8586: }
8587:
1.1030 www 8588: .LCmodal-overlay {
8589: position:fixed;
8590: top:0;
8591: right:0;
8592: bottom:0;
8593: left:0;
8594: height:100%;
8595: width:100%;
8596: margin:0;
8597: padding:0;
8598: background:#999;
8599: opacity:.75;
8600: filter: alpha(opacity=75);
8601: -moz-opacity: 0.75;
8602: z-index:101;
8603: }
8604:
8605: * html .LCmodal-overlay {
8606: position: absolute;
8607: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8608: }
8609:
8610: .LCmodal-window {
8611: position:fixed;
8612: top:50%;
8613: left:50%;
8614: margin:0;
8615: padding:0;
8616: z-index:102;
8617: }
8618:
8619: * html .LCmodal-window {
8620: position:absolute;
8621: }
8622:
8623: .LCclose-window {
8624: position:absolute;
8625: width:32px;
8626: height:32px;
8627: right:8px;
8628: top:8px;
8629: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8630: text-indent:-99999px;
8631: overflow:hidden;
8632: cursor:pointer;
8633: }
8634:
1.1369 raeburn 8635: .LCisDisabled {
8636: cursor: not-allowed;
8637: opacity: 0.5;
8638: }
8639:
8640: a[aria-disabled="true"] {
8641: color: currentColor;
8642: display: inline-block; /* For IE11/ MS Edge bug */
8643: pointer-events: none;
8644: text-decoration: none;
8645: }
8646:
1.1335 raeburn 8647: pre.LC_wordwrap {
8648: white-space: pre-wrap;
8649: white-space: -moz-pre-wrap;
8650: white-space: -pre-wrap;
8651: white-space: -o-pre-wrap;
8652: word-wrap: break-word;
8653: }
8654:
1.1100 raeburn 8655: /*
1.1231 damieng 8656: styles used for response display
8657: */
8658: div.LC_radiofoil, div.LC_rankfoil {
8659: margin: .5em 0em .5em 0em;
8660: }
8661: table.LC_itemgroup {
8662: margin-top: 1em;
8663: }
8664:
8665: /*
1.1100 raeburn 8666: styles used by TTH when "Default set of options to pass to tth/m
8667: when converting TeX" in course settings has been set
8668:
8669: option passed: -t
8670:
8671: */
8672:
8673: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8674: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8675: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8676: td div.norm {line-height:normal;}
8677:
8678: /*
8679: option passed -y3
8680: */
8681:
8682: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8683: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8684: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8685:
1.1230 damieng 8686: /*
8687: sections with roles, for content only
8688: */
8689: section[class^="role-"] {
8690: padding-left: 10px;
8691: padding-right: 5px;
8692: margin-top: 8px;
8693: margin-bottom: 8px;
8694: border: 1px solid #2A4;
8695: border-radius: 5px;
8696: box-shadow: 0px 1px 1px #BBB;
8697: }
8698: section[class^="role-"]>h1 {
8699: position: relative;
8700: margin: 0px;
8701: padding-top: 10px;
8702: padding-left: 40px;
8703: }
8704: section[class^="role-"]>h1:before {
8705: position: absolute;
8706: left: -5px;
8707: top: 5px;
8708: }
8709: section.role-activity>h1:before {
8710: content:url('/adm/daxe/images/section_icons/activity.png');
8711: }
8712: section.role-advice>h1:before {
8713: content:url('/adm/daxe/images/section_icons/advice.png');
8714: }
8715: section.role-bibliography>h1:before {
8716: content:url('/adm/daxe/images/section_icons/bibliography.png');
8717: }
8718: section.role-citation>h1:before {
8719: content:url('/adm/daxe/images/section_icons/citation.png');
8720: }
8721: section.role-conclusion>h1:before {
8722: content:url('/adm/daxe/images/section_icons/conclusion.png');
8723: }
8724: section.role-definition>h1:before {
8725: content:url('/adm/daxe/images/section_icons/definition.png');
8726: }
8727: section.role-demonstration>h1:before {
8728: content:url('/adm/daxe/images/section_icons/demonstration.png');
8729: }
8730: section.role-example>h1:before {
8731: content:url('/adm/daxe/images/section_icons/example.png');
8732: }
8733: section.role-explanation>h1:before {
8734: content:url('/adm/daxe/images/section_icons/explanation.png');
8735: }
8736: section.role-introduction>h1:before {
8737: content:url('/adm/daxe/images/section_icons/introduction.png');
8738: }
8739: section.role-method>h1:before {
8740: content:url('/adm/daxe/images/section_icons/method.png');
8741: }
8742: section.role-more_information>h1:before {
8743: content:url('/adm/daxe/images/section_icons/more_information.png');
8744: }
8745: section.role-objectives>h1:before {
8746: content:url('/adm/daxe/images/section_icons/objectives.png');
8747: }
8748: section.role-prerequisites>h1:before {
8749: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8750: }
8751: section.role-remark>h1:before {
8752: content:url('/adm/daxe/images/section_icons/remark.png');
8753: }
8754: section.role-reminder>h1:before {
8755: content:url('/adm/daxe/images/section_icons/reminder.png');
8756: }
8757: section.role-summary>h1:before {
8758: content:url('/adm/daxe/images/section_icons/summary.png');
8759: }
8760: section.role-syntax>h1:before {
8761: content:url('/adm/daxe/images/section_icons/syntax.png');
8762: }
8763: section.role-warning>h1:before {
8764: content:url('/adm/daxe/images/section_icons/warning.png');
8765: }
8766:
1.1269 raeburn 8767: #LC_minitab_header {
8768: float:left;
8769: width:100%;
8770: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8771: font-size:93%;
8772: line-height:normal;
8773: margin: 0.5em 0 0.5em 0;
8774: }
8775: #LC_minitab_header ul {
8776: margin:0;
8777: padding:10px 10px 0;
8778: list-style:none;
8779: }
8780: #LC_minitab_header li {
8781: float:left;
8782: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8783: margin:0;
8784: padding:0 0 0 9px;
8785: }
8786: #LC_minitab_header a {
8787: display:block;
8788: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8789: padding:5px 15px 4px 6px;
8790: }
8791: #LC_minitab_header #LC_current_minitab {
8792: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8793: }
8794: #LC_minitab_header #LC_current_minitab a {
8795: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8796: padding-bottom:5px;
8797: }
8798:
8799:
1.343 albertel 8800: END
8801: }
8802:
1.306 albertel 8803: =pod
8804:
8805: =item * &headtag()
8806:
8807: Returns a uniform footer for LON-CAPA web pages.
8808:
1.307 albertel 8809: Inputs: $title - optional title for the head
8810: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8811: $args - optional arguments
1.319 albertel 8812: force_register - if is true call registerurl so the remote is
8813: informed
1.415 albertel 8814: redirect -> array ref of
8815: 1- seconds before redirect occurs
8816: 2- url to redirect to
8817: 3- whether the side effect should occur
1.315 albertel 8818: (side effect of setting
8819: $env{'internal.head.redirect'} to the url
8820: redirected too)
1.352 albertel 8821: domain -> force to color decorate a page for a specific
8822: domain
8823: function -> force usage of a specific rolish color scheme
8824: bgcolor -> override the default page bgcolor
1.460 albertel 8825: no_auto_mt_title
8826: -> prevent &mt()ing the title arg
1.464 albertel 8827:
1.306 albertel 8828: =cut
8829:
8830: sub headtag {
1.313 albertel 8831: my ($title,$head_extra,$args) = @_;
1.306 albertel 8832:
1.363 albertel 8833: my $function = $args->{'function'} || &get_users_function();
8834: my $domain = $args->{'domain'} || &determinedomain();
8835: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8836: my $httphost = $args->{'use_absolute'};
1.418 albertel 8837: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8838: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8839: #time(),
1.418 albertel 8840: $env{'environment.color.timestamp'},
1.363 albertel 8841: $function,$domain,$bgcolor);
8842:
1.369 www 8843: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8844:
1.308 albertel 8845: my $result =
8846: '<head>'.
1.1160 raeburn 8847: &font_settings($args);
1.319 albertel 8848:
1.1188 raeburn 8849: my $inhibitprint;
8850: if ($args->{'print_suppress'}) {
8851: $inhibitprint = &print_suppression();
8852: }
1.1064 raeburn 8853:
1.461 albertel 8854: if (!$args->{'frameset'}) {
8855: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8856: }
1.962 droeschl 8857: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8858: $result .= Apache::lonxml::display_title();
1.319 albertel 8859: }
1.436 albertel 8860: if (!$args->{'no_nav_bar'}
8861: && !$args->{'only_body'}
8862: && !$args->{'frameset'}) {
1.1154 raeburn 8863: $result .= &help_menu_js($httphost);
1.1032 www 8864: $result.=&modal_window();
1.1038 www 8865: $result.=&togglebox_script();
1.1034 www 8866: $result.=&wishlist_window();
1.1041 www 8867: $result.=&LCprogressbarUpdate_script();
1.1034 www 8868: } else {
8869: if ($args->{'add_modal'}) {
8870: $result.=&modal_window();
8871: }
8872: if ($args->{'add_wishlist'}) {
8873: $result.=&wishlist_window();
8874: }
1.1038 www 8875: if ($args->{'add_togglebox'}) {
8876: $result.=&togglebox_script();
8877: }
1.1041 www 8878: if ($args->{'add_progressbar'}) {
8879: $result.=&LCprogressbarUpdate_script();
8880: }
1.436 albertel 8881: }
1.314 albertel 8882: if (ref($args->{'redirect'})) {
1.414 albertel 8883: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8884: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8885: if (!$inhibit_continue) {
8886: $env{'internal.head.redirect'} = $url;
8887: }
1.313 albertel 8888: $result.=<<ADDMETA
8889: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8890: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8891: ADDMETA
1.1210 raeburn 8892: } else {
8893: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8894: my $requrl = $env{'request.uri'};
8895: if ($requrl eq '') {
8896: $requrl = $ENV{'REQUEST_URI'};
8897: $requrl =~ s/\?.+$//;
8898: }
8899: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8900: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8901: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8902: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8903: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8904: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340 raeburn 8905: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1352 raeburn 8906: my ($offload,$offloadoth);
1.1210 raeburn 8907: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8908: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340 raeburn 8909: $offload = 1;
1.1353 raeburn 8910: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8911: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8912: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8913: $offloadoth = 1;
8914: $dom_in_use = $env{'user.domain'};
8915: }
8916: }
1.1340 raeburn 8917: }
8918: }
8919: unless ($offload) {
8920: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
8921: if ($domdefs{'offloadoth'}{$lonhost}) {
8922: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8923: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8924: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8925: $offload = 1;
1.1352 raeburn 8926: $offloadoth = 1;
1.1340 raeburn 8927: $dom_in_use = $env{'user.domain'};
8928: }
1.1210 raeburn 8929: }
1.1340 raeburn 8930: }
8931: }
8932: }
8933: if ($offload) {
1.1358 raeburn 8934: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1352 raeburn 8935: if (($newserver eq '') && ($offloadoth)) {
8936: my @domains = &Apache::lonnet::current_machine_domains();
8937: if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
8938: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
8939: }
8940: }
1.1340 raeburn 8941: if (($newserver) && ($newserver ne $lonhost)) {
8942: my $numsec = 5;
8943: my $timeout = $numsec * 1000;
8944: my ($newurl,$locknum,%locks,$msg);
8945: if ($env{'request.role.adv'}) {
8946: ($locknum,%locks) = &Apache::lonnet::get_locks();
8947: }
8948: my $disable_submit = 0;
8949: if ($requrl =~ /$LONCAPA::assess_re/) {
8950: $disable_submit = 1;
8951: }
8952: if ($locknum) {
8953: my @lockinfo = sort(values(%locks));
1.1354 raeburn 8954: $msg = &mt('Once the following tasks are complete:')." \n".
1.1340 raeburn 8955: join(", ",sort(values(%locks)))."\n";
8956: if (&show_course()) {
8957: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
8958: } else {
8959: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210 raeburn 8960: }
1.1340 raeburn 8961: } else {
8962: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8963: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
8964: }
8965: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8966: $newurl = '/adm/switchserver?otherserver='.$newserver;
8967: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8968: $newurl .= '&role='.$env{'request.role'};
8969: }
8970: if ($env{'request.symb'}) {
8971: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
8972: if ($shownsymb =~ m{^/enc/}) {
8973: my $reqdmajor = 2;
8974: my $reqdminor = 11;
8975: my $reqdsubminor = 3;
8976: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
8977: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
8978: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
8979: if (($major eq '' && $minor eq '') ||
8980: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
8981: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
8982: ($reqdsubminor > $subminor))))) {
8983: undef($shownsymb);
8984: }
1.1210 raeburn 8985: }
1.1340 raeburn 8986: if ($shownsymb) {
8987: &js_escape(\$shownsymb);
8988: $newurl .= '&symb='.$shownsymb;
1.1210 raeburn 8989: }
1.1340 raeburn 8990: } else {
8991: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
8992: &js_escape(\$shownurl);
8993: $newurl .= '&origurl='.$shownurl;
1.1210 raeburn 8994: }
1.1340 raeburn 8995: }
8996: &js_escape(\$msg);
8997: $result.=<<OFFLOAD
1.1210 raeburn 8998: <meta http-equiv="pragma" content="no-cache" />
8999: <script type="text/javascript">
1.1215 raeburn 9000: // <![CDATA[
1.1210 raeburn 9001: function LC_Offload_Now() {
9002: var dest = "$newurl";
9003: if (dest != '') {
9004: window.location.href="$newurl";
9005: }
9006: }
1.1214 raeburn 9007: \$(document).ready(function () {
9008: window.alert('$msg');
9009: if ($disable_submit) {
1.1210 raeburn 9010: \$(".LC_hwk_submit").prop("disabled", true);
9011: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 9012: }
9013: setTimeout('LC_Offload_Now()', $timeout);
9014: });
1.1215 raeburn 9015: // ]]>
1.1210 raeburn 9016: </script>
9017: OFFLOAD
9018: }
9019: }
9020: }
9021: }
9022: }
1.313 albertel 9023: }
1.306 albertel 9024: if (!defined($title)) {
9025: $title = 'The LearningOnline Network with CAPA';
9026: }
1.460 albertel 9027: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
9028: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 9029: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
9030: if (!$args->{'frameset'}) {
9031: $result .= ' /';
9032: }
9033: $result .= '>'
1.1064 raeburn 9034: .$inhibitprint
1.414 albertel 9035: .$head_extra;
1.1242 raeburn 9036: my $clientmobile;
9037: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
9038: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
9039: } else {
9040: $clientmobile = $env{'browser.mobile'};
9041: }
9042: if ($clientmobile) {
1.1137 raeburn 9043: $result .= '
9044: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
9045: <meta name="apple-mobile-web-app-capable" content="yes" />';
9046: }
1.1278 raeburn 9047: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 9048: return $result.'</head>';
1.306 albertel 9049: }
9050:
9051: =pod
9052:
1.340 albertel 9053: =item * &font_settings()
9054:
9055: Returns neccessary <meta> to set the proper encoding
9056:
1.1160 raeburn 9057: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 9058:
9059: =cut
9060:
9061: sub font_settings {
1.1160 raeburn 9062: my ($args) = @_;
1.340 albertel 9063: my $headerstring='';
1.1160 raeburn 9064: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
9065: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 9066: $headerstring.=
9067: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
9068: if (!$args->{'frameset'}) {
9069: $headerstring.= ' /';
9070: }
9071: $headerstring .= '>'."\n";
1.340 albertel 9072: }
9073: return $headerstring;
9074: }
9075:
1.341 albertel 9076: =pod
9077:
1.1064 raeburn 9078: =item * &print_suppression()
9079:
9080: In course context returns css which causes the body to be blank when media="print",
9081: if printout generation is unavailable for the current resource.
9082:
9083: This could be because:
9084:
9085: (a) printstartdate is in the future
9086:
9087: (b) printenddate is in the past
9088:
9089: (c) there is an active exam block with "printout"
9090: functionality blocked
9091:
9092: Users with pav, pfo or evb privileges are exempt.
9093:
9094: Inputs: none
9095:
9096: =cut
9097:
9098:
9099: sub print_suppression {
9100: my $noprint;
9101: if ($env{'request.course.id'}) {
9102: my $scope = $env{'request.course.id'};
9103: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9104: (&Apache::lonnet::allowed('pfo',$scope))) {
9105: return;
9106: }
9107: if ($env{'request.course.sec'} ne '') {
9108: $scope .= "/$env{'request.course.sec'}";
9109: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9110: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 9111: return;
1.1064 raeburn 9112: }
9113: }
9114: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9115: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 9116: my $clientip = &Apache::lonnet::get_requestor_ip();
9117: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 9118: if ($blocked) {
9119: my $checkrole = "cm./$cdom/$cnum";
9120: if ($env{'request.course.sec'} ne '') {
9121: $checkrole .= "/$env{'request.course.sec'}";
9122: }
9123: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
9124: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
9125: $noprint = 1;
9126: }
9127: }
9128: unless ($noprint) {
9129: my $symb = &Apache::lonnet::symbread();
9130: if ($symb ne '') {
9131: my $navmap = Apache::lonnavmaps::navmap->new();
9132: if (ref($navmap)) {
9133: my $res = $navmap->getBySymb($symb);
9134: if (ref($res)) {
9135: if (!$res->resprintable()) {
9136: $noprint = 1;
9137: }
9138: }
9139: }
9140: }
9141: }
9142: if ($noprint) {
9143: return <<"ENDSTYLE";
9144: <style type="text/css" media="print">
9145: body { display:none }
9146: </style>
9147: ENDSTYLE
9148: }
9149: }
9150: return;
9151: }
9152:
9153: =pod
9154:
1.341 albertel 9155: =item * &xml_begin()
9156:
9157: Returns the needed doctype and <html>
9158:
9159: Inputs: none
9160:
9161: =cut
9162:
9163: sub xml_begin {
1.1168 raeburn 9164: my ($is_frameset) = @_;
1.341 albertel 9165: my $output='';
9166:
9167: if ($env{'browser.mathml'}) {
9168: $output='<?xml version="1.0"?>'
9169: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
9170: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
9171:
9172: # .'<!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">] >'
9173: .'<!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">'
9174: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
9175: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 9176: } elsif ($is_frameset) {
9177: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
9178: '<html>'."\n";
1.341 albertel 9179: } else {
1.1168 raeburn 9180: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
9181: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 9182: }
9183: return $output;
9184: }
1.340 albertel 9185:
9186: =pod
9187:
1.306 albertel 9188: =item * &start_page()
9189:
9190: Returns a complete <html> .. <body> section for LON-CAPA web pages.
9191:
1.648 raeburn 9192: Inputs:
9193:
9194: =over 4
9195:
9196: $title - optional title for the page
9197:
9198: $head_extra - optional extra HTML to incude inside the <head>
9199:
9200: $args - additional optional args supported are:
9201:
9202: =over 8
9203:
9204: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 9205: arg on
1.814 bisitz 9206: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 9207: add_entries -> additional attributes to add to the <body>
9208: domain -> force to color decorate a page for a
1.317 albertel 9209: specific domain
1.648 raeburn 9210: function -> force usage of a specific rolish color
1.317 albertel 9211: scheme
1.648 raeburn 9212: redirect -> see &headtag()
9213: bgcolor -> override the default page bg color
9214: js_ready -> return a string ready for being used in
1.317 albertel 9215: a javascript writeln
1.648 raeburn 9216: html_encode -> return a string ready for being used in
1.320 albertel 9217: a html attribute
1.648 raeburn 9218: force_register -> if is true will turn on the &bodytag()
1.317 albertel 9219: $forcereg arg
1.648 raeburn 9220: frameset -> if true will start with a <frameset>
1.330 albertel 9221: rather than <body>
1.648 raeburn 9222: skip_phases -> hash ref of
1.338 albertel 9223: head -> skip the <html><head> generation
9224: body -> skip all <body> generation
1.648 raeburn 9225: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 9226: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 9227: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 9228: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
9229: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 9230: group -> includes the current group, if page is for a
1.1274 raeburn 9231: specific group
9232: use_absolute -> for request for external resource or syllabus, this
9233: will contain https://<hostname> if server uses
9234: https (as per hosts.tab), but request is for http
9235: hostname -> hostname, originally from $r->hostname(), (optional).
1.1369 raeburn 9236: links_disabled -> Links in primary and secondary menus are disabled
9237: (Can enable them once page has loaded - see lonroles.pm
9238: for an example).
1.361 albertel 9239:
1.648 raeburn 9240: =back
1.460 albertel 9241:
1.648 raeburn 9242: =back
1.562 albertel 9243:
1.306 albertel 9244: =cut
9245:
9246: sub start_page {
1.309 albertel 9247: my ($title,$head_extra,$args) = @_;
1.318 albertel 9248: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 9249:
1.315 albertel 9250: $env{'internal.start_page'}++;
1.1359 raeburn 9251: my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964 droeschl 9252:
1.338 albertel 9253: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 9254: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 9255: }
1.1316 raeburn 9256:
9257: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318 raeburn 9258: if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
9259: unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
9260: $args->{'no_primary_menu'} = 1;
9261: }
9262: unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
9263: $args->{'no_inline_menu'} = 1;
9264: }
9265: if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
9266: map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
9267: }
9268: } else {
9269: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9270: my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
9271: if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
9272: unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
9273: $args->{'no_primary_menu'} = 1;
9274: }
9275: unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
9276: $args->{'no_inline_menu'} = 1;
9277: }
9278: if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
9279: map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
9280: }
9281: }
9282: }
1.1316 raeburn 9283: ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
9284: $env{'course.'.$env{'request.course.id'}.'.domain'},
9285: $env{'course.'.$env{'request.course.id'}.'.num'});
1.1359 raeburn 9286: } elsif ($env{'request.course.id'}) {
9287: my $expiretime=600;
9288: if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
9289: &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
9290: }
9291: my ($deeplinkmenu,$menuref);
9292: ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
9293: if ($menucoll) {
9294: if (ref($menuref) eq 'HASH') {
9295: %menu = %{$menuref};
9296: }
9297: if ($menu{'top'} eq 'n') {
9298: $args->{'no_primary_menu'} = 1;
9299: }
9300: if ($menu{'inline'} eq 'n') {
9301: unless (&Apache::lonnet::allowed('opa')) {
9302: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9303: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9304: my $crstype = &course_type();
9305: my $now = time;
9306: my $ccrole;
9307: if ($crstype eq 'Community') {
9308: $ccrole = 'co';
9309: } else {
9310: $ccrole = 'cc';
9311: }
9312: if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
9313: my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
9314: if ((($start) && ($start<0)) ||
9315: (($end) && ($end<$now)) ||
9316: (($start) && ($now<$start))) {
9317: $args->{'no_inline_menu'} = 1;
9318: }
9319: } else {
9320: $args->{'no_inline_menu'} = 1;
9321: }
9322: }
9323: }
9324: }
1.1316 raeburn 9325: }
1.1359 raeburn 9326:
1.338 albertel 9327: if (! exists($args->{'skip_phases'}{'body'}) ) {
9328: if ($args->{'frameset'}) {
9329: my $attr_string = &make_attr_string($args->{'force_register'},
9330: $args->{'add_entries'});
9331: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 9332: } else {
9333: $result .=
9334: &bodytag($title,
9335: $args->{'function'}, $args->{'add_entries'},
9336: $args->{'only_body'}, $args->{'domain'},
9337: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 9338: $args->{'bgcolor'}, $args,
1.1359 raeburn 9339: \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu);
1.831 bisitz 9340: }
1.330 albertel 9341: }
1.338 albertel 9342:
1.315 albertel 9343: if ($args->{'js_ready'}) {
1.713 kaisler 9344: $result = &js_ready($result);
1.315 albertel 9345: }
1.320 albertel 9346: if ($args->{'html_encode'}) {
1.713 kaisler 9347: $result = &html_encode($result);
9348: }
9349:
1.813 bisitz 9350: # Preparation for new and consistent functionlist at top of screen
9351: # if ($args->{'functionlist'}) {
9352: # $result .= &build_functionlist();
9353: #}
9354:
1.964 droeschl 9355: # Don't add anything more if only_body wanted or in const space
9356: return $result if $args->{'only_body'}
9357: || $env{'request.state'} eq 'construct';
1.813 bisitz 9358:
9359: #Breadcrumbs
1.758 kaisler 9360: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
9361: &Apache::lonhtmlcommon::clear_breadcrumbs();
9362: #if any br links exists, add them to the breadcrumbs
9363: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
9364: foreach my $crumb (@{$args->{'bread_crumbs'}}){
9365: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
9366: }
9367: }
1.1096 raeburn 9368: # if @advtools array contains items add then to the breadcrumbs
9369: if (@advtools > 0) {
9370: &Apache::lonmenu::advtools_crumbs(@advtools);
9371: }
1.1272 raeburn 9372: my $menulink;
9373: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
9374: if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312 raeburn 9375: ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272 raeburn 9376: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
9377: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
9378: (!$env{'request.role.adv'}))) {
9379: $menulink = 0;
9380: } else {
9381: undef($menulink);
9382: }
1.758 kaisler 9383: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
9384: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 9385: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 9386: } else {
1.1272 raeburn 9387: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 9388: }
1.320 albertel 9389: }
1.315 albertel 9390: return $result;
1.306 albertel 9391: }
9392:
9393: sub end_page {
1.315 albertel 9394: my ($args) = @_;
9395: $env{'internal.end_page'}++;
1.330 albertel 9396: my $result;
1.335 albertel 9397: if ($args->{'discussion'}) {
9398: my ($target,$parser);
9399: if (ref($args->{'discussion'})) {
9400: ($target,$parser) =($args->{'discussion'}{'target'},
9401: $args->{'discussion'}{'parser'});
9402: }
9403: $result .= &Apache::lonxml::xmlend($target,$parser);
9404: }
1.330 albertel 9405: if ($args->{'frameset'}) {
9406: $result .= '</frameset>';
9407: } else {
1.635 raeburn 9408: $result .= &endbodytag($args);
1.330 albertel 9409: }
1.1080 raeburn 9410: unless ($args->{'notbody'}) {
9411: $result .= "\n</html>";
9412: }
1.330 albertel 9413:
1.315 albertel 9414: if ($args->{'js_ready'}) {
1.317 albertel 9415: $result = &js_ready($result);
1.315 albertel 9416: }
1.335 albertel 9417:
1.320 albertel 9418: if ($args->{'html_encode'}) {
9419: $result = &html_encode($result);
9420: }
1.335 albertel 9421:
1.315 albertel 9422: return $result;
9423: }
9424:
1.1359 raeburn 9425: sub menucoll_in_effect {
9426: my ($menucoll,$deeplinkmenu,%menu);
9427: if ($env{'request.course.id'}) {
9428: $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
1.1362 raeburn 9429: if ($env{'request.deeplink.login'}) {
1.1370 raeburn 9430: my ($deeplink_symb,$deeplink,$check_login_symb);
1.1362 raeburn 9431: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9432: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9433: if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
9434: if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
9435: my $navmap = Apache::lonnavmaps::navmap->new();
9436: if (ref($navmap)) {
9437: $deeplink = $navmap->get_mapparam(undef,
9438: &Apache::lonnet::declutter($env{'request.noversionuri'}),
9439: '0.deeplink');
1.1370 raeburn 9440: } else {
9441: $check_login_symb = 1;
1.1362 raeburn 9442: }
9443: } else {
1.1370 raeburn 9444: my $symb = &Apache::lonnet::symbread();
9445: if ($symb) {
9446: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
9447: } else {
9448: $check_login_symb = 1;
9449: }
1.1362 raeburn 9450: }
9451: } else {
1.1370 raeburn 9452: $check_login_symb = 1;
9453: }
9454: if ($check_login_symb) {
1.1362 raeburn 9455: $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
9456: if ($deeplink_symb =~ /\.(page|sequence)$/) {
9457: my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
9458: my $navmap = Apache::lonnavmaps::navmap->new();
9459: if (ref($navmap)) {
9460: $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
9461: }
9462: } else {
9463: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
9464: }
9465: }
1.1359 raeburn 9466: if ($deeplink ne '') {
1.1378 ! raeburn 9467: my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
1.1359 raeburn 9468: if ($display =~ /^\d+$/) {
9469: $deeplinkmenu = 1;
9470: $menucoll = $display;
9471: }
9472: }
9473: }
9474: if ($menucoll) {
9475: %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
9476: }
9477: }
9478: return ($menucoll,$deeplinkmenu,\%menu);
9479: }
9480:
1.1362 raeburn 9481: sub deeplink_login_symb {
9482: my ($cnum,$cdom) = @_;
9483: my $login_symb;
9484: if ($env{'request.deeplink.login'}) {
1.1364 raeburn 9485: $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
9486: }
9487: return $login_symb;
9488: }
9489:
9490: sub symb_from_tinyurl {
9491: my ($url,$cnum,$cdom) = @_;
9492: if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
9493: my $key = $1;
9494: my ($tinyurl,$login);
9495: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
9496: if (defined($cached)) {
9497: $tinyurl = $result;
9498: } else {
9499: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
9500: my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
9501: if ($currtiny{$key} ne '') {
9502: $tinyurl = $currtiny{$key};
9503: &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
1.1362 raeburn 9504: }
1.1364 raeburn 9505: }
9506: if ($tinyurl ne '') {
9507: my ($cnumreq,$symb) = split(/\&/,$tinyurl);
9508: if (wantarray) {
9509: return ($cnumreq,$symb);
9510: } elsif ($cnumreq eq $cnum) {
9511: return $symb;
1.1362 raeburn 9512: }
9513: }
9514: }
1.1364 raeburn 9515: if (wantarray) {
9516: return ();
9517: } else {
9518: return;
9519: }
1.1362 raeburn 9520: }
9521:
1.1034 www 9522: sub wishlist_window {
9523: return(<<'ENDWISHLIST');
1.1046 raeburn 9524: <script type="text/javascript">
1.1034 www 9525: // <![CDATA[
9526: // <!-- BEGIN LON-CAPA Internal
9527: function set_wishlistlink(title, path) {
9528: if (!title) {
9529: title = document.title;
9530: title = title.replace(/^LON-CAPA /,'');
9531: }
1.1175 raeburn 9532: title = encodeURIComponent(title);
1.1203 raeburn 9533: title = title.replace("'","\\\'");
1.1034 www 9534: if (!path) {
9535: path = location.pathname;
9536: }
1.1175 raeburn 9537: path = encodeURIComponent(path);
1.1203 raeburn 9538: path = path.replace("'","\\\'");
1.1034 www 9539: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
9540: 'wishlistNewLink','width=560,height=350,scrollbars=0');
9541: }
9542: // END LON-CAPA Internal -->
9543: // ]]>
9544: </script>
9545: ENDWISHLIST
9546: }
9547:
1.1030 www 9548: sub modal_window {
9549: return(<<'ENDMODAL');
1.1046 raeburn 9550: <script type="text/javascript">
1.1030 www 9551: // <![CDATA[
9552: // <!-- BEGIN LON-CAPA Internal
9553: var modalWindow = {
9554: parent:"body",
9555: windowId:null,
9556: content:null,
9557: width:null,
9558: height:null,
9559: close:function()
9560: {
9561: $(".LCmodal-window").remove();
9562: $(".LCmodal-overlay").remove();
9563: },
9564: open:function()
9565: {
9566: var modal = "";
9567: modal += "<div class=\"LCmodal-overlay\"></div>";
9568: 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;\">";
9569: modal += this.content;
9570: modal += "</div>";
9571:
9572: $(this.parent).append(modal);
9573:
9574: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
9575: $(".LCclose-window").click(function(){modalWindow.close();});
9576: $(".LCmodal-overlay").click(function(){modalWindow.close();});
9577: }
9578: };
1.1140 raeburn 9579: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 9580: {
1.1266 raeburn 9581: source = source.replace(/'/g,"'");
1.1030 www 9582: modalWindow.windowId = "myModal";
9583: modalWindow.width = width;
9584: modalWindow.height = height;
1.1196 raeburn 9585: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 9586: modalWindow.open();
1.1208 raeburn 9587: };
1.1030 www 9588: // END LON-CAPA Internal -->
9589: // ]]>
9590: </script>
9591: ENDMODAL
9592: }
9593:
9594: sub modal_link {
1.1140 raeburn 9595: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 9596: unless ($width) { $width=480; }
9597: unless ($height) { $height=400; }
1.1031 www 9598: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 9599: unless ($transparency) { $transparency='true'; }
9600:
1.1074 raeburn 9601: my $target_attr;
9602: if (defined($target)) {
9603: $target_attr = 'target="'.$target.'"';
9604: }
9605: return <<"ENDLINK";
1.1336 raeburn 9606: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 9607: ENDLINK
1.1030 www 9608: }
9609:
1.1032 www 9610: sub modal_adhoc_script {
1.1365 raeburn 9611: my ($funcname,$width,$height,$content,$possmathjax)=@_;
9612: my $mathjax;
9613: if ($possmathjax) {
9614: $mathjax = <<'ENDJAX';
9615: if (typeof MathJax == 'object') {
9616: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
9617: }
9618: ENDJAX
9619: }
1.1032 www 9620: return (<<ENDADHOC);
1.1046 raeburn 9621: <script type="text/javascript">
1.1032 www 9622: // <![CDATA[
9623: var $funcname = function()
9624: {
9625: modalWindow.windowId = "myModal";
9626: modalWindow.width = $width;
9627: modalWindow.height = $height;
9628: modalWindow.content = '$content';
9629: modalWindow.open();
1.1365 raeburn 9630: $mathjax
1.1032 www 9631: };
9632: // ]]>
9633: </script>
9634: ENDADHOC
9635: }
9636:
1.1041 www 9637: sub modal_adhoc_inner {
1.1365 raeburn 9638: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 9639: my $innerwidth=$width-20;
9640: $content=&js_ready(
1.1140 raeburn 9641: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
9642: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
9643: $content.
1.1041 www 9644: &end_scrollbox().
1.1140 raeburn 9645: &end_page()
1.1041 www 9646: );
1.1365 raeburn 9647: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 9648: }
9649:
9650: sub modal_adhoc_window {
1.1365 raeburn 9651: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
9652: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 9653: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
9654: }
9655:
9656: sub modal_adhoc_launch {
9657: my ($funcname,$width,$height,$content)=@_;
9658: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
9659: <script type="text/javascript">
9660: // <![CDATA[
9661: $funcname();
9662: // ]]>
9663: </script>
9664: ENDLAUNCH
9665: }
9666:
9667: sub modal_adhoc_close {
9668: return (<<ENDCLOSE);
9669: <script type="text/javascript">
9670: // <![CDATA[
9671: modalWindow.close();
9672: // ]]>
9673: </script>
9674: ENDCLOSE
9675: }
9676:
1.1038 www 9677: sub togglebox_script {
9678: return(<<ENDTOGGLE);
9679: <script type="text/javascript">
9680: // <![CDATA[
9681: function LCtoggleDisplay(id,hidetext,showtext) {
9682: link = document.getElementById(id + "link").childNodes[0];
9683: with (document.getElementById(id).style) {
9684: if (display == "none" ) {
9685: display = "inline";
9686: link.nodeValue = hidetext;
9687: } else {
9688: display = "none";
9689: link.nodeValue = showtext;
9690: }
9691: }
9692: }
9693: // ]]>
9694: </script>
9695: ENDTOGGLE
9696: }
9697:
1.1039 www 9698: sub start_togglebox {
9699: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
9700: unless ($heading) { $heading=''; } else { $heading.=' '; }
9701: unless ($showtext) { $showtext=&mt('show'); }
9702: unless ($hidetext) { $hidetext=&mt('hide'); }
9703: unless ($headerbg) { $headerbg='#FFFFFF'; }
9704: return &start_data_table().
9705: &start_data_table_header_row().
9706: '<td bgcolor="'.$headerbg.'">'.$heading.
9707: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
9708: $showtext.'\')">'.$showtext.'</a>]</td>'.
9709: &end_data_table_header_row().
9710: '<tr id="'.$id.'" style="display:none""><td>';
9711: }
9712:
9713: sub end_togglebox {
9714: return '</td></tr>'.&end_data_table();
9715: }
9716:
1.1041 www 9717: sub LCprogressbar_script {
1.1302 raeburn 9718: my ($id,$number_to_do)=@_;
9719: if ($number_to_do) {
9720: return(<<ENDPROGRESS);
1.1041 www 9721: <script type="text/javascript">
9722: // <![CDATA[
1.1045 www 9723: \$('#progressbar$id').progressbar({
1.1041 www 9724: value: 0,
9725: change: function(event, ui) {
9726: var newVal = \$(this).progressbar('option', 'value');
9727: \$('.pblabel', this).text(LCprogressTxt);
9728: }
9729: });
9730: // ]]>
9731: </script>
9732: ENDPROGRESS
1.1302 raeburn 9733: } else {
9734: return(<<ENDPROGRESS);
9735: <script type="text/javascript">
9736: // <![CDATA[
9737: \$('#progressbar$id').progressbar({
9738: value: false,
9739: create: function(event, ui) {
9740: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
9741: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
9742: }
9743: });
9744: // ]]>
9745: </script>
9746: ENDPROGRESS
9747: }
1.1041 www 9748: }
9749:
9750: sub LCprogressbarUpdate_script {
9751: return(<<ENDPROGRESSUPDATE);
9752: <style type="text/css">
9753: .ui-progressbar { position:relative; }
1.1302 raeburn 9754: .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 9755: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
9756: </style>
9757: <script type="text/javascript">
9758: // <![CDATA[
1.1045 www 9759: var LCprogressTxt='---';
9760:
1.1302 raeburn 9761: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 9762: LCprogressTxt=progresstext;
1.1302 raeburn 9763: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
9764: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
9765: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 9766: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
9767: } else {
9768: \$('#progressbar'+id).progressbar('value',percent);
9769: }
1.1041 www 9770: }
9771: // ]]>
9772: </script>
9773: ENDPROGRESSUPDATE
9774: }
9775:
1.1042 www 9776: my $LClastpercent;
1.1045 www 9777: my $LCidcnt;
9778: my $LCcurrentid;
1.1042 www 9779:
1.1041 www 9780: sub LCprogressbar {
1.1302 raeburn 9781: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 9782: $LClastpercent=0;
1.1045 www 9783: $LCidcnt++;
9784: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 9785: my ($starting,$content);
9786: if ($number_to_do) {
9787: $starting=&mt('Starting');
9788: $content=(<<ENDPROGBAR);
9789: $preamble
1.1045 www 9790: <div id="progressbar$LCcurrentid">
1.1041 www 9791: <span class="pblabel">$starting</span>
9792: </div>
9793: ENDPROGBAR
1.1302 raeburn 9794: } else {
9795: $starting=&mt('Loading...');
9796: $LClastpercent='false';
9797: $content=(<<ENDPROGBAR);
9798: $preamble
9799: <div id="progressbar$LCcurrentid">
9800: <div class="progress-label">$starting</div>
9801: </div>
9802: ENDPROGBAR
9803: }
9804: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 9805: }
9806:
9807: sub LCprogressbarUpdate {
1.1302 raeburn 9808: my ($r,$val,$text,$number_to_do)=@_;
9809: if ($number_to_do) {
9810: unless ($val) {
9811: if ($LClastpercent) {
9812: $val=$LClastpercent;
9813: } else {
9814: $val=0;
9815: }
9816: }
9817: if ($val<0) { $val=0; }
9818: if ($val>100) { $val=0; }
9819: $LClastpercent=$val;
9820: unless ($text) { $text=$val.'%'; }
9821: } else {
9822: $val = 'false';
1.1042 www 9823: }
1.1041 www 9824: $text=&js_ready($text);
1.1044 www 9825: &r_print($r,<<ENDUPDATE);
1.1041 www 9826: <script type="text/javascript">
9827: // <![CDATA[
1.1302 raeburn 9828: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 9829: // ]]>
9830: </script>
9831: ENDUPDATE
1.1035 www 9832: }
9833:
1.1042 www 9834: sub LCprogressbarClose {
9835: my ($r)=@_;
9836: $LClastpercent=0;
1.1044 www 9837: &r_print($r,<<ENDCLOSE);
1.1042 www 9838: <script type="text/javascript">
9839: // <![CDATA[
1.1045 www 9840: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 9841: // ]]>
9842: </script>
9843: ENDCLOSE
1.1044 www 9844: }
9845:
9846: sub r_print {
9847: my ($r,$to_print)=@_;
9848: if ($r) {
9849: $r->print($to_print);
9850: $r->rflush();
9851: } else {
9852: print($to_print);
9853: }
1.1042 www 9854: }
9855:
1.320 albertel 9856: sub html_encode {
9857: my ($result) = @_;
9858:
1.322 albertel 9859: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 9860:
9861: return $result;
9862: }
1.1044 www 9863:
1.317 albertel 9864: sub js_ready {
9865: my ($result) = @_;
9866:
1.323 albertel 9867: $result =~ s/[\n\r]/ /xmsg;
9868: $result =~ s/\\/\\\\/xmsg;
9869: $result =~ s/'/\\'/xmsg;
1.372 albertel 9870: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 9871:
9872: return $result;
9873: }
9874:
1.315 albertel 9875: sub validate_page {
9876: if ( exists($env{'internal.start_page'})
1.316 albertel 9877: && $env{'internal.start_page'} > 1) {
9878: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 9879: $env{'internal.start_page'}.' '.
1.316 albertel 9880: $ENV{'request.filename'});
1.315 albertel 9881: }
9882: if ( exists($env{'internal.end_page'})
1.316 albertel 9883: && $env{'internal.end_page'} > 1) {
9884: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 9885: $env{'internal.end_page'}.' '.
1.316 albertel 9886: $env{'request.filename'});
1.315 albertel 9887: }
9888: if ( exists($env{'internal.start_page'})
9889: && ! exists($env{'internal.end_page'})) {
1.316 albertel 9890: &Apache::lonnet::logthis('start_page called without end_page '.
9891: $env{'request.filename'});
1.315 albertel 9892: }
9893: if ( ! exists($env{'internal.start_page'})
9894: && exists($env{'internal.end_page'})) {
1.316 albertel 9895: &Apache::lonnet::logthis('end_page called without start_page'.
9896: $env{'request.filename'});
1.315 albertel 9897: }
1.306 albertel 9898: }
1.315 albertel 9899:
1.996 www 9900:
9901: sub start_scrollbox {
1.1140 raeburn 9902: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 9903: unless ($outerwidth) { $outerwidth='520px'; }
9904: unless ($width) { $width='500px'; }
9905: unless ($height) { $height='200px'; }
1.1075 raeburn 9906: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 9907: if ($id ne '') {
1.1140 raeburn 9908: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 9909: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 9910: }
1.1075 raeburn 9911: if ($bgcolor ne '') {
9912: $tdcol = "background-color: $bgcolor;";
9913: }
1.1137 raeburn 9914: my $nicescroll_js;
9915: if ($env{'browser.mobile'}) {
1.1140 raeburn 9916: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
9917: }
9918: return <<"END";
9919: $nicescroll_js
9920:
9921: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
9922: <div style="overflow:auto; width:$width; height:$height;"$div_id>
9923: END
9924: }
9925:
9926: sub end_scrollbox {
9927: return '</div></td></tr></table>';
9928: }
9929:
9930: sub nicescroll_javascript {
9931: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
9932: my %options;
9933: if (ref($cursor) eq 'HASH') {
9934: %options = %{$cursor};
9935: }
9936: unless ($options{'railalign'} =~ /^left|right$/) {
9937: $options{'railalign'} = 'left';
9938: }
9939: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9940: my $function = &get_users_function();
9941: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 9942: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 9943: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 9944: }
1.1140 raeburn 9945: }
9946: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
9947: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 9948: $options{'cursoropacity'}='1.0';
9949: }
1.1140 raeburn 9950: } else {
9951: $options{'cursoropacity'}='1.0';
9952: }
9953: if ($options{'cursorfixedheight'} eq 'none') {
9954: delete($options{'cursorfixedheight'});
9955: } else {
9956: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
9957: }
9958: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
9959: delete($options{'railoffset'});
9960: }
9961: my @niceoptions;
9962: while (my($key,$value) = each(%options)) {
9963: if ($value =~ /^\{.+\}$/) {
9964: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 9965: } else {
1.1140 raeburn 9966: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 9967: }
1.1140 raeburn 9968: }
9969: my $nicescroll_js = '
1.1137 raeburn 9970: $(document).ready(
1.1140 raeburn 9971: function() {
9972: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
9973: }
1.1137 raeburn 9974: );
9975: ';
1.1140 raeburn 9976: if ($framecheck) {
9977: $nicescroll_js .= '
9978: function expand_div(caller) {
9979: if (top === self) {
9980: document.getElementById("'.$id.'").style.width = "auto";
9981: document.getElementById("'.$id.'").style.height = "auto";
9982: } else {
9983: try {
9984: if (parent.frames) {
9985: if (parent.frames.length > 1) {
9986: var framesrc = parent.frames[1].location.href;
9987: var currsrc = framesrc.replace(/\#.*$/,"");
9988: if ((caller == "search") || (currsrc == "'.$location.'")) {
9989: document.getElementById("'.$id.'").style.width = "auto";
9990: document.getElementById("'.$id.'").style.height = "auto";
9991: }
9992: }
9993: }
9994: } catch (e) {
9995: return;
9996: }
1.1137 raeburn 9997: }
1.1140 raeburn 9998: return;
1.996 www 9999: }
1.1140 raeburn 10000: ';
10001: }
10002: if ($needjsready) {
10003: $nicescroll_js = '
10004: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
10005: } else {
10006: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
10007: }
10008: return $nicescroll_js;
1.996 www 10009: }
10010:
1.318 albertel 10011: sub simple_error_page {
1.1150 bisitz 10012: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 10013: my %displayargs;
1.1151 raeburn 10014: if (ref($args) eq 'HASH') {
10015: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 10016: if ($args->{'only_body'}) {
10017: $displayargs{'only_body'} = 1;
10018: }
10019: if ($args->{'no_nav_bar'}) {
10020: $displayargs{'no_nav_bar'} = 1;
10021: }
1.1151 raeburn 10022: } else {
10023: $msg = &mt($msg);
10024: }
1.1150 bisitz 10025:
1.318 albertel 10026: my $page =
1.1304 raeburn 10027: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 10028: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 10029: &Apache::loncommon::end_page();
10030: if (ref($r)) {
10031: $r->print($page);
1.327 albertel 10032: return;
1.318 albertel 10033: }
10034: return $page;
10035: }
1.347 albertel 10036:
10037: {
1.610 albertel 10038: my @row_count;
1.961 onken 10039:
10040: sub start_data_table_count {
10041: unshift(@row_count, 0);
10042: return;
10043: }
10044:
10045: sub end_data_table_count {
10046: shift(@row_count);
10047: return;
10048: }
10049:
1.347 albertel 10050: sub start_data_table {
1.1018 raeburn 10051: my ($add_class,$id) = @_;
1.422 albertel 10052: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 10053: my $table_id;
10054: if (defined($id)) {
10055: $table_id = ' id="'.$id.'"';
10056: }
1.961 onken 10057: &start_data_table_count();
1.1018 raeburn 10058: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 10059: }
10060:
10061: sub end_data_table {
1.961 onken 10062: &end_data_table_count();
1.389 albertel 10063: return '</table>'."\n";;
1.347 albertel 10064: }
10065:
10066: sub start_data_table_row {
1.974 wenzelju 10067: my ($add_class, $id) = @_;
1.610 albertel 10068: $row_count[0]++;
10069: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 10070: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 10071: $id = (' id="'.$id.'"') unless ($id eq '');
10072: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 10073: }
1.471 banghart 10074:
10075: sub continue_data_table_row {
1.974 wenzelju 10076: my ($add_class, $id) = @_;
1.610 albertel 10077: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 10078: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
10079: $id = (' id="'.$id.'"') unless ($id eq '');
10080: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 10081: }
1.347 albertel 10082:
10083: sub end_data_table_row {
1.389 albertel 10084: return '</tr>'."\n";;
1.347 albertel 10085: }
1.367 www 10086:
1.421 albertel 10087: sub start_data_table_empty_row {
1.707 bisitz 10088: # $row_count[0]++;
1.421 albertel 10089: return '<tr class="LC_empty_row" >'."\n";;
10090: }
10091:
10092: sub end_data_table_empty_row {
10093: return '</tr>'."\n";;
10094: }
10095:
1.367 www 10096: sub start_data_table_header_row {
1.389 albertel 10097: return '<tr class="LC_header_row">'."\n";;
1.367 www 10098: }
10099:
10100: sub end_data_table_header_row {
1.389 albertel 10101: return '</tr>'."\n";;
1.367 www 10102: }
1.890 droeschl 10103:
10104: sub data_table_caption {
10105: my $caption = shift;
10106: return "<caption class=\"LC_caption\">$caption</caption>";
10107: }
1.347 albertel 10108: }
10109:
1.548 albertel 10110: =pod
10111:
10112: =item * &inhibit_menu_check($arg)
10113:
10114: Checks for a inhibitmenu state and generates output to preserve it
10115:
10116: Inputs: $arg - can be any of
10117: - undef - in which case the return value is a string
10118: to add into arguments list of a uri
10119: - 'input' - in which case the return value is a HTML
10120: <form> <input> field of type hidden to
10121: preserve the value
10122: - a url - in which case the return value is the url with
10123: the neccesary cgi args added to preserve the
10124: inhibitmenu state
10125: - a ref to a url - no return value, but the string is
10126: updated to include the neccessary cgi
10127: args to preserve the inhibitmenu state
10128:
10129: =cut
10130:
10131: sub inhibit_menu_check {
10132: my ($arg) = @_;
10133: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
10134: if ($arg eq 'input') {
10135: if ($env{'form.inhibitmenu'}) {
10136: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
10137: } else {
10138: return
10139: }
10140: }
10141: if ($env{'form.inhibitmenu'}) {
10142: if (ref($arg)) {
10143: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10144: } elsif ($arg eq '') {
10145: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
10146: } else {
10147: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10148: }
10149: }
10150: if (!ref($arg)) {
10151: return $arg;
10152: }
10153: }
10154:
1.251 albertel 10155: ###############################################
1.182 matthew 10156:
10157: =pod
10158:
1.549 albertel 10159: =back
10160:
10161: =head1 User Information Routines
10162:
10163: =over 4
10164:
1.405 albertel 10165: =item * &get_users_function()
1.182 matthew 10166:
10167: Used by &bodytag to determine the current users primary role.
10168: Returns either 'student','coordinator','admin', or 'author'.
10169:
10170: =cut
10171:
10172: ###############################################
10173: sub get_users_function {
1.815 tempelho 10174: my $function = 'norole';
1.818 tempelho 10175: if ($env{'request.role'}=~/^(st)/) {
10176: $function='student';
10177: }
1.907 raeburn 10178: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 10179: $function='coordinator';
10180: }
1.258 albertel 10181: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 10182: $function='admin';
10183: }
1.826 bisitz 10184: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 10185: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 10186: $function='author';
10187: }
10188: return $function;
1.54 www 10189: }
1.99 www 10190:
10191: ###############################################
10192:
1.233 raeburn 10193: =pod
10194:
1.821 raeburn 10195: =item * &show_course()
10196:
10197: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
10198: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
10199:
10200: Inputs:
10201: None
10202:
10203: Outputs:
10204: Scalar: 1 if 'Course' to be used, 0 otherwise.
10205:
10206: =cut
10207:
10208: ###############################################
10209: sub show_course {
10210: my $course = !$env{'user.adv'};
10211: if (!$env{'user.adv'}) {
10212: foreach my $env (keys(%env)) {
10213: next if ($env !~ m/^user\.priv\./);
10214: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
10215: $course = 0;
10216: last;
10217: }
10218: }
10219: }
10220: return $course;
10221: }
10222:
10223: ###############################################
10224:
10225: =pod
10226:
1.542 raeburn 10227: =item * &check_user_status()
1.274 raeburn 10228:
10229: Determines current status of supplied role for a
10230: specific user. Roles can be active, previous or future.
10231:
10232: Inputs:
10233: user's domain, user's username, course's domain,
1.375 raeburn 10234: course's number, optional section ID.
1.274 raeburn 10235:
10236: Outputs:
10237: role status: active, previous or future.
10238:
10239: =cut
10240:
10241: sub check_user_status {
1.412 raeburn 10242: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 10243: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 10244: my @uroles = keys(%userinfo);
1.274 raeburn 10245: my $srchstr;
10246: my $active_chk = 'none';
1.412 raeburn 10247: my $now = time;
1.274 raeburn 10248: if (@uroles > 0) {
1.908 raeburn 10249: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 10250: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
10251: } else {
1.412 raeburn 10252: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
10253: }
10254: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 10255: my $role_end = 0;
10256: my $role_start = 0;
10257: $active_chk = 'active';
1.412 raeburn 10258: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
10259: $role_end = $1;
10260: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
10261: $role_start = $1;
1.274 raeburn 10262: }
10263: }
10264: if ($role_start > 0) {
1.412 raeburn 10265: if ($now < $role_start) {
1.274 raeburn 10266: $active_chk = 'future';
10267: }
10268: }
10269: if ($role_end > 0) {
1.412 raeburn 10270: if ($now > $role_end) {
1.274 raeburn 10271: $active_chk = 'previous';
10272: }
10273: }
10274: }
10275: }
10276: return $active_chk;
10277: }
10278:
10279: ###############################################
10280:
10281: =pod
10282:
1.405 albertel 10283: =item * &get_sections()
1.233 raeburn 10284:
10285: Determines all the sections for a course including
10286: sections with students and sections containing other roles.
1.419 raeburn 10287: Incoming parameters:
10288:
10289: 1. domain
10290: 2. course number
10291: 3. reference to array containing roles for which sections should
10292: be gathered (optional).
10293: 4. reference to array containing status types for which sections
10294: should be gathered (optional).
10295:
10296: If the third argument is undefined, sections are gathered for any role.
10297: If the fourth argument is undefined, sections are gathered for any status.
10298: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 10299:
1.374 raeburn 10300: Returns section hash (keys are section IDs, values are
10301: number of users in each section), subject to the
1.419 raeburn 10302: optional roles filter, optional status filter
1.233 raeburn 10303:
10304: =cut
10305:
10306: ###############################################
10307: sub get_sections {
1.419 raeburn 10308: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 10309: if (!defined($cdom) || !defined($cnum)) {
10310: my $cid = $env{'request.course.id'};
10311:
10312: return if (!defined($cid));
10313:
10314: $cdom = $env{'course.'.$cid.'.domain'};
10315: $cnum = $env{'course.'.$cid.'.num'};
10316: }
10317:
10318: my %sectioncount;
1.419 raeburn 10319: my $now = time;
1.240 albertel 10320:
1.1118 raeburn 10321: my $check_students = 1;
10322: my $only_students = 0;
10323: if (ref($possible_roles) eq 'ARRAY') {
10324: if (grep(/^st$/,@{$possible_roles})) {
10325: if (@{$possible_roles} == 1) {
10326: $only_students = 1;
10327: }
10328: } else {
10329: $check_students = 0;
10330: }
10331: }
10332:
10333: if ($check_students) {
1.276 albertel 10334: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 10335: my $sec_index = &Apache::loncoursedata::CL_SECTION();
10336: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 10337: my $start_index = &Apache::loncoursedata::CL_START();
10338: my $end_index = &Apache::loncoursedata::CL_END();
10339: my $status;
1.366 albertel 10340: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 10341: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
10342: $data->[$status_index],
10343: $data->[$start_index],
10344: $data->[$end_index]);
10345: if ($stu_status eq 'Active') {
10346: $status = 'active';
10347: } elsif ($end < $now) {
10348: $status = 'previous';
10349: } elsif ($start > $now) {
10350: $status = 'future';
10351: }
10352: if ($section ne '-1' && $section !~ /^\s*$/) {
10353: if ((!defined($possible_status)) || (($status ne '') &&
10354: (grep/^\Q$status\E$/,@{$possible_status}))) {
10355: $sectioncount{$section}++;
10356: }
1.240 albertel 10357: }
10358: }
10359: }
1.1118 raeburn 10360: if ($only_students) {
10361: return %sectioncount;
10362: }
1.240 albertel 10363: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10364: foreach my $user (sort(keys(%courseroles))) {
10365: if ($user !~ /^(\w{2})/) { next; }
10366: my ($role) = ($user =~ /^(\w{2})/);
10367: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 10368: my ($section,$status);
1.240 albertel 10369: if ($role eq 'cr' &&
10370: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
10371: $section=$1;
10372: }
10373: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
10374: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 10375: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
10376: if ($end == -1 && $start == -1) {
10377: next; #deleted role
10378: }
10379: if (!defined($possible_status)) {
10380: $sectioncount{$section}++;
10381: } else {
10382: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
10383: $status = 'active';
10384: } elsif ($end < $now) {
10385: $status = 'future';
10386: } elsif ($start > $now) {
10387: $status = 'previous';
10388: }
10389: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
10390: $sectioncount{$section}++;
10391: }
10392: }
1.233 raeburn 10393: }
1.366 albertel 10394: return %sectioncount;
1.233 raeburn 10395: }
10396:
1.274 raeburn 10397: ###############################################
1.294 raeburn 10398:
10399: =pod
1.405 albertel 10400:
10401: =item * &get_course_users()
10402:
1.275 raeburn 10403: Retrieves usernames:domains for users in the specified course
10404: with specific role(s), and access status.
10405:
10406: Incoming parameters:
1.277 albertel 10407: 1. course domain
10408: 2. course number
10409: 3. access status: users must have - either active,
1.275 raeburn 10410: previous, future, or all.
1.277 albertel 10411: 4. reference to array of permissible roles
1.288 raeburn 10412: 5. reference to array of section restrictions (optional)
10413: 6. reference to results object (hash of hashes).
10414: 7. reference to optional userdata hash
1.609 raeburn 10415: 8. reference to optional statushash
1.630 raeburn 10416: 9. flag if privileged users (except those set to unhide in
10417: course settings) should be excluded
1.609 raeburn 10418: Keys of top level results hash are roles.
1.275 raeburn 10419: Keys of inner hashes are username:domain, with
10420: values set to access type.
1.288 raeburn 10421: Optional userdata hash returns an array with arguments in the
10422: same order as loncoursedata::get_classlist() for student data.
10423:
1.609 raeburn 10424: Optional statushash returns
10425:
1.288 raeburn 10426: Entries for end, start, section and status are blank because
10427: of the possibility of multiple values for non-student roles.
10428:
1.275 raeburn 10429: =cut
1.405 albertel 10430:
1.275 raeburn 10431: ###############################################
1.405 albertel 10432:
1.275 raeburn 10433: sub get_course_users {
1.630 raeburn 10434: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 10435: my %idx = ();
1.419 raeburn 10436: my %seclists;
1.288 raeburn 10437:
10438: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
10439: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
10440: $idx{end} = &Apache::loncoursedata::CL_END();
10441: $idx{start} = &Apache::loncoursedata::CL_START();
10442: $idx{id} = &Apache::loncoursedata::CL_ID();
10443: $idx{section} = &Apache::loncoursedata::CL_SECTION();
10444: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
10445: $idx{status} = &Apache::loncoursedata::CL_STATUS();
10446:
1.290 albertel 10447: if (grep(/^st$/,@{$roles})) {
1.276 albertel 10448: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 10449: my $now = time;
1.277 albertel 10450: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 10451: my $match = 0;
1.412 raeburn 10452: my $secmatch = 0;
1.419 raeburn 10453: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 10454: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 10455: if ($section eq '') {
10456: $section = 'none';
10457: }
1.291 albertel 10458: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10459: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10460: $secmatch = 1;
10461: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 10462: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10463: $secmatch = 1;
10464: }
10465: } else {
1.419 raeburn 10466: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 10467: $secmatch = 1;
10468: }
1.290 albertel 10469: }
1.412 raeburn 10470: if (!$secmatch) {
10471: next;
10472: }
1.419 raeburn 10473: }
1.275 raeburn 10474: if (defined($$types{'active'})) {
1.288 raeburn 10475: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 10476: push(@{$$users{st}{$student}},'active');
1.288 raeburn 10477: $match = 1;
1.275 raeburn 10478: }
10479: }
10480: if (defined($$types{'previous'})) {
1.609 raeburn 10481: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 10482: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 10483: $match = 1;
1.275 raeburn 10484: }
10485: }
10486: if (defined($$types{'future'})) {
1.609 raeburn 10487: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 10488: push(@{$$users{st}{$student}},'future');
1.288 raeburn 10489: $match = 1;
1.275 raeburn 10490: }
10491: }
1.609 raeburn 10492: if ($match) {
10493: push(@{$seclists{$student}},$section);
10494: if (ref($userdata) eq 'HASH') {
10495: $$userdata{$student} = $$classlist{$student};
10496: }
10497: if (ref($statushash) eq 'HASH') {
10498: $statushash->{$student}{'st'}{$section} = $status;
10499: }
1.288 raeburn 10500: }
1.275 raeburn 10501: }
10502: }
1.412 raeburn 10503: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 10504: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10505: my $now = time;
1.609 raeburn 10506: my %displaystatus = ( previous => 'Expired',
10507: active => 'Active',
10508: future => 'Future',
10509: );
1.1121 raeburn 10510: my (%nothide,@possdoms);
1.630 raeburn 10511: if ($hidepriv) {
10512: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
10513: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
10514: if ($user !~ /:/) {
10515: $nothide{join(':',split(/[\@]/,$user))}=1;
10516: } else {
10517: $nothide{$user} = 1;
10518: }
10519: }
1.1121 raeburn 10520: my @possdoms = ($cdom);
10521: if ($coursehash{'checkforpriv'}) {
10522: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
10523: }
1.630 raeburn 10524: }
1.439 raeburn 10525: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 10526: my $match = 0;
1.412 raeburn 10527: my $secmatch = 0;
1.439 raeburn 10528: my $status;
1.412 raeburn 10529: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 10530: $user =~ s/:$//;
1.439 raeburn 10531: my ($end,$start) = split(/:/,$coursepersonnel{$person});
10532: if ($end == -1 || $start == -1) {
10533: next;
10534: }
10535: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
10536: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 10537: my ($uname,$udom) = split(/:/,$user);
10538: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10539: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10540: $secmatch = 1;
10541: } elsif ($usec eq '') {
1.420 albertel 10542: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10543: $secmatch = 1;
10544: }
10545: } else {
10546: if (grep(/^\Q$usec\E$/,@{$sections})) {
10547: $secmatch = 1;
10548: }
10549: }
10550: if (!$secmatch) {
10551: next;
10552: }
1.288 raeburn 10553: }
1.419 raeburn 10554: if ($usec eq '') {
10555: $usec = 'none';
10556: }
1.275 raeburn 10557: if ($uname ne '' && $udom ne '') {
1.630 raeburn 10558: if ($hidepriv) {
1.1121 raeburn 10559: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 10560: (!$nothide{$uname.':'.$udom})) {
10561: next;
10562: }
10563: }
1.503 raeburn 10564: if ($end > 0 && $end < $now) {
1.439 raeburn 10565: $status = 'previous';
10566: } elsif ($start > $now) {
10567: $status = 'future';
10568: } else {
10569: $status = 'active';
10570: }
1.277 albertel 10571: foreach my $type (keys(%{$types})) {
1.275 raeburn 10572: if ($status eq $type) {
1.420 albertel 10573: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 10574: push(@{$$users{$role}{$user}},$type);
10575: }
1.288 raeburn 10576: $match = 1;
10577: }
10578: }
1.419 raeburn 10579: if (($match) && (ref($userdata) eq 'HASH')) {
10580: if (!exists($$userdata{$uname.':'.$udom})) {
10581: &get_user_info($udom,$uname,\%idx,$userdata);
10582: }
1.420 albertel 10583: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 10584: push(@{$seclists{$uname.':'.$udom}},$usec);
10585: }
1.609 raeburn 10586: if (ref($statushash) eq 'HASH') {
10587: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
10588: }
1.275 raeburn 10589: }
10590: }
10591: }
10592: }
1.290 albertel 10593: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 10594: if ((defined($cdom)) && (defined($cnum))) {
10595: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
10596: if ( defined($csettings{'internal.courseowner'}) ) {
10597: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 10598: next if ($owner eq '');
10599: my ($ownername,$ownerdom);
10600: if ($owner =~ /^([^:]+):([^:]+)$/) {
10601: $ownername = $1;
10602: $ownerdom = $2;
10603: } else {
10604: $ownername = $owner;
10605: $ownerdom = $cdom;
10606: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 10607: }
10608: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 10609: if (defined($userdata) &&
1.609 raeburn 10610: !exists($$userdata{$owner})) {
10611: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
10612: if (!grep(/^none$/,@{$seclists{$owner}})) {
10613: push(@{$seclists{$owner}},'none');
10614: }
10615: if (ref($statushash) eq 'HASH') {
10616: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 10617: }
1.290 albertel 10618: }
1.279 raeburn 10619: }
10620: }
10621: }
1.419 raeburn 10622: foreach my $user (keys(%seclists)) {
10623: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
10624: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
10625: }
1.275 raeburn 10626: }
10627: return;
10628: }
10629:
1.288 raeburn 10630: sub get_user_info {
10631: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 10632: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
10633: &plainname($uname,$udom,'lastname');
1.291 albertel 10634: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 10635: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 10636: my %idhash = &Apache::lonnet::idrget($udom,($uname));
10637: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 10638: return;
10639: }
1.275 raeburn 10640:
1.472 raeburn 10641: ###############################################
10642:
10643: =pod
10644:
10645: =item * &get_user_quota()
10646:
1.1134 raeburn 10647: Retrieves quota assigned for storage of user files.
10648: Default is to report quota for portfolio files.
1.472 raeburn 10649:
10650: Incoming parameters:
10651: 1. user's username
10652: 2. user's domain
1.1134 raeburn 10653: 3. quota name - portfolio, author, or course
1.1136 raeburn 10654: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 10655: 4. crstype - official, unofficial, textbook, placement or community,
10656: if quota name is course
1.472 raeburn 10657:
10658: Returns:
1.1163 raeburn 10659: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 10660: 2. (Optional) Type of setting: custom or default
10661: (individually assigned or default for user's
10662: institutional status).
10663: 3. (Optional) - User's institutional status (e.g., faculty, staff
10664: or student - types as defined in localenroll::inst_usertypes
10665: for user's domain, which determines default quota for user.
10666: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 10667:
10668: If a value has been stored in the user's environment,
1.536 raeburn 10669: it will return that, otherwise it returns the maximal default
1.1134 raeburn 10670: defined for the user's institutional status(es) in the domain.
1.472 raeburn 10671:
10672: =cut
10673:
10674: ###############################################
10675:
10676:
10677: sub get_user_quota {
1.1136 raeburn 10678: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 10679: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 10680: if (!defined($udom)) {
10681: $udom = $env{'user.domain'};
10682: }
10683: if (!defined($uname)) {
10684: $uname = $env{'user.name'};
10685: }
10686: if (($udom eq '' || $uname eq '') ||
10687: ($udom eq 'public') && ($uname eq 'public')) {
10688: $quota = 0;
1.536 raeburn 10689: $quotatype = 'default';
10690: $defquota = 0;
1.472 raeburn 10691: } else {
1.536 raeburn 10692: my $inststatus;
1.1134 raeburn 10693: if ($quotaname eq 'course') {
10694: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
10695: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
10696: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
10697: } else {
10698: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
10699: $quota = $cenv{'internal.uploadquota'};
10700: }
1.536 raeburn 10701: } else {
1.1134 raeburn 10702: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
10703: if ($quotaname eq 'author') {
10704: $quota = $env{'environment.authorquota'};
10705: } else {
10706: $quota = $env{'environment.portfolioquota'};
10707: }
10708: $inststatus = $env{'environment.inststatus'};
10709: } else {
10710: my %userenv =
10711: &Apache::lonnet::get('environment',['portfolioquota',
10712: 'authorquota','inststatus'],$udom,$uname);
10713: my ($tmp) = keys(%userenv);
10714: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
10715: if ($quotaname eq 'author') {
10716: $quota = $userenv{'authorquota'};
10717: } else {
10718: $quota = $userenv{'portfolioquota'};
10719: }
10720: $inststatus = $userenv{'inststatus'};
10721: } else {
10722: undef(%userenv);
10723: }
10724: }
10725: }
10726: if ($quota eq '' || wantarray) {
10727: if ($quotaname eq 'course') {
10728: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 10729: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 10730: ($crstype eq 'community') || ($crstype eq 'textbook') ||
10731: ($crstype eq 'placement')) {
1.1136 raeburn 10732: $defquota = $domdefs{$crstype.'quota'};
10733: }
10734: if ($defquota eq '') {
10735: $defquota = 500;
10736: }
1.1134 raeburn 10737: } else {
10738: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
10739: }
10740: if ($quota eq '') {
10741: $quota = $defquota;
10742: $quotatype = 'default';
10743: } else {
10744: $quotatype = 'custom';
10745: }
1.472 raeburn 10746: }
10747: }
1.536 raeburn 10748: if (wantarray) {
10749: return ($quota,$quotatype,$settingstatus,$defquota);
10750: } else {
10751: return $quota;
10752: }
1.472 raeburn 10753: }
10754:
10755: ###############################################
10756:
10757: =pod
10758:
10759: =item * &default_quota()
10760:
1.536 raeburn 10761: Retrieves default quota assigned for storage of user portfolio files,
10762: given an (optional) user's institutional status.
1.472 raeburn 10763:
10764: Incoming parameters:
1.1142 raeburn 10765:
1.472 raeburn 10766: 1. domain
1.536 raeburn 10767: 2. (Optional) institutional status(es). This is a : separated list of
10768: status types (e.g., faculty, staff, student etc.)
10769: which apply to the user for whom the default is being retrieved.
10770: If the institutional status string in undefined, the domain
1.1134 raeburn 10771: default quota will be returned.
10772: 3. quota name - portfolio, author, or course
10773: (if no quota name provided, defaults to portfolio).
1.472 raeburn 10774:
10775: Returns:
1.1142 raeburn 10776:
1.1163 raeburn 10777: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 10778: 2. (Optional) institutional type which determined the value of the
10779: default quota.
1.472 raeburn 10780:
10781: If a value has been stored in the domain's configuration db,
10782: it will return that, otherwise it returns 20 (for backwards
10783: compatibility with domains which have not set up a configuration
1.1163 raeburn 10784: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 10785:
1.536 raeburn 10786: If the user's status includes multiple types (e.g., staff and student),
10787: the largest default quota which applies to the user determines the
10788: default quota returned.
10789:
1.472 raeburn 10790: =cut
10791:
10792: ###############################################
10793:
10794:
10795: sub default_quota {
1.1134 raeburn 10796: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 10797: my ($defquota,$settingstatus);
10798: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 10799: ['quotas'],$udom);
1.1134 raeburn 10800: my $key = 'defaultquota';
10801: if ($quotaname eq 'author') {
10802: $key = 'authorquota';
10803: }
1.622 raeburn 10804: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 10805: if ($inststatus ne '') {
1.765 raeburn 10806: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 10807: foreach my $item (@statuses) {
1.1134 raeburn 10808: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10809: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 10810: if ($defquota eq '') {
1.1134 raeburn 10811: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10812: $settingstatus = $item;
1.1134 raeburn 10813: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
10814: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10815: $settingstatus = $item;
10816: }
10817: }
1.1134 raeburn 10818: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10819: if ($quotahash{'quotas'}{$item} ne '') {
10820: if ($defquota eq '') {
10821: $defquota = $quotahash{'quotas'}{$item};
10822: $settingstatus = $item;
10823: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
10824: $defquota = $quotahash{'quotas'}{$item};
10825: $settingstatus = $item;
10826: }
1.536 raeburn 10827: }
10828: }
10829: }
10830: }
10831: if ($defquota eq '') {
1.1134 raeburn 10832: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10833: $defquota = $quotahash{'quotas'}{$key}{'default'};
10834: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10835: $defquota = $quotahash{'quotas'}{'default'};
10836: }
1.536 raeburn 10837: $settingstatus = 'default';
1.1139 raeburn 10838: if ($defquota eq '') {
10839: if ($quotaname eq 'author') {
10840: $defquota = 500;
10841: }
10842: }
1.536 raeburn 10843: }
10844: } else {
10845: $settingstatus = 'default';
1.1134 raeburn 10846: if ($quotaname eq 'author') {
10847: $defquota = 500;
10848: } else {
10849: $defquota = 20;
10850: }
1.536 raeburn 10851: }
10852: if (wantarray) {
10853: return ($defquota,$settingstatus);
1.472 raeburn 10854: } else {
1.536 raeburn 10855: return $defquota;
1.472 raeburn 10856: }
10857: }
10858:
1.1135 raeburn 10859: ###############################################
10860:
10861: =pod
10862:
1.1136 raeburn 10863: =item * &excess_filesize_warning()
1.1135 raeburn 10864:
10865: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 10866: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 10867: space to be exceeded.
1.1136 raeburn 10868:
10869: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 10870: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 10871:
1.1165 raeburn 10872: Inputs: 7
1.1136 raeburn 10873: 1. username or coursenum
1.1135 raeburn 10874: 2. domain
1.1136 raeburn 10875: 3. context ('author' or 'course')
1.1135 raeburn 10876: 4. filename of file for which action is being requested
10877: 5. filesize (kB) of file
10878: 6. action being taken: copy or upload.
1.1237 raeburn 10879: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 10880:
10881: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 10882: otherwise return null.
10883:
10884: =back
1.1135 raeburn 10885:
10886: =cut
10887:
1.1136 raeburn 10888: sub excess_filesize_warning {
1.1165 raeburn 10889: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 10890: my $current_disk_usage = 0;
1.1165 raeburn 10891: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 10892: if ($context eq 'author') {
10893: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
10894: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
10895: } else {
10896: foreach my $subdir ('docs','supplemental') {
10897: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
10898: }
10899: }
1.1135 raeburn 10900: $disk_quota = int($disk_quota * 1000);
10901: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 10902: return '<p class="LC_warning">'.
1.1135 raeburn 10903: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 10904: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
10905: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 10906: $disk_quota,$current_disk_usage).
10907: '</p>';
10908: }
10909: return;
10910: }
10911:
10912: ###############################################
10913:
10914:
1.1136 raeburn 10915:
10916:
1.384 raeburn 10917: sub get_secgrprole_info {
10918: my ($cdom,$cnum,$needroles,$type) = @_;
10919: my %sections_count = &get_sections($cdom,$cnum);
10920: my @sections = (sort {$a <=> $b} keys(%sections_count));
10921: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
10922: my @groups = sort(keys(%curr_groups));
10923: my $allroles = [];
10924: my $rolehash;
10925: my $accesshash = {
10926: active => 'Currently has access',
10927: future => 'Will have future access',
10928: previous => 'Previously had access',
10929: };
10930: if ($needroles) {
10931: $rolehash = {'all' => 'all'};
1.385 albertel 10932: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10933: if (&Apache::lonnet::error(%user_roles)) {
10934: undef(%user_roles);
10935: }
10936: foreach my $item (keys(%user_roles)) {
1.384 raeburn 10937: my ($role)=split(/\:/,$item,2);
10938: if ($role eq 'cr') { next; }
10939: if ($role =~ /^cr/) {
10940: $$rolehash{$role} = (split('/',$role))[3];
10941: } else {
10942: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
10943: }
10944: }
10945: foreach my $key (sort(keys(%{$rolehash}))) {
10946: push(@{$allroles},$key);
10947: }
10948: push (@{$allroles},'st');
10949: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
10950: }
10951: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
10952: }
10953:
1.555 raeburn 10954: sub user_picker {
1.1279 raeburn 10955: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 10956: my $currdom = $dom;
1.1253 raeburn 10957: my @alldoms = &Apache::lonnet::all_domains();
10958: if (@alldoms == 1) {
10959: my %domsrch = &Apache::lonnet::get_dom('configuration',
10960: ['directorysrch'],$alldoms[0]);
10961: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
10962: my $showdom = $domdesc;
10963: if ($showdom eq '') {
10964: $showdom = $dom;
10965: }
10966: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
10967: if ((!$domsrch{'directorysrch'}{'available'}) &&
10968: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
10969: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
10970: }
10971: }
10972: }
1.555 raeburn 10973: my %curr_selected = (
10974: srchin => 'dom',
1.580 raeburn 10975: srchby => 'lastname',
1.555 raeburn 10976: );
10977: my $srchterm;
1.625 raeburn 10978: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 10979: if ($srch->{'srchby'} ne '') {
10980: $curr_selected{'srchby'} = $srch->{'srchby'};
10981: }
10982: if ($srch->{'srchin'} ne '') {
10983: $curr_selected{'srchin'} = $srch->{'srchin'};
10984: }
10985: if ($srch->{'srchtype'} ne '') {
10986: $curr_selected{'srchtype'} = $srch->{'srchtype'};
10987: }
10988: if ($srch->{'srchdomain'} ne '') {
10989: $currdom = $srch->{'srchdomain'};
10990: }
10991: $srchterm = $srch->{'srchterm'};
10992: }
1.1222 damieng 10993: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10994: 'usr' => 'Search criteria',
1.563 raeburn 10995: 'doma' => 'Domain/institution to search',
1.558 albertel 10996: 'uname' => 'username',
10997: 'lastname' => 'last name',
1.555 raeburn 10998: 'lastfirst' => 'last name, first name',
1.558 albertel 10999: 'crs' => 'in this course',
1.576 raeburn 11000: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 11001: 'alc' => 'all LON-CAPA',
1.573 raeburn 11002: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 11003: 'exact' => 'is',
11004: 'contains' => 'contains',
1.569 raeburn 11005: 'begins' => 'begins with',
1.1222 damieng 11006: );
11007: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 11008: 'youm' => "You must include some text to search for.",
11009: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
11010: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
11011: 'yomc' => "You must choose a domain when using an institutional directory search.",
11012: 'ymcd' => "You must choose a domain when using a domain search.",
11013: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
11014: 'whse' => "When searching by last,first you must include at least one character in the first name.",
11015: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 11016: );
1.1222 damieng 11017: &html_escape(\%html_lt);
11018: &js_escape(\%js_lt);
1.1255 raeburn 11019: my $domform;
1.1277 raeburn 11020: my $allow_blank = 1;
1.1255 raeburn 11021: if ($fixeddom) {
1.1277 raeburn 11022: $allow_blank = 0;
11023: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 11024: } else {
1.1287 raeburn 11025: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 11026: my ($trusted,$untrusted);
1.1287 raeburn 11027: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 11028: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 11029: } elsif ($context eq 'author') {
1.1288 raeburn 11030: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 11031: } elsif ($context eq 'domain') {
1.1288 raeburn 11032: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 11033: }
1.1288 raeburn 11034: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 11035: }
1.563 raeburn 11036: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 11037:
11038: my @srchins = ('crs','dom','alc','instd');
11039:
11040: foreach my $option (@srchins) {
11041: # FIXME 'alc' option unavailable until
11042: # loncreateuser::print_user_query_page()
11043: # has been completed.
11044: next if ($option eq 'alc');
1.880 raeburn 11045: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 11046: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 11047: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 11048: if ($curr_selected{'srchin'} eq $option) {
11049: $srchinsel .= '
1.1222 damieng 11050: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 11051: } else {
11052: $srchinsel .= '
1.1222 damieng 11053: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 11054: }
1.555 raeburn 11055: }
1.563 raeburn 11056: $srchinsel .= "\n </select>\n";
1.555 raeburn 11057:
11058: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 11059: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 11060: if ($curr_selected{'srchby'} eq $option) {
11061: $srchbysel .= '
1.1222 damieng 11062: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11063: } else {
11064: $srchbysel .= '
1.1222 damieng 11065: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11066: }
11067: }
11068: $srchbysel .= "\n </select>\n";
11069:
11070: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 11071: foreach my $option ('begins','contains','exact') {
1.555 raeburn 11072: if ($curr_selected{'srchtype'} eq $option) {
11073: $srchtypesel .= '
1.1222 damieng 11074: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11075: } else {
11076: $srchtypesel .= '
1.1222 damieng 11077: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11078: }
11079: }
11080: $srchtypesel .= "\n </select>\n";
11081:
1.558 albertel 11082: my ($newuserscript,$new_user_create);
1.994 raeburn 11083: my $context_dom = $env{'request.role.domain'};
11084: if ($context eq 'requestcrs') {
11085: if ($env{'form.coursedom'} ne '') {
11086: $context_dom = $env{'form.coursedom'};
11087: }
11088: }
1.556 raeburn 11089: if ($forcenewuser) {
1.576 raeburn 11090: if (ref($srch) eq 'HASH') {
1.994 raeburn 11091: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 11092: if ($cancreate) {
11093: $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>';
11094: } else {
1.799 bisitz 11095: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 11096: my %usertypetext = (
11097: official => 'institutional',
11098: unofficial => 'non-institutional',
11099: );
1.799 bisitz 11100: $new_user_create = '<p class="LC_warning">'
11101: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
11102: .' '
11103: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
11104: ,'<a href="'.$helplink.'">','</a>')
11105: .'</p><br />';
1.627 raeburn 11106: }
1.576 raeburn 11107: }
11108: }
11109:
1.556 raeburn 11110: $newuserscript = <<"ENDSCRIPT";
11111:
1.570 raeburn 11112: function setSearch(createnew,callingForm) {
1.556 raeburn 11113: if (createnew == 1) {
1.570 raeburn 11114: for (var i=0; i<callingForm.srchby.length; i++) {
11115: if (callingForm.srchby.options[i].value == 'uname') {
11116: callingForm.srchby.selectedIndex = i;
1.556 raeburn 11117: }
11118: }
1.570 raeburn 11119: for (var i=0; i<callingForm.srchin.length; i++) {
11120: if ( callingForm.srchin.options[i].value == 'dom') {
11121: callingForm.srchin.selectedIndex = i;
1.556 raeburn 11122: }
11123: }
1.570 raeburn 11124: for (var i=0; i<callingForm.srchtype.length; i++) {
11125: if (callingForm.srchtype.options[i].value == 'exact') {
11126: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 11127: }
11128: }
1.570 raeburn 11129: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 11130: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 11131: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 11132: }
11133: }
11134: }
11135: }
11136: ENDSCRIPT
1.558 albertel 11137:
1.556 raeburn 11138: }
11139:
1.555 raeburn 11140: my $output = <<"END_BLOCK";
1.556 raeburn 11141: <script type="text/javascript">
1.824 bisitz 11142: // <![CDATA[
1.570 raeburn 11143: function validateEntry(callingForm) {
1.558 albertel 11144:
1.556 raeburn 11145: var checkok = 1;
1.558 albertel 11146: var srchin;
1.570 raeburn 11147: for (var i=0; i<callingForm.srchin.length; i++) {
11148: if ( callingForm.srchin[i].checked ) {
11149: srchin = callingForm.srchin[i].value;
1.558 albertel 11150: }
11151: }
11152:
1.570 raeburn 11153: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
11154: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
11155: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
11156: var srchterm = callingForm.srchterm.value;
11157: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 11158: var msg = "";
11159:
11160: if (srchterm == "") {
11161: checkok = 0;
1.1222 damieng 11162: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 11163: }
11164:
1.569 raeburn 11165: if (srchtype== 'begins') {
11166: if (srchterm.length < 2) {
11167: checkok = 0;
1.1222 damieng 11168: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 11169: }
11170: }
11171:
1.556 raeburn 11172: if (srchtype== 'contains') {
11173: if (srchterm.length < 3) {
11174: checkok = 0;
1.1222 damieng 11175: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 11176: }
11177: }
11178: if (srchin == 'instd') {
11179: if (srchdomain == '') {
11180: checkok = 0;
1.1222 damieng 11181: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 11182: }
11183: }
11184: if (srchin == 'dom') {
11185: if (srchdomain == '') {
11186: checkok = 0;
1.1222 damieng 11187: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 11188: }
11189: }
11190: if (srchby == 'lastfirst') {
11191: if (srchterm.indexOf(",") == -1) {
11192: checkok = 0;
1.1222 damieng 11193: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 11194: }
11195: if (srchterm.indexOf(",") == srchterm.length -1) {
11196: checkok = 0;
1.1222 damieng 11197: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 11198: }
11199: }
11200: if (checkok == 0) {
1.1222 damieng 11201: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 11202: return;
11203: }
11204: if (checkok == 1) {
1.570 raeburn 11205: callingForm.submit();
1.556 raeburn 11206: }
11207: }
11208:
11209: $newuserscript
11210:
1.824 bisitz 11211: // ]]>
1.556 raeburn 11212: </script>
1.558 albertel 11213:
11214: $new_user_create
11215:
1.555 raeburn 11216: END_BLOCK
1.558 albertel 11217:
1.876 raeburn 11218: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 11219: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 11220: $domform.
11221: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 11222: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 11223: $srchbysel.
11224: $srchtypesel.
11225: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
11226: $srchinsel.
11227: &Apache::lonhtmlcommon::row_closure(1).
11228: &Apache::lonhtmlcommon::end_pick_box().
11229: '<br />';
1.1253 raeburn 11230: return ($output,1);
1.555 raeburn 11231: }
11232:
1.612 raeburn 11233: sub user_rule_check {
1.615 raeburn 11234: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 11235: my ($response,%inst_response);
1.612 raeburn 11236: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 11237: if (keys(%{$usershash}) > 1) {
11238: my (%by_username,%by_id,%userdoms);
11239: my $checkid;
11240: if (ref($checks) eq 'HASH') {
11241: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
11242: $checkid = 1;
11243: }
11244: }
11245: foreach my $user (keys(%{$usershash})) {
11246: my ($uname,$udom) = split(/:/,$user);
11247: if ($checkid) {
11248: if (ref($usershash->{$user}) eq 'HASH') {
11249: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 11250: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 11251: $userdoms{$udom} = 1;
1.1227 raeburn 11252: if (ref($inst_results) eq 'HASH') {
11253: $inst_results->{$uname.':'.$udom} = {};
11254: }
1.1226 raeburn 11255: }
11256: }
11257: } else {
11258: $by_username{$udom}{$uname} = 1;
11259: $userdoms{$udom} = 1;
1.1227 raeburn 11260: if (ref($inst_results) eq 'HASH') {
11261: $inst_results->{$uname.':'.$udom} = {};
11262: }
1.1226 raeburn 11263: }
11264: }
11265: foreach my $udom (keys(%userdoms)) {
11266: if (!$got_rules->{$udom}) {
11267: my %domconfig = &Apache::lonnet::get_dom('configuration',
11268: ['usercreation'],$udom);
11269: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11270: foreach my $item ('username','id') {
11271: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 11272: $$curr_rules{$udom}{$item} =
11273: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 11274: }
11275: }
11276: }
11277: $got_rules->{$udom} = 1;
11278: }
1.612 raeburn 11279: }
1.1226 raeburn 11280: if ($checkid) {
11281: foreach my $udom (keys(%by_id)) {
11282: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
11283: if ($outcome eq 'ok') {
1.1227 raeburn 11284: foreach my $id (keys(%{$by_id{$udom}})) {
11285: my $uname = $by_id{$udom}{$id};
11286: $inst_response{$uname.':'.$udom} = $outcome;
11287: }
1.1226 raeburn 11288: if (ref($results) eq 'HASH') {
11289: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 11290: if (exists($inst_response{$uname.':'.$udom})) {
11291: $inst_response{$uname.':'.$udom} = $outcome;
11292: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11293: }
1.1226 raeburn 11294: }
11295: }
11296: }
1.612 raeburn 11297: }
1.615 raeburn 11298: } else {
1.1226 raeburn 11299: foreach my $udom (keys(%by_username)) {
11300: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
11301: if ($outcome eq 'ok') {
1.1227 raeburn 11302: foreach my $uname (keys(%{$by_username{$udom}})) {
11303: $inst_response{$uname.':'.$udom} = $outcome;
11304: }
1.1226 raeburn 11305: if (ref($results) eq 'HASH') {
11306: foreach my $uname (keys(%{$results})) {
11307: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11308: }
11309: }
11310: }
11311: }
1.612 raeburn 11312: }
1.1226 raeburn 11313: } elsif (keys(%{$usershash}) == 1) {
11314: my $user = (keys(%{$usershash}))[0];
11315: my ($uname,$udom) = split(/:/,$user);
11316: if (($udom ne '') && ($uname ne '')) {
11317: if (ref($usershash->{$user}) eq 'HASH') {
11318: if (ref($checks) eq 'HASH') {
11319: if (defined($checks->{'username'})) {
11320: ($inst_response{$user},%{$inst_results->{$user}}) =
11321: &Apache::lonnet::get_instuser($udom,$uname);
11322: } elsif (defined($checks->{'id'})) {
11323: if ($usershash->{$user}->{'id'} ne '') {
11324: ($inst_response{$user},%{$inst_results->{$user}}) =
11325: &Apache::lonnet::get_instuser($udom,undef,
11326: $usershash->{$user}->{'id'});
11327: } else {
11328: ($inst_response{$user},%{$inst_results->{$user}}) =
11329: &Apache::lonnet::get_instuser($udom,$uname);
11330: }
1.585 raeburn 11331: }
1.1226 raeburn 11332: } else {
11333: ($inst_response{$user},%{$inst_results->{$user}}) =
11334: &Apache::lonnet::get_instuser($udom,$uname);
11335: return;
11336: }
11337: if (!$got_rules->{$udom}) {
11338: my %domconfig = &Apache::lonnet::get_dom('configuration',
11339: ['usercreation'],$udom);
11340: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11341: foreach my $item ('username','id') {
11342: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
11343: $$curr_rules{$udom}{$item} =
11344: $domconfig{'usercreation'}{$item.'_rule'};
11345: }
11346: }
11347: }
11348: $got_rules->{$udom} = 1;
1.585 raeburn 11349: }
11350: }
1.1226 raeburn 11351: } else {
11352: return;
11353: }
11354: } else {
11355: return;
11356: }
11357: foreach my $user (keys(%{$usershash})) {
11358: my ($uname,$udom) = split(/:/,$user);
11359: next if (($udom eq '') || ($uname eq ''));
11360: my $id;
1.1227 raeburn 11361: if (ref($inst_results) eq 'HASH') {
11362: if (ref($inst_results->{$user}) eq 'HASH') {
11363: $id = $inst_results->{$user}->{'id'};
11364: }
11365: }
11366: if ($id eq '') {
11367: if (ref($usershash->{$user})) {
11368: $id = $usershash->{$user}->{'id'};
11369: }
1.585 raeburn 11370: }
1.612 raeburn 11371: foreach my $item (keys(%{$checks})) {
11372: if (ref($$curr_rules{$udom}) eq 'HASH') {
11373: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
11374: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 11375: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
11376: $$curr_rules{$udom}{$item});
1.612 raeburn 11377: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
11378: if ($rule_check{$rule}) {
11379: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 11380: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 11381: if (ref($inst_results) eq 'HASH') {
11382: if (ref($inst_results->{$user}) eq 'HASH') {
11383: if (keys(%{$inst_results->{$user}}) == 0) {
11384: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 11385: } elsif ($item eq 'id') {
11386: if ($inst_results->{$user}->{'id'} eq '') {
11387: $$alerts{$item}{$udom}{$uname} = 1;
11388: }
1.615 raeburn 11389: }
1.612 raeburn 11390: }
11391: }
1.615 raeburn 11392: }
11393: last;
1.585 raeburn 11394: }
11395: }
11396: }
11397: }
11398: }
11399: }
11400: }
11401: }
1.612 raeburn 11402: return;
11403: }
11404:
11405: sub user_rule_formats {
11406: my ($domain,$domdesc,$curr_rules,$check) = @_;
11407: my %text = (
11408: 'username' => 'Usernames',
11409: 'id' => 'IDs',
11410: );
11411: my $output;
11412: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
11413: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
11414: if (@{$ruleorder} > 0) {
1.1102 raeburn 11415: $output = '<br />'.
11416: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
11417: '<span class="LC_cusr_emph">','</span>',$domdesc).
11418: ' <ul>';
1.612 raeburn 11419: foreach my $rule (@{$ruleorder}) {
11420: if (ref($curr_rules) eq 'ARRAY') {
11421: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
11422: if (ref($rules->{$rule}) eq 'HASH') {
11423: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
11424: $rules->{$rule}{'desc'}.'</li>';
11425: }
11426: }
11427: }
11428: }
11429: $output .= '</ul>';
11430: }
11431: }
11432: return $output;
11433: }
11434:
11435: sub instrule_disallow_msg {
1.615 raeburn 11436: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 11437: my $response;
11438: my %text = (
11439: item => 'username',
11440: items => 'usernames',
11441: match => 'matches',
11442: do => 'does',
11443: action => 'a username',
11444: one => 'one',
11445: );
11446: if ($count > 1) {
11447: $text{'item'} = 'usernames';
11448: $text{'match'} ='match';
11449: $text{'do'} = 'do';
11450: $text{'action'} = 'usernames',
11451: $text{'one'} = 'ones';
11452: }
11453: if ($checkitem eq 'id') {
11454: $text{'items'} = 'IDs';
11455: $text{'item'} = 'ID';
11456: $text{'action'} = 'an ID';
1.615 raeburn 11457: if ($count > 1) {
11458: $text{'item'} = 'IDs';
11459: $text{'action'} = 'IDs';
11460: }
1.612 raeburn 11461: }
1.674 bisitz 11462: $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 11463: if ($mode eq 'upload') {
11464: if ($checkitem eq 'username') {
11465: $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'}.");
11466: } elsif ($checkitem eq 'id') {
1.674 bisitz 11467: $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 11468: }
1.669 raeburn 11469: } elsif ($mode eq 'selfcreate') {
11470: if ($checkitem eq 'id') {
11471: $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.");
11472: }
1.615 raeburn 11473: } else {
11474: if ($checkitem eq 'username') {
11475: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
11476: } elsif ($checkitem eq 'id') {
11477: $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.");
11478: }
1.612 raeburn 11479: }
11480: return $response;
1.585 raeburn 11481: }
11482:
1.624 raeburn 11483: sub personal_data_fieldtitles {
11484: my %fieldtitles = &Apache::lonlocal::texthash (
11485: id => 'Student/Employee ID',
11486: permanentemail => 'E-mail address',
11487: lastname => 'Last Name',
11488: firstname => 'First Name',
11489: middlename => 'Middle Name',
11490: generation => 'Generation',
11491: gen => 'Generation',
1.765 raeburn 11492: inststatus => 'Affiliation',
1.624 raeburn 11493: );
11494: return %fieldtitles;
11495: }
11496:
1.642 raeburn 11497: sub sorted_inst_types {
11498: my ($dom) = @_;
1.1185 raeburn 11499: my ($usertypes,$order);
11500: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
11501: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
11502: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
11503: $order = $domdefaults{'inststatus'}{'inststatusorder'};
11504: } else {
11505: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
11506: }
1.642 raeburn 11507: my $othertitle = &mt('All users');
11508: if ($env{'request.course.id'}) {
1.668 raeburn 11509: $othertitle = &mt('Any users');
1.642 raeburn 11510: }
11511: my @types;
11512: if (ref($order) eq 'ARRAY') {
11513: @types = @{$order};
11514: }
11515: if (@types == 0) {
11516: if (ref($usertypes) eq 'HASH') {
11517: @types = sort(keys(%{$usertypes}));
11518: }
11519: }
11520: if (keys(%{$usertypes}) > 0) {
11521: $othertitle = &mt('Other users');
11522: }
11523: return ($othertitle,$usertypes,\@types);
11524: }
11525:
1.645 raeburn 11526: sub get_institutional_codes {
1.1361 raeburn 11527: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 11528: # Get complete list of course sections to update
11529: my @currsections = ();
11530: my @currxlists = ();
1.1361 raeburn 11531: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 11532: my $coursecode = $$settings{'internal.coursecode'};
1.1361 raeburn 11533: my $crskey = $crs.':'.$coursecode;
11534: @{$unclutteredsec{$crskey}} = ();
11535: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 11536:
11537: if ($$settings{'internal.sectionnums'} ne '') {
11538: @currsections = split(/,/,$$settings{'internal.sectionnums'});
11539: }
11540:
11541: if ($$settings{'internal.crosslistings'} ne '') {
11542: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
11543: }
11544:
11545: if (@currxlists > 0) {
1.1361 raeburn 11546: foreach my $xl (@currxlists) {
11547: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 11548: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 11549: push(@{$allcourses},$1);
1.645 raeburn 11550: $$LC_code{$1} = $2;
11551: }
11552: }
11553: }
11554: }
1.1361 raeburn 11555:
1.645 raeburn 11556: if (@currsections > 0) {
1.1361 raeburn 11557: foreach my $sec (@currsections) {
11558: if ($sec =~ m/^(\w+):(\w*)$/ ) {
11559: my $instsec = $1;
1.645 raeburn 11560: my $lc_sec = $2;
1.1361 raeburn 11561: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
11562: push(@{$unclutteredsec{$crskey}},$instsec);
11563: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
11564: }
11565: }
11566: }
11567: }
11568:
11569: if (@{$unclutteredsec{$crskey}} > 0) {
11570: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
11571: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
11572: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
11573: my $sec = $coursecode.$formattedsec{$crskey}[$i];
11574: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1263 raeburn 11575: push(@{$allcourses},$sec);
1.1361 raeburn 11576: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 11577: }
11578: }
11579: }
11580: }
11581: return;
11582: }
11583:
1.971 raeburn 11584: sub get_standard_codeitems {
11585: return ('Year','Semester','Department','Number','Section');
11586: }
11587:
1.112 bowersj2 11588: =pod
11589:
1.780 raeburn 11590: =head1 Slot Helpers
11591:
11592: =over 4
11593:
11594: =item * sorted_slots()
11595:
1.1040 raeburn 11596: Sorts an array of slot names in order of an optional sort key,
11597: default sort is by slot start time (earliest first).
1.780 raeburn 11598:
11599: Inputs:
11600:
11601: =over 4
11602:
11603: slotsarr - Reference to array of unsorted slot names.
11604:
11605: slots - Reference to hash of hash, where outer hash keys are slot names.
11606:
1.1040 raeburn 11607: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
11608:
1.549 albertel 11609: =back
11610:
1.780 raeburn 11611: Returns:
11612:
11613: =over 4
11614:
1.1040 raeburn 11615: sorted - An array of slot names sorted by a specified sort key
11616: (default sort key is start time of the slot).
1.780 raeburn 11617:
11618: =back
11619:
11620: =cut
11621:
11622:
11623: sub sorted_slots {
1.1040 raeburn 11624: my ($slotsarr,$slots,$sortkey) = @_;
11625: if ($sortkey eq '') {
11626: $sortkey = 'starttime';
11627: }
1.780 raeburn 11628: my @sorted;
11629: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
11630: @sorted =
11631: sort {
11632: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 11633: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 11634: }
11635: if (ref($slots->{$a})) { return -1;}
11636: if (ref($slots->{$b})) { return 1;}
11637: return 0;
11638: } @{$slotsarr};
11639: }
11640: return @sorted;
11641: }
11642:
1.1040 raeburn 11643: =pod
11644:
11645: =item * get_future_slots()
11646:
11647: Inputs:
11648:
11649: =over 4
11650:
11651: cnum - course number
11652:
11653: cdom - course domain
11654:
11655: now - current UNIX time
11656:
11657: symb - optional symb
11658:
11659: =back
11660:
11661: Returns:
11662:
11663: =over 4
11664:
11665: sorted_reservable - ref to array of student_schedulable slots currently
11666: reservable, ordered by end date of reservation period.
11667:
11668: reservable_now - ref to hash of student_schedulable slots currently
11669: reservable.
11670:
11671: Keys in inner hash are:
11672: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 11673: (b) endreserve: end date of reservation period.
11674: (c) uniqueperiod: start,end dates when slot is to be uniquely
11675: selected.
1.1040 raeburn 11676:
11677: sorted_future - ref to array of student_schedulable slots reservable in
11678: the future, ordered by start date of reservation period.
11679:
11680: future_reservable - ref to hash of student_schedulable slots reservable
11681: in the future.
11682:
11683: Keys in inner hash are:
11684: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 11685: (b) startreserve: start date of reservation period.
11686: (c) uniqueperiod: start,end dates when slot is to be uniquely
11687: selected.
1.1040 raeburn 11688:
11689: =back
11690:
11691: =cut
11692:
11693: sub get_future_slots {
11694: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 11695: my $map;
11696: if ($symb) {
11697: ($map) = &Apache::lonnet::decode_symb($symb);
11698: }
1.1040 raeburn 11699: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
11700: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
11701: foreach my $slot (keys(%slots)) {
11702: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
11703: if ($symb) {
1.1229 raeburn 11704: if ($slots{$slot}->{'symb'} ne '') {
11705: my $canuse;
11706: my %oksymbs;
11707: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
11708: map { $oksymbs{$_} = 1; } @slotsymbs;
11709: if ($oksymbs{$symb}) {
11710: $canuse = 1;
11711: } else {
11712: foreach my $item (@slotsymbs) {
11713: if ($item =~ /\.(page|sequence)$/) {
11714: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
11715: if (($map ne '') && ($map eq $sloturl)) {
11716: $canuse = 1;
11717: last;
11718: }
11719: }
11720: }
11721: }
11722: next unless ($canuse);
11723: }
1.1040 raeburn 11724: }
11725: if (($slots{$slot}->{'starttime'} > $now) &&
11726: ($slots{$slot}->{'endtime'} > $now)) {
11727: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
11728: my $userallowed = 0;
11729: if ($slots{$slot}->{'allowedsections'}) {
11730: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
11731: if (!defined($env{'request.role.sec'})
11732: && grep(/^No section assigned$/,@allowed_sec)) {
11733: $userallowed=1;
11734: } else {
11735: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
11736: $userallowed=1;
11737: }
11738: }
11739: unless ($userallowed) {
11740: if (defined($env{'request.course.groups'})) {
11741: my @groups = split(/:/,$env{'request.course.groups'});
11742: foreach my $group (@groups) {
11743: if (grep(/^\Q$group\E$/,@allowed_sec)) {
11744: $userallowed=1;
11745: last;
11746: }
11747: }
11748: }
11749: }
11750: }
11751: if ($slots{$slot}->{'allowedusers'}) {
11752: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
11753: my $user = $env{'user.name'}.':'.$env{'user.domain'};
11754: if (grep(/^\Q$user\E$/,@allowed_users)) {
11755: $userallowed = 1;
11756: }
11757: }
11758: next unless($userallowed);
11759: }
11760: my $startreserve = $slots{$slot}->{'startreserve'};
11761: my $endreserve = $slots{$slot}->{'endreserve'};
11762: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 11763: my $uniqueperiod;
11764: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
11765: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
11766: }
1.1040 raeburn 11767: if (($startreserve < $now) &&
11768: (!$endreserve || $endreserve > $now)) {
11769: my $lastres = $endreserve;
11770: if (!$lastres) {
11771: $lastres = $slots{$slot}->{'starttime'};
11772: }
11773: $reservable_now{$slot} = {
11774: symb => $symb,
1.1250 raeburn 11775: endreserve => $lastres,
11776: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11777: };
11778: } elsif (($startreserve > $now) &&
11779: (!$endreserve || $endreserve > $startreserve)) {
11780: $future_reservable{$slot} = {
11781: symb => $symb,
1.1250 raeburn 11782: startreserve => $startreserve,
11783: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11784: };
11785: }
11786: }
11787: }
11788: my @unsorted_reservable = keys(%reservable_now);
11789: if (@unsorted_reservable > 0) {
11790: @sorted_reservable =
11791: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
11792: }
11793: my @unsorted_future = keys(%future_reservable);
11794: if (@unsorted_future > 0) {
11795: @sorted_future =
11796: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
11797: }
11798: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
11799: }
1.780 raeburn 11800:
11801: =pod
11802:
1.1057 foxr 11803: =back
11804:
1.549 albertel 11805: =head1 HTTP Helpers
11806:
11807: =over 4
11808:
1.648 raeburn 11809: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 11810:
1.258 albertel 11811: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 11812: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 11813: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 11814:
11815: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
11816: $possible_names is an ref to an array of form element names. As an example:
11817: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 11818: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 11819:
11820: =cut
1.1 albertel 11821:
1.6 albertel 11822: sub get_unprocessed_cgi {
1.25 albertel 11823: my ($query,$possible_names)= @_;
1.26 matthew 11824: # $Apache::lonxml::debug=1;
1.356 albertel 11825: foreach my $pair (split(/&/,$query)) {
11826: my ($name, $value) = split(/=/,$pair);
1.369 www 11827: $name = &unescape($name);
1.25 albertel 11828: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
11829: $value =~ tr/+/ /;
11830: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 11831: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 11832: }
1.16 harris41 11833: }
1.6 albertel 11834: }
11835:
1.112 bowersj2 11836: =pod
11837:
1.648 raeburn 11838: =item * &cacheheader()
1.112 bowersj2 11839:
11840: returns cache-controlling header code
11841:
11842: =cut
11843:
1.7 albertel 11844: sub cacheheader {
1.258 albertel 11845: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 11846: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
11847: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 11848: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
11849: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 11850: return $output;
1.7 albertel 11851: }
11852:
1.112 bowersj2 11853: =pod
11854:
1.648 raeburn 11855: =item * &no_cache($r)
1.112 bowersj2 11856:
11857: specifies header code to not have cache
11858:
11859: =cut
11860:
1.9 albertel 11861: sub no_cache {
1.216 albertel 11862: my ($r) = @_;
11863: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 11864: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 11865: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
11866: $r->no_cache(1);
11867: $r->header_out("Expires" => $date);
11868: $r->header_out("Pragma" => "no-cache");
1.123 www 11869: }
11870:
11871: sub content_type {
1.181 albertel 11872: my ($r,$type,$charset) = @_;
1.299 foxr 11873: if ($r) {
11874: # Note that printout.pl calls this with undef for $r.
11875: &no_cache($r);
11876: }
1.258 albertel 11877: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 11878: unless ($charset) {
11879: $charset=&Apache::lonlocal::current_encoding;
11880: }
11881: if ($charset) { $type.='; charset='.$charset; }
11882: if ($r) {
11883: $r->content_type($type);
11884: } else {
11885: print("Content-type: $type\n\n");
11886: }
1.9 albertel 11887: }
1.25 albertel 11888:
1.112 bowersj2 11889: =pod
11890:
1.648 raeburn 11891: =item * &add_to_env($name,$value)
1.112 bowersj2 11892:
1.258 albertel 11893: adds $name to the %env hash with value
1.112 bowersj2 11894: $value, if $name already exists, the entry is converted to an array
11895: reference and $value is added to the array.
11896:
11897: =cut
11898:
1.25 albertel 11899: sub add_to_env {
11900: my ($name,$value)=@_;
1.258 albertel 11901: if (defined($env{$name})) {
11902: if (ref($env{$name})) {
1.25 albertel 11903: #already have multiple values
1.258 albertel 11904: push(@{ $env{$name} },$value);
1.25 albertel 11905: } else {
11906: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 11907: my $first=$env{$name};
11908: undef($env{$name});
11909: push(@{ $env{$name} },$first,$value);
1.25 albertel 11910: }
11911: } else {
1.258 albertel 11912: $env{$name}=$value;
1.25 albertel 11913: }
1.31 albertel 11914: }
1.149 albertel 11915:
11916: =pod
11917:
1.648 raeburn 11918: =item * &get_env_multiple($name)
1.149 albertel 11919:
1.258 albertel 11920: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 11921: values may be defined and end up as an array ref.
11922:
11923: returns an array of values
11924:
11925: =cut
11926:
11927: sub get_env_multiple {
11928: my ($name) = @_;
11929: my @values;
1.258 albertel 11930: if (defined($env{$name})) {
1.149 albertel 11931: # exists is it an array
1.258 albertel 11932: if (ref($env{$name})) {
11933: @values=@{ $env{$name} };
1.149 albertel 11934: } else {
1.258 albertel 11935: $values[0]=$env{$name};
1.149 albertel 11936: }
11937: }
11938: return(@values);
11939: }
11940:
1.1249 damieng 11941: # Looks at given dependencies, and returns something depending on the context.
11942: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
11943: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
11944: # For all other contexts, returns ($output, $counter, $numpathchg).
11945: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
11946: # $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.
11947: # $numpathchg: integer with the number of cleaned up dependency paths.
11948: # \%existing: hash reference clean path -> 1 only for existing dependencies.
11949: # \%mapping: hash reference clean path -> original path for all dependencies.
11950: # @param {string} actionurl - The path to the handler, indicative of the context.
11951: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
11952: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
11953: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
11954: # @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)
11955: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 11956: sub ask_for_embedded_content {
1.1249 damieng 11957: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 11958: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 11959: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 11960: %currsubfile,%unused,$rem);
1.1071 raeburn 11961: my $counter = 0;
11962: my $numnew = 0;
1.987 raeburn 11963: my $numremref = 0;
11964: my $numinvalid = 0;
11965: my $numpathchg = 0;
11966: my $numexisting = 0;
1.1071 raeburn 11967: my $numunused = 0;
11968: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 11969: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 11970: my $heading = &mt('Upload embedded files');
11971: my $buttontext = &mt('Upload');
11972:
1.1249 damieng 11973: # fills these variables based on the context:
11974: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
11975: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 11976: if ($env{'request.course.id'}) {
1.1123 raeburn 11977: if ($actionurl eq '/adm/dependencies') {
11978: $navmap = Apache::lonnavmaps::navmap->new();
11979: }
11980: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
11981: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 11982: }
1.1123 raeburn 11983: if (($actionurl eq '/adm/portfolio') ||
11984: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 11985: my $current_path='/';
11986: if ($env{'form.currentpath'}) {
11987: $current_path = $env{'form.currentpath'};
11988: }
11989: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 11990: $udom = $cdom;
11991: $uname = $cnum;
1.984 raeburn 11992: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
11993: } else {
11994: $udom = $env{'user.domain'};
11995: $uname = $env{'user.name'};
11996: $url = '/userfiles/portfolio';
11997: }
1.987 raeburn 11998: $toplevel = $url.'/';
1.984 raeburn 11999: $url .= $current_path;
12000: $getpropath = 1;
1.987 raeburn 12001: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12002: ($actionurl eq '/adm/imsimport')) {
1.1022 www 12003: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 12004: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 12005: $toplevel = $url;
1.984 raeburn 12006: if ($rest ne '') {
1.987 raeburn 12007: $url .= $rest;
12008: }
12009: } elsif ($actionurl eq '/adm/coursedocs') {
12010: if (ref($args) eq 'HASH') {
1.1071 raeburn 12011: $url = $args->{'docs_url'};
12012: $toplevel = $url;
1.1084 raeburn 12013: if ($args->{'context'} eq 'paste') {
12014: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
12015: ($path) =
12016: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12017: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12018: $fileloc =~ s{^/}{};
12019: }
1.1071 raeburn 12020: }
1.1084 raeburn 12021: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 12022: if ($env{'request.course.id'} ne '') {
12023: if (ref($args) eq 'HASH') {
12024: $url = $args->{'docs_url'};
12025: $title = $args->{'docs_title'};
1.1126 raeburn 12026: $toplevel = $url;
12027: unless ($toplevel =~ m{^/}) {
12028: $toplevel = "/$url";
12029: }
1.1085 raeburn 12030: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 12031: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
12032: $path = $1;
12033: } else {
12034: ($path) =
12035: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12036: }
1.1195 raeburn 12037: if ($toplevel=~/^\/*(uploaded|editupload)/) {
12038: $fileloc = $toplevel;
12039: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
12040: my ($udom,$uname,$fname) =
12041: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
12042: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
12043: } else {
12044: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12045: }
1.1071 raeburn 12046: $fileloc =~ s{^/}{};
12047: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
12048: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
12049: }
1.987 raeburn 12050: }
1.1123 raeburn 12051: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12052: $udom = $cdom;
12053: $uname = $cnum;
12054: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
12055: $toplevel = $url;
12056: $path = $url;
12057: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
12058: $fileloc =~ s{^/}{};
1.987 raeburn 12059: }
1.1249 damieng 12060:
12061: # parses the dependency paths to get some info
12062: # fills $newfiles, $mapping, $subdependencies, $dependencies
12063: # $newfiles: hash URL -> 1 for new files or external URLs
12064: # (will be completed later)
12065: # $mapping:
12066: # for external URLs: external URL -> external URL
12067: # for relative paths: clean path -> original path
12068: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
12069: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 12070: foreach my $file (keys(%{$allfiles})) {
12071: my $embed_file;
12072: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
12073: $embed_file = $1;
12074: } else {
12075: $embed_file = $file;
12076: }
1.1158 raeburn 12077: my ($absolutepath,$cleaned_file);
12078: if ($embed_file =~ m{^\w+://}) {
12079: $cleaned_file = $embed_file;
1.1147 raeburn 12080: $newfiles{$cleaned_file} = 1;
12081: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12082: } else {
1.1158 raeburn 12083: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 12084: if ($embed_file =~ m{^/}) {
12085: $absolutepath = $embed_file;
12086: }
1.1147 raeburn 12087: if ($cleaned_file =~ m{/}) {
12088: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 12089: $path = &check_for_traversal($path,$url,$toplevel);
12090: my $item = $fname;
12091: if ($path ne '') {
12092: $item = $path.'/'.$fname;
12093: $subdependencies{$path}{$fname} = 1;
12094: } else {
12095: $dependencies{$item} = 1;
12096: }
12097: if ($absolutepath) {
12098: $mapping{$item} = $absolutepath;
12099: } else {
12100: $mapping{$item} = $embed_file;
12101: }
12102: } else {
12103: $dependencies{$embed_file} = 1;
12104: if ($absolutepath) {
1.1147 raeburn 12105: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 12106: } else {
1.1147 raeburn 12107: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12108: }
12109: }
1.984 raeburn 12110: }
12111: }
1.1249 damieng 12112:
12113: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
12114: # and lists
12115: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
12116: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
12117: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
12118: # the path had to be cleaned up
12119: # $existing: hash clean path -> 1 if the file exists
12120: # $numexisting: number of keys in $existing
12121: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
12122: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
12123: # dependency subdirectories that are
12124: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 12125: my $dirptr = 16384;
1.984 raeburn 12126: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 12127: $currsubfile{$path} = {};
1.1123 raeburn 12128: if (($actionurl eq '/adm/portfolio') ||
12129: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12130: my ($sublistref,$listerror) =
12131: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
12132: if (ref($sublistref) eq 'ARRAY') {
12133: foreach my $line (@{$sublistref}) {
12134: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 12135: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 12136: }
1.984 raeburn 12137: }
1.987 raeburn 12138: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12139: if (opendir(my $dir,$url.'/'.$path)) {
12140: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 12141: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
12142: }
1.1084 raeburn 12143: } elsif (($actionurl eq '/adm/dependencies') ||
12144: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12145: ($args->{'context'} eq 'paste')) ||
12146: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12147: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 12148: my $dir;
12149: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12150: $dir = $fileloc;
12151: } else {
12152: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12153: }
1.1071 raeburn 12154: if ($dir ne '') {
12155: my ($sublistref,$listerror) =
12156: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
12157: if (ref($sublistref) eq 'ARRAY') {
12158: foreach my $line (@{$sublistref}) {
12159: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
12160: undef,$mtime)=split(/\&/,$line,12);
12161: unless (($testdir&$dirptr) ||
12162: ($file_name =~ /^\.\.?$/)) {
12163: $currsubfile{$path}{$file_name} = [$size,$mtime];
12164: }
12165: }
12166: }
12167: }
1.984 raeburn 12168: }
12169: }
12170: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 12171: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 12172: my $item = $path.'/'.$file;
12173: unless ($mapping{$item} eq $item) {
12174: $pathchanges{$item} = 1;
12175: }
12176: $existing{$item} = 1;
12177: $numexisting ++;
12178: } else {
12179: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 12180: }
12181: }
1.1071 raeburn 12182: if ($actionurl eq '/adm/dependencies') {
12183: foreach my $path (keys(%currsubfile)) {
12184: if (ref($currsubfile{$path}) eq 'HASH') {
12185: foreach my $file (keys(%{$currsubfile{$path}})) {
12186: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 12187: next if (($rem ne '') &&
12188: (($env{"httpref.$rem"."$path/$file"} ne '') ||
12189: (ref($navmap) &&
12190: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
12191: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12192: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 12193: $unused{$path.'/'.$file} = 1;
12194: }
12195: }
12196: }
12197: }
12198: }
1.984 raeburn 12199: }
1.1249 damieng 12200:
12201: # fills $currfile, hash file name -> 1 or [$size,$mtime]
12202: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 12203: my %currfile;
1.1123 raeburn 12204: if (($actionurl eq '/adm/portfolio') ||
12205: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12206: my ($dirlistref,$listerror) =
12207: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
12208: if (ref($dirlistref) eq 'ARRAY') {
12209: foreach my $line (@{$dirlistref}) {
12210: my ($file_name,$rest) = split(/\&/,$line,2);
12211: $currfile{$file_name} = 1;
12212: }
1.984 raeburn 12213: }
1.987 raeburn 12214: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12215: if (opendir(my $dir,$url)) {
1.987 raeburn 12216: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 12217: map {$currfile{$_} = 1;} @dir_list;
12218: }
1.1084 raeburn 12219: } elsif (($actionurl eq '/adm/dependencies') ||
12220: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12221: ($args->{'context'} eq 'paste')) ||
12222: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12223: if ($env{'request.course.id'} ne '') {
12224: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12225: if ($dir ne '') {
12226: my ($dirlistref,$listerror) =
12227: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
12228: if (ref($dirlistref) eq 'ARRAY') {
12229: foreach my $line (@{$dirlistref}) {
12230: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
12231: $size,undef,$mtime)=split(/\&/,$line,12);
12232: unless (($testdir&$dirptr) ||
12233: ($file_name =~ /^\.\.?$/)) {
12234: $currfile{$file_name} = [$size,$mtime];
12235: }
12236: }
12237: }
12238: }
12239: }
1.984 raeburn 12240: }
1.1249 damieng 12241: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
12242: # are not in subdirectories, using $currfile
1.984 raeburn 12243: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 12244: if (exists($currfile{$file})) {
1.987 raeburn 12245: unless ($mapping{$file} eq $file) {
12246: $pathchanges{$file} = 1;
12247: }
12248: $existing{$file} = 1;
12249: $numexisting ++;
12250: } else {
1.984 raeburn 12251: $newfiles{$file} = 1;
12252: }
12253: }
1.1071 raeburn 12254: foreach my $file (keys(%currfile)) {
12255: unless (($file eq $filename) ||
12256: ($file eq $filename.'.bak') ||
12257: ($dependencies{$file})) {
1.1085 raeburn 12258: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 12259: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
12260: next if (($rem ne '') &&
12261: (($env{"httpref.$rem".$file} ne '') ||
12262: (ref($navmap) &&
12263: (($navmap->getResourceByUrl($rem.$file) ne '') ||
12264: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12265: ($navmap->getResourceByUrl($rem.$1)))))));
12266: }
1.1085 raeburn 12267: }
1.1071 raeburn 12268: $unused{$file} = 1;
12269: }
12270: }
1.1249 damieng 12271:
12272: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 12273: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
12274: ($args->{'context'} eq 'paste')) {
12275: $counter = scalar(keys(%existing));
12276: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 12277: return ($output,$counter,$numpathchg,\%existing);
12278: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
12279: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
12280: $counter = scalar(keys(%existing));
12281: $numpathchg = scalar(keys(%pathchanges));
12282: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 12283: }
1.1249 damieng 12284:
12285: # returns HTML otherwise, with dependency results and to ask for more uploads
12286:
12287: # $upload_output: missing dependencies (with upload form)
12288: # $modify_output: uploaded dependencies (in use)
12289: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 12290: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 12291: if ($actionurl eq '/adm/dependencies') {
12292: next if ($embed_file =~ m{^\w+://});
12293: }
1.660 raeburn 12294: $upload_output .= &start_data_table_row().
1.1123 raeburn 12295: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 12296: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 12297: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 12298: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
12299: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 12300: }
1.1123 raeburn 12301: $upload_output .= '</td>';
1.1071 raeburn 12302: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 12303: $upload_output.='<td align="right">'.
12304: '<span class="LC_info LC_fontsize_medium">'.
12305: &mt("URL points to web address").'</span>';
1.987 raeburn 12306: $numremref++;
1.660 raeburn 12307: } elsif ($args->{'error_on_invalid_names'}
12308: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 12309: $upload_output.='<td align="right"><span class="LC_warning">'.
12310: &mt('Invalid characters').'</span>';
1.987 raeburn 12311: $numinvalid++;
1.660 raeburn 12312: } else {
1.1123 raeburn 12313: $upload_output .= '<td>'.
12314: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 12315: $embed_file,\%mapping,
1.1071 raeburn 12316: $allfiles,$codebase,'upload');
12317: $counter ++;
12318: $numnew ++;
1.987 raeburn 12319: }
12320: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
12321: }
12322: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 12323: if ($actionurl eq '/adm/dependencies') {
12324: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
12325: $modify_output .= &start_data_table_row().
12326: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
12327: '<img src="'.&icon($embed_file).'" border="0" />'.
12328: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
12329: '<td>'.$size.'</td>'.
12330: '<td>'.$mtime.'</td>'.
12331: '<td><label><input type="checkbox" name="mod_upload_dep" '.
12332: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
12333: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
12334: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
12335: &embedded_file_element('upload_embedded',$counter,
12336: $embed_file,\%mapping,
12337: $allfiles,$codebase,'modify').
12338: '</div></td>'.
12339: &end_data_table_row()."\n";
12340: $counter ++;
12341: } else {
12342: $upload_output .= &start_data_table_row().
1.1123 raeburn 12343: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
12344: '<span class="LC_filename">'.$embed_file.'</span></td>'.
12345: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 12346: &Apache::loncommon::end_data_table_row()."\n";
12347: }
12348: }
12349: my $delidx = $counter;
12350: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
12351: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
12352: $delete_output .= &start_data_table_row().
12353: '<td><img src="'.&icon($oldfile).'" />'.
12354: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
12355: '<td>'.$size.'</td>'.
12356: '<td>'.$mtime.'</td>'.
12357: '<td><label><input type="checkbox" name="del_upload_dep" '.
12358: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
12359: &embedded_file_element('upload_embedded',$delidx,
12360: $oldfile,\%mapping,$allfiles,
12361: $codebase,'delete').'</td>'.
12362: &end_data_table_row()."\n";
12363: $numunused ++;
12364: $delidx ++;
1.987 raeburn 12365: }
12366: if ($upload_output) {
12367: $upload_output = &start_data_table().
12368: $upload_output.
12369: &end_data_table()."\n";
12370: }
1.1071 raeburn 12371: if ($modify_output) {
12372: $modify_output = &start_data_table().
12373: &start_data_table_header_row().
12374: '<th>'.&mt('File').'</th>'.
12375: '<th>'.&mt('Size (KB)').'</th>'.
12376: '<th>'.&mt('Modified').'</th>'.
12377: '<th>'.&mt('Upload replacement?').'</th>'.
12378: &end_data_table_header_row().
12379: $modify_output.
12380: &end_data_table()."\n";
12381: }
12382: if ($delete_output) {
12383: $delete_output = &start_data_table().
12384: &start_data_table_header_row().
12385: '<th>'.&mt('File').'</th>'.
12386: '<th>'.&mt('Size (KB)').'</th>'.
12387: '<th>'.&mt('Modified').'</th>'.
12388: '<th>'.&mt('Delete?').'</th>'.
12389: &end_data_table_header_row().
12390: $delete_output.
12391: &end_data_table()."\n";
12392: }
1.987 raeburn 12393: my $applies = 0;
12394: if ($numremref) {
12395: $applies ++;
12396: }
12397: if ($numinvalid) {
12398: $applies ++;
12399: }
12400: if ($numexisting) {
12401: $applies ++;
12402: }
1.1071 raeburn 12403: if ($counter || $numunused) {
1.987 raeburn 12404: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
12405: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 12406: $state.'<h3>'.$heading.'</h3>';
12407: if ($actionurl eq '/adm/dependencies') {
12408: if ($numnew) {
12409: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
12410: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
12411: $upload_output.'<br />'."\n";
12412: }
12413: if ($numexisting) {
12414: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
12415: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
12416: $modify_output.'<br />'."\n";
12417: $buttontext = &mt('Save changes');
12418: }
12419: if ($numunused) {
12420: $output .= '<h4>'.&mt('Unused files').'</h4>'.
12421: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
12422: $delete_output.'<br />'."\n";
12423: $buttontext = &mt('Save changes');
12424: }
12425: } else {
12426: $output .= $upload_output.'<br />'."\n";
12427: }
12428: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
12429: $counter.'" />'."\n";
12430: if ($actionurl eq '/adm/dependencies') {
12431: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
12432: $numnew.'" />'."\n";
12433: } elsif ($actionurl eq '') {
1.987 raeburn 12434: $output .= '<input type="hidden" name="phase" value="three" />';
12435: }
12436: } elsif ($applies) {
12437: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
12438: if ($applies > 1) {
12439: $output .=
1.1123 raeburn 12440: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 12441: if ($numremref) {
12442: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
12443: }
12444: if ($numinvalid) {
12445: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
12446: }
12447: if ($numexisting) {
12448: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
12449: }
12450: $output .= '</ul><br />';
12451: } elsif ($numremref) {
12452: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
12453: } elsif ($numinvalid) {
12454: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
12455: } elsif ($numexisting) {
12456: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
12457: }
12458: $output .= $upload_output.'<br />';
12459: }
12460: my ($pathchange_output,$chgcount);
1.1071 raeburn 12461: $chgcount = $counter;
1.987 raeburn 12462: if (keys(%pathchanges) > 0) {
12463: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 12464: if ($counter) {
1.987 raeburn 12465: $output .= &embedded_file_element('pathchange',$chgcount,
12466: $embed_file,\%mapping,
1.1071 raeburn 12467: $allfiles,$codebase,'change');
1.987 raeburn 12468: } else {
12469: $pathchange_output .=
12470: &start_data_table_row().
12471: '<td><input type ="checkbox" name="namechange" value="'.
12472: $chgcount.'" checked="checked" /></td>'.
12473: '<td>'.$mapping{$embed_file}.'</td>'.
12474: '<td>'.$embed_file.
12475: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 12476: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 12477: '</td>'.&end_data_table_row();
1.660 raeburn 12478: }
1.987 raeburn 12479: $numpathchg ++;
12480: $chgcount ++;
1.660 raeburn 12481: }
12482: }
1.1127 raeburn 12483: if (($counter) || ($numunused)) {
1.987 raeburn 12484: if ($numpathchg) {
12485: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
12486: $numpathchg.'" />'."\n";
12487: }
12488: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12489: ($actionurl eq '/adm/imsimport')) {
12490: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
12491: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
12492: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 12493: } elsif ($actionurl eq '/adm/dependencies') {
12494: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 12495: }
1.1123 raeburn 12496: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 12497: } elsif ($numpathchg) {
12498: my %pathchange = ();
12499: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
12500: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12501: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 12502: }
1.987 raeburn 12503: }
1.1071 raeburn 12504: return ($output,$counter,$numpathchg);
1.987 raeburn 12505: }
12506:
1.1147 raeburn 12507: =pod
12508:
12509: =item * clean_path($name)
12510:
12511: Performs clean-up of directories, subdirectories and filename in an
12512: embedded object, referenced in an HTML file which is being uploaded
12513: to a course or portfolio, where
12514: "Upload embedded images/multimedia files if HTML file" checkbox was
12515: checked.
12516:
12517: Clean-up is similar to replacements in lonnet::clean_filename()
12518: except each / between sub-directory and next level is preserved.
12519:
12520: =cut
12521:
12522: sub clean_path {
12523: my ($embed_file) = @_;
12524: $embed_file =~s{^/+}{};
12525: my @contents;
12526: if ($embed_file =~ m{/}) {
12527: @contents = split(/\//,$embed_file);
12528: } else {
12529: @contents = ($embed_file);
12530: }
12531: my $lastidx = scalar(@contents)-1;
12532: for (my $i=0; $i<=$lastidx; $i++) {
12533: $contents[$i]=~s{\\}{/}g;
12534: $contents[$i]=~s/\s+/\_/g;
12535: $contents[$i]=~s{[^/\w\.\-]}{}g;
12536: if ($i == $lastidx) {
12537: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
12538: }
12539: }
12540: if ($lastidx > 0) {
12541: return join('/',@contents);
12542: } else {
12543: return $contents[0];
12544: }
12545: }
12546:
1.987 raeburn 12547: sub embedded_file_element {
1.1071 raeburn 12548: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 12549: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
12550: (ref($codebase) eq 'HASH'));
12551: my $output;
1.1071 raeburn 12552: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 12553: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
12554: }
12555: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
12556: &escape($embed_file).'" />';
12557: unless (($context eq 'upload_embedded') &&
12558: ($mapping->{$embed_file} eq $embed_file)) {
12559: $output .='
12560: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
12561: }
12562: my $attrib;
12563: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
12564: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
12565: }
12566: $output .=
12567: "\n\t\t".
12568: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
12569: $attrib.'" />';
12570: if (exists($codebase->{$mapping->{$embed_file}})) {
12571: $output .=
12572: "\n\t\t".
12573: '<input name="codebase_'.$num.'" type="hidden" value="'.
12574: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 12575: }
1.987 raeburn 12576: return $output;
1.660 raeburn 12577: }
12578:
1.1071 raeburn 12579: sub get_dependency_details {
12580: my ($currfile,$currsubfile,$embed_file) = @_;
12581: my ($size,$mtime,$showsize,$showmtime);
12582: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
12583: if ($embed_file =~ m{/}) {
12584: my ($path,$fname) = split(/\//,$embed_file);
12585: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
12586: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
12587: }
12588: } else {
12589: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
12590: ($size,$mtime) = @{$currfile->{$embed_file}};
12591: }
12592: }
12593: $showsize = $size/1024.0;
12594: $showsize = sprintf("%.1f",$showsize);
12595: if ($mtime > 0) {
12596: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
12597: }
12598: }
12599: return ($showsize,$showmtime);
12600: }
12601:
12602: sub ask_embedded_js {
12603: return <<"END";
12604: <script type="text/javascript"">
12605: // <![CDATA[
12606: function toggleBrowse(counter) {
12607: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
12608: var fileid = document.getElementById('embedded_item_'+counter);
12609: var uploaddivid = document.getElementById('moduploaddep_'+counter);
12610: if (chkboxid.checked == true) {
12611: uploaddivid.style.display='block';
12612: } else {
12613: uploaddivid.style.display='none';
12614: fileid.value = '';
12615: }
12616: }
12617: // ]]>
12618: </script>
12619:
12620: END
12621: }
12622:
1.661 raeburn 12623: sub upload_embedded {
12624: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 12625: $current_disk_usage,$hiddenstate,$actionurl) = @_;
12626: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 12627: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
12628: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
12629: my $orig_uploaded_filename =
12630: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 12631: foreach my $type ('orig','ref','attrib','codebase') {
12632: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
12633: $env{'form.embedded_'.$type.'_'.$i} =
12634: &unescape($env{'form.embedded_'.$type.'_'.$i});
12635: }
12636: }
1.661 raeburn 12637: my ($path,$fname) =
12638: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
12639: # no path, whole string is fname
12640: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
12641: $fname = &Apache::lonnet::clean_filename($fname);
12642: # See if there is anything left
12643: next if ($fname eq '');
12644:
12645: # Check if file already exists as a file or directory.
12646: my ($state,$msg);
12647: if ($context eq 'portfolio') {
12648: my $port_path = $dirpath;
12649: if ($group ne '') {
12650: $port_path = "groups/$group/$port_path";
12651: }
1.987 raeburn 12652: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
12653: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 12654: $dir_root,$port_path,$disk_quota,
12655: $current_disk_usage,$uname,$udom);
12656: if ($state eq 'will_exceed_quota'
1.984 raeburn 12657: || $state eq 'file_locked') {
1.661 raeburn 12658: $output .= $msg;
12659: next;
12660: }
12661: } elsif (($context eq 'author') || ($context eq 'testbank')) {
12662: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
12663: if ($state eq 'exists') {
12664: $output .= $msg;
12665: next;
12666: }
12667: }
12668: # Check if extension is valid
12669: if (($fname =~ /\.(\w+)$/) &&
12670: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 12671: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
12672: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 12673: next;
12674: } elsif (($fname =~ /\.(\w+)$/) &&
12675: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 12676: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 12677: next;
12678: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 12679: $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 12680: next;
12681: }
12682: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 12683: my $subdir = $path;
12684: $subdir =~ s{/+$}{};
1.661 raeburn 12685: if ($context eq 'portfolio') {
1.984 raeburn 12686: my $result;
12687: if ($state eq 'existingfile') {
12688: $result=
12689: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 12690: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 12691: } else {
1.984 raeburn 12692: $result=
12693: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 12694: $dirpath.
1.1123 raeburn 12695: $env{'form.currentpath'}.$subdir);
1.984 raeburn 12696: if ($result !~ m|^/uploaded/|) {
12697: $output .= '<span class="LC_error">'
12698: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12699: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12700: .'</span><br />';
12701: next;
12702: } else {
1.987 raeburn 12703: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12704: $path.$fname.'</span>').'<br />';
1.984 raeburn 12705: }
1.661 raeburn 12706: }
1.1123 raeburn 12707: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 12708: my $extendedsubdir = $dirpath.'/'.$subdir;
12709: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 12710: my $result =
1.1126 raeburn 12711: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 12712: if ($result !~ m|^/uploaded/|) {
12713: $output .= '<span class="LC_error">'
12714: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12715: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12716: .'</span><br />';
12717: next;
12718: } else {
12719: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12720: $path.$fname.'</span>').'<br />';
1.1125 raeburn 12721: if ($context eq 'syllabus') {
12722: &Apache::lonnet::make_public_indefinitely($result);
12723: }
1.987 raeburn 12724: }
1.661 raeburn 12725: } else {
12726: # Save the file
12727: my $target = $env{'form.embedded_item_'.$i};
12728: my $fullpath = $dir_root.$dirpath.'/'.$path;
12729: my $dest = $fullpath.$fname;
12730: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 12731: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 12732: my $count;
12733: my $filepath = $dir_root;
1.1027 raeburn 12734: foreach my $subdir (@parts) {
12735: $filepath .= "/$subdir";
12736: if (!-e $filepath) {
1.661 raeburn 12737: mkdir($filepath,0770);
12738: }
12739: }
12740: my $fh;
12741: if (!open($fh,'>'.$dest)) {
12742: &Apache::lonnet::logthis('Failed to create '.$dest);
12743: $output .= '<span class="LC_error">'.
1.1071 raeburn 12744: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
12745: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12746: '</span><br />';
12747: } else {
12748: if (!print $fh $env{'form.embedded_item_'.$i}) {
12749: &Apache::lonnet::logthis('Failed to write to '.$dest);
12750: $output .= '<span class="LC_error">'.
1.1071 raeburn 12751: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
12752: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12753: '</span><br />';
12754: } else {
1.987 raeburn 12755: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12756: $url.'</span>').'<br />';
12757: unless ($context eq 'testbank') {
12758: $footer .= &mt('View embedded file: [_1]',
12759: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
12760: }
12761: }
12762: close($fh);
12763: }
12764: }
12765: if ($env{'form.embedded_ref_'.$i}) {
12766: $pathchange{$i} = 1;
12767: }
12768: }
12769: if ($output) {
12770: $output = '<p>'.$output.'</p>';
12771: }
12772: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
12773: $returnflag = 'ok';
1.1071 raeburn 12774: my $numpathchgs = scalar(keys(%pathchange));
12775: if ($numpathchgs > 0) {
1.987 raeburn 12776: if ($context eq 'portfolio') {
12777: $output .= '<p>'.&mt('or').'</p>';
12778: } elsif ($context eq 'testbank') {
1.1071 raeburn 12779: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
12780: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 12781: $returnflag = 'modify_orightml';
12782: }
12783: }
1.1071 raeburn 12784: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 12785: }
12786:
12787: sub modify_html_form {
12788: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
12789: my $end = 0;
12790: my $modifyform;
12791: if ($context eq 'upload_embedded') {
12792: return unless (ref($pathchange) eq 'HASH');
12793: if ($env{'form.number_embedded_items'}) {
12794: $end += $env{'form.number_embedded_items'};
12795: }
12796: if ($env{'form.number_pathchange_items'}) {
12797: $end += $env{'form.number_pathchange_items'};
12798: }
12799: if ($end) {
12800: for (my $i=0; $i<$end; $i++) {
12801: if ($i < $env{'form.number_embedded_items'}) {
12802: next unless($pathchange->{$i});
12803: }
12804: $modifyform .=
12805: &start_data_table_row().
12806: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
12807: 'checked="checked" /></td>'.
12808: '<td>'.$env{'form.embedded_ref_'.$i}.
12809: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
12810: &escape($env{'form.embedded_ref_'.$i}).'" />'.
12811: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
12812: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
12813: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
12814: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
12815: '<td>'.$env{'form.embedded_orig_'.$i}.
12816: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
12817: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
12818: &end_data_table_row();
1.1071 raeburn 12819: }
1.987 raeburn 12820: }
12821: } else {
12822: $modifyform = $pathchgtable;
12823: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
12824: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
12825: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12826: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
12827: }
12828: }
12829: if ($modifyform) {
1.1071 raeburn 12830: if ($actionurl eq '/adm/dependencies') {
12831: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
12832: }
1.987 raeburn 12833: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
12834: '<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".
12835: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
12836: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
12837: '</ol></p>'."\n".'<p>'.
12838: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
12839: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
12840: &start_data_table()."\n".
12841: &start_data_table_header_row().
12842: '<th>'.&mt('Change?').'</th>'.
12843: '<th>'.&mt('Current reference').'</th>'.
12844: '<th>'.&mt('Required reference').'</th>'.
12845: &end_data_table_header_row()."\n".
12846: $modifyform.
12847: &end_data_table().'<br />'."\n".$hiddenstate.
12848: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
12849: '</form>'."\n";
12850: }
12851: return;
12852: }
12853:
12854: sub modify_html_refs {
1.1123 raeburn 12855: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 12856: my $container;
12857: if ($context eq 'portfolio') {
12858: $container = $env{'form.container'};
12859: } elsif ($context eq 'coursedoc') {
12860: $container = $env{'form.primaryurl'};
1.1071 raeburn 12861: } elsif ($context eq 'manage_dependencies') {
12862: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
12863: $container = "/$container";
1.1123 raeburn 12864: } elsif ($context eq 'syllabus') {
12865: $container = $url;
1.987 raeburn 12866: } else {
1.1027 raeburn 12867: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 12868: }
12869: my (%allfiles,%codebase,$output,$content);
12870: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 12871: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 12872: if (wantarray) {
12873: return ('',0,0);
12874: } else {
12875: return;
12876: }
12877: }
12878: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12879: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 12880: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
12881: if (wantarray) {
12882: return ('',0,0);
12883: } else {
12884: return;
12885: }
12886: }
1.987 raeburn 12887: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 12888: if ($content eq '-1') {
12889: if (wantarray) {
12890: return ('',0,0);
12891: } else {
12892: return;
12893: }
12894: }
1.987 raeburn 12895: } else {
1.1071 raeburn 12896: unless ($container =~ /^\Q$dir_root\E/) {
12897: if (wantarray) {
12898: return ('',0,0);
12899: } else {
12900: return;
12901: }
12902: }
1.1317 raeburn 12903: if (open(my $fh,'<',$container)) {
1.987 raeburn 12904: $content = join('', <$fh>);
12905: close($fh);
12906: } else {
1.1071 raeburn 12907: if (wantarray) {
12908: return ('',0,0);
12909: } else {
12910: return;
12911: }
1.987 raeburn 12912: }
12913: }
12914: my ($count,$codebasecount) = (0,0);
12915: my $mm = new File::MMagic;
12916: my $mime_type = $mm->checktype_contents($content);
12917: if ($mime_type eq 'text/html') {
12918: my $parse_result =
12919: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
12920: \%codebase,\$content);
12921: if ($parse_result eq 'ok') {
12922: foreach my $i (@changes) {
12923: my $orig = &unescape($env{'form.embedded_orig_'.$i});
12924: my $ref = &unescape($env{'form.embedded_ref_'.$i});
12925: if ($allfiles{$ref}) {
12926: my $newname = $orig;
12927: my ($attrib_regexp,$codebase);
1.1006 raeburn 12928: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 12929: if ($attrib_regexp =~ /:/) {
12930: $attrib_regexp =~ s/\:/|/g;
12931: }
12932: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12933: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12934: $count += $numchg;
1.1123 raeburn 12935: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 12936: delete($allfiles{$ref});
1.987 raeburn 12937: }
12938: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 12939: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 12940: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
12941: $codebasecount ++;
12942: }
12943: }
12944: }
1.1123 raeburn 12945: my $skiprewrites;
1.987 raeburn 12946: if ($count || $codebasecount) {
12947: my $saveresult;
1.1071 raeburn 12948: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12949: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 12950: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12951: if ($url eq $container) {
12952: my ($fname) = ($container =~ m{/([^/]+)$});
12953: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12954: $count,'<span class="LC_filename">'.
1.1071 raeburn 12955: $fname.'</span>').'</p>';
1.987 raeburn 12956: } else {
12957: $output = '<p class="LC_error">'.
12958: &mt('Error: update failed for: [_1].',
12959: '<span class="LC_filename">'.
12960: $container.'</span>').'</p>';
12961: }
1.1123 raeburn 12962: if ($context eq 'syllabus') {
12963: unless ($saveresult eq 'ok') {
12964: $skiprewrites = 1;
12965: }
12966: }
1.987 raeburn 12967: } else {
1.1317 raeburn 12968: if (open(my $fh,'>',$container)) {
1.987 raeburn 12969: print $fh $content;
12970: close($fh);
12971: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12972: $count,'<span class="LC_filename">'.
12973: $container.'</span>').'</p>';
1.661 raeburn 12974: } else {
1.987 raeburn 12975: $output = '<p class="LC_error">'.
12976: &mt('Error: could not update [_1].',
12977: '<span class="LC_filename">'.
12978: $container.'</span>').'</p>';
1.661 raeburn 12979: }
12980: }
12981: }
1.1123 raeburn 12982: if (($context eq 'syllabus') && (!$skiprewrites)) {
12983: my ($actionurl,$state);
12984: $actionurl = "/public/$udom/$uname/syllabus";
12985: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
12986: &ask_for_embedded_content($actionurl,$state,\%allfiles,
12987: \%codebase,
12988: {'context' => 'rewrites',
12989: 'ignore_remote_references' => 1,});
12990: if (ref($mapping) eq 'HASH') {
12991: my $rewrites = 0;
12992: foreach my $key (keys(%{$mapping})) {
12993: next if ($key =~ m{^https?://});
12994: my $ref = $mapping->{$key};
12995: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
12996: my $attrib;
12997: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
12998: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
12999: }
13000: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13001: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13002: $rewrites += $numchg;
13003: }
13004: }
13005: if ($rewrites) {
13006: my $saveresult;
13007: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13008: if ($url eq $container) {
13009: my ($fname) = ($container =~ m{/([^/]+)$});
13010: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
13011: $count,'<span class="LC_filename">'.
13012: $fname.'</span>').'</p>';
13013: } else {
13014: $output .= '<p class="LC_error">'.
13015: &mt('Error: could not update links in [_1].',
13016: '<span class="LC_filename">'.
13017: $container.'</span>').'</p>';
13018:
13019: }
13020: }
13021: }
13022: }
1.987 raeburn 13023: } else {
13024: &logthis('Failed to parse '.$container.
13025: ' to modify references: '.$parse_result);
1.661 raeburn 13026: }
13027: }
1.1071 raeburn 13028: if (wantarray) {
13029: return ($output,$count,$codebasecount);
13030: } else {
13031: return $output;
13032: }
1.661 raeburn 13033: }
13034:
13035: sub check_for_existing {
13036: my ($path,$fname,$element) = @_;
13037: my ($state,$msg);
13038: if (-d $path.'/'.$fname) {
13039: $state = 'exists';
13040: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13041: } elsif (-e $path.'/'.$fname) {
13042: $state = 'exists';
13043: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13044: }
13045: if ($state eq 'exists') {
13046: $msg = '<span class="LC_error">'.$msg.'</span><br />';
13047: }
13048: return ($state,$msg);
13049: }
13050:
13051: sub check_for_upload {
13052: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
13053: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 13054: my $filesize = length($env{'form.'.$element});
13055: if (!$filesize) {
13056: my $msg = '<span class="LC_error">'.
13057: &mt('Unable to upload [_1]. (size = [_2] bytes)',
13058: '<span class="LC_filename">'.$fname.'</span>',
13059: $filesize).'<br />'.
1.1007 raeburn 13060: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 13061: '</span>';
13062: return ('zero_bytes',$msg);
13063: }
13064: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 13065: my $getpropath = 1;
1.1021 raeburn 13066: my ($dirlistref,$listerror) =
13067: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 13068: my $found_file = 0;
13069: my $locked_file = 0;
1.991 raeburn 13070: my @lockers;
13071: my $navmap;
13072: if ($env{'request.course.id'}) {
13073: $navmap = Apache::lonnavmaps::navmap->new();
13074: }
1.1021 raeburn 13075: if (ref($dirlistref) eq 'ARRAY') {
13076: foreach my $line (@{$dirlistref}) {
13077: my ($file_name,$rest)=split(/\&/,$line,2);
13078: if ($file_name eq $fname){
13079: $file_name = $path.$file_name;
13080: if ($group ne '') {
13081: $file_name = $group.$file_name;
13082: }
13083: $found_file = 1;
13084: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
13085: foreach my $lock (@lockers) {
13086: if (ref($lock) eq 'ARRAY') {
13087: my ($symb,$crsid) = @{$lock};
13088: if ($crsid eq $env{'request.course.id'}) {
13089: if (ref($navmap)) {
13090: my $res = $navmap->getBySymb($symb);
13091: foreach my $part (@{$res->parts()}) {
13092: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
13093: unless (($slot_status == $res->RESERVED) ||
13094: ($slot_status == $res->RESERVED_LOCATION)) {
13095: $locked_file = 1;
13096: }
1.991 raeburn 13097: }
1.1021 raeburn 13098: } else {
13099: $locked_file = 1;
1.991 raeburn 13100: }
13101: } else {
13102: $locked_file = 1;
13103: }
13104: }
1.1021 raeburn 13105: }
13106: } else {
13107: my @info = split(/\&/,$rest);
13108: my $currsize = $info[6]/1000;
13109: if ($currsize < $filesize) {
13110: my $extra = $filesize - $currsize;
13111: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 13112: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 13113: &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 13114: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
13115: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
13116: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 13117: return ('will_exceed_quota',$msg);
13118: }
1.984 raeburn 13119: }
13120: }
1.661 raeburn 13121: }
13122: }
13123: }
13124: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 13125: my $msg = '<p class="LC_warning">'.
13126: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 13127: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 13128: return ('will_exceed_quota',$msg);
13129: } elsif ($found_file) {
13130: if ($locked_file) {
1.1179 bisitz 13131: my $msg = '<p class="LC_warning">';
1.661 raeburn 13132: $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 13133: $msg .= '</p>';
1.661 raeburn 13134: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
13135: return ('file_locked',$msg);
13136: } else {
1.1179 bisitz 13137: my $msg = '<p class="LC_error">';
1.984 raeburn 13138: $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 13139: $msg .= '</p>';
1.984 raeburn 13140: return ('existingfile',$msg);
1.661 raeburn 13141: }
13142: }
13143: }
13144:
1.987 raeburn 13145: sub check_for_traversal {
13146: my ($path,$url,$toplevel) = @_;
13147: my @parts=split(/\//,$path);
13148: my $cleanpath;
13149: my $fullpath = $url;
13150: for (my $i=0;$i<@parts;$i++) {
13151: next if ($parts[$i] eq '.');
13152: if ($parts[$i] eq '..') {
13153: $fullpath =~ s{([^/]+/)$}{};
13154: } else {
13155: $fullpath .= $parts[$i].'/';
13156: }
13157: }
13158: if ($fullpath =~ /^\Q$url\E(.*)$/) {
13159: $cleanpath = $1;
13160: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
13161: my $curr_toprel = $1;
13162: my @parts = split(/\//,$curr_toprel);
13163: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
13164: my @urlparts = split(/\//,$url_toprel);
13165: my $doubledots;
13166: my $startdiff = -1;
13167: for (my $i=0; $i<@urlparts; $i++) {
13168: if ($startdiff == -1) {
13169: unless ($urlparts[$i] eq $parts[$i]) {
13170: $startdiff = $i;
13171: $doubledots .= '../';
13172: }
13173: } else {
13174: $doubledots .= '../';
13175: }
13176: }
13177: if ($startdiff > -1) {
13178: $cleanpath = $doubledots;
13179: for (my $i=$startdiff; $i<@parts; $i++) {
13180: $cleanpath .= $parts[$i].'/';
13181: }
13182: }
13183: }
13184: $cleanpath =~ s{(/)$}{};
13185: return $cleanpath;
13186: }
1.31 albertel 13187:
1.1053 raeburn 13188: sub is_archive_file {
13189: my ($mimetype) = @_;
13190: if (($mimetype eq 'application/octet-stream') ||
13191: ($mimetype eq 'application/x-stuffit') ||
13192: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
13193: return 1;
13194: }
13195: return;
13196: }
13197:
13198: sub decompress_form {
1.1065 raeburn 13199: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 13200: my %lt = &Apache::lonlocal::texthash (
13201: this => 'This file is an archive file.',
1.1067 raeburn 13202: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 13203: itsc => 'Its contents are as follows:',
1.1053 raeburn 13204: youm => 'You may wish to extract its contents.',
13205: extr => 'Extract contents',
1.1067 raeburn 13206: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
13207: proa => 'Process automatically?',
1.1053 raeburn 13208: yes => 'Yes',
13209: no => 'No',
1.1067 raeburn 13210: fold => 'Title for folder containing movie',
13211: movi => 'Title for page containing embedded movie',
1.1053 raeburn 13212: );
1.1065 raeburn 13213: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 13214: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 13215: my $info = &list_archive_contents($fileloc,\@paths);
13216: if (@paths) {
13217: foreach my $path (@paths) {
13218: $path =~ s{^/}{};
1.1067 raeburn 13219: if ($path =~ m{^([^/]+)/$}) {
13220: $topdir = $1;
13221: }
1.1065 raeburn 13222: if ($path =~ m{^([^/]+)/}) {
13223: $toplevel{$1} = $path;
13224: } else {
13225: $toplevel{$path} = $path;
13226: }
13227: }
13228: }
1.1067 raeburn 13229: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 13230: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 13231: "$topdir/media/",
13232: "$topdir/media/$topdir.mp4",
13233: "$topdir/media/FirstFrame.png",
13234: "$topdir/media/player.swf",
13235: "$topdir/media/swfobject.js",
13236: "$topdir/media/expressInstall.swf");
1.1197 raeburn 13237: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 13238: "$topdir/$topdir.mp4",
13239: "$topdir/$topdir\_config.xml",
13240: "$topdir/$topdir\_controller.swf",
13241: "$topdir/$topdir\_embed.css",
13242: "$topdir/$topdir\_First_Frame.png",
13243: "$topdir/$topdir\_player.html",
13244: "$topdir/$topdir\_Thumbnails.png",
13245: "$topdir/playerProductInstall.swf",
13246: "$topdir/scripts/",
13247: "$topdir/scripts/config_xml.js",
13248: "$topdir/scripts/handlebars.js",
13249: "$topdir/scripts/jquery-1.7.1.min.js",
13250: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
13251: "$topdir/scripts/modernizr.js",
13252: "$topdir/scripts/player-min.js",
13253: "$topdir/scripts/swfobject.js",
13254: "$topdir/skins/",
13255: "$topdir/skins/configuration_express.xml",
13256: "$topdir/skins/express_show/",
13257: "$topdir/skins/express_show/player-min.css",
13258: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 13259: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
13260: "$topdir/$topdir.mp4",
13261: "$topdir/$topdir\_config.xml",
13262: "$topdir/$topdir\_controller.swf",
13263: "$topdir/$topdir\_embed.css",
13264: "$topdir/$topdir\_First_Frame.png",
13265: "$topdir/$topdir\_player.html",
13266: "$topdir/$topdir\_Thumbnails.png",
13267: "$topdir/playerProductInstall.swf",
13268: "$topdir/scripts/",
13269: "$topdir/scripts/config_xml.js",
13270: "$topdir/scripts/techsmith-smart-player.min.js",
13271: "$topdir/skins/",
13272: "$topdir/skins/configuration_express.xml",
13273: "$topdir/skins/express_show/",
13274: "$topdir/skins/express_show/spritesheet.min.css",
13275: "$topdir/skins/express_show/spritesheet.png",
13276: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 13277: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 13278: if (@diffs == 0) {
1.1164 raeburn 13279: $is_camtasia = 6;
13280: } else {
1.1197 raeburn 13281: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 13282: if (@diffs == 0) {
13283: $is_camtasia = 8;
1.1197 raeburn 13284: } else {
13285: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
13286: if (@diffs == 0) {
13287: $is_camtasia = 8;
13288: }
1.1164 raeburn 13289: }
1.1067 raeburn 13290: }
13291: }
13292: my $output;
13293: if ($is_camtasia) {
13294: $output = <<"ENDCAM";
13295: <script type="text/javascript" language="Javascript">
13296: // <![CDATA[
13297:
13298: function camtasiaToggle() {
13299: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
13300: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 13301: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 13302: document.getElementById('camtasia_titles').style.display='block';
13303: } else {
13304: document.getElementById('camtasia_titles').style.display='none';
13305: }
13306: }
13307: }
13308: return;
13309: }
13310:
13311: // ]]>
13312: </script>
13313: <p>$lt{'camt'}</p>
13314: ENDCAM
1.1065 raeburn 13315: } else {
1.1067 raeburn 13316: $output = '<p>'.$lt{'this'};
13317: if ($info eq '') {
13318: $output .= ' '.$lt{'youm'}.'</p>'."\n";
13319: } else {
13320: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
13321: '<div><pre>'.$info.'</pre></div>';
13322: }
1.1065 raeburn 13323: }
1.1067 raeburn 13324: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 13325: my $duplicates;
13326: my $num = 0;
13327: if (ref($dirlist) eq 'ARRAY') {
13328: foreach my $item (@{$dirlist}) {
13329: if (ref($item) eq 'ARRAY') {
13330: if (exists($toplevel{$item->[0]})) {
13331: $duplicates .=
13332: &start_data_table_row().
13333: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
13334: 'value="0" checked="checked" />'.&mt('No').'</label>'.
13335: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
13336: 'value="1" />'.&mt('Yes').'</label>'.
13337: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
13338: '<td>'.$item->[0].'</td>';
13339: if ($item->[2]) {
13340: $duplicates .= '<td>'.&mt('Directory').'</td>';
13341: } else {
13342: $duplicates .= '<td>'.&mt('File').'</td>';
13343: }
13344: $duplicates .= '<td>'.$item->[3].'</td>'.
13345: '<td>'.
13346: &Apache::lonlocal::locallocaltime($item->[4]).
13347: '</td>'.
13348: &end_data_table_row();
13349: $num ++;
13350: }
13351: }
13352: }
13353: }
13354: my $itemcount;
13355: if (@paths > 0) {
13356: $itemcount = scalar(@paths);
13357: } else {
13358: $itemcount = 1;
13359: }
1.1067 raeburn 13360: if ($is_camtasia) {
13361: $output .= $lt{'auto'}.'<br />'.
13362: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 13363: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 13364: $lt{'yes'}.'</label> <label>'.
13365: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
13366: $lt{'no'}.'</label></span><br />'.
13367: '<div id="camtasia_titles" style="display:block">'.
13368: &Apache::lonhtmlcommon::start_pick_box().
13369: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
13370: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
13371: &Apache::lonhtmlcommon::row_closure().
13372: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
13373: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
13374: &Apache::lonhtmlcommon::row_closure(1).
13375: &Apache::lonhtmlcommon::end_pick_box().
13376: '</div>';
13377: }
1.1065 raeburn 13378: $output .=
13379: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 13380: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
13381: "\n";
1.1065 raeburn 13382: if ($duplicates ne '') {
13383: $output .= '<p><span class="LC_warning">'.
13384: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
13385: &start_data_table().
13386: &start_data_table_header_row().
13387: '<th>'.&mt('Overwrite?').'</th>'.
13388: '<th>'.&mt('Name').'</th>'.
13389: '<th>'.&mt('Type').'</th>'.
13390: '<th>'.&mt('Size').'</th>'.
13391: '<th>'.&mt('Last modified').'</th>'.
13392: &end_data_table_header_row().
13393: $duplicates.
13394: &end_data_table().
13395: '</p>';
13396: }
1.1067 raeburn 13397: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 13398: if (ref($hiddenelements) eq 'HASH') {
13399: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
13400: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
13401: }
13402: }
13403: $output .= <<"END";
1.1067 raeburn 13404: <br />
1.1053 raeburn 13405: <input type="submit" name="decompress" value="$lt{'extr'}" />
13406: </form>
13407: $noextract
13408: END
13409: return $output;
13410: }
13411:
1.1065 raeburn 13412: sub decompression_utility {
13413: my ($program) = @_;
13414: my @utilities = ('tar','gunzip','bunzip2','unzip');
13415: my $location;
13416: if (grep(/^\Q$program\E$/,@utilities)) {
13417: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
13418: '/usr/sbin/') {
13419: if (-x $dir.$program) {
13420: $location = $dir.$program;
13421: last;
13422: }
13423: }
13424: }
13425: return $location;
13426: }
13427:
13428: sub list_archive_contents {
13429: my ($file,$pathsref) = @_;
13430: my (@cmd,$output);
13431: my $needsregexp;
13432: if ($file =~ /\.zip$/) {
13433: @cmd = (&decompression_utility('unzip'),"-l");
13434: $needsregexp = 1;
13435: } elsif (($file =~ m/\.tar\.gz$/) ||
13436: ($file =~ /\.tgz$/)) {
13437: @cmd = (&decompression_utility('tar'),"-ztf");
13438: } elsif ($file =~ /\.tar\.bz2$/) {
13439: @cmd = (&decompression_utility('tar'),"-jtf");
13440: } elsif ($file =~ m|\.tar$|) {
13441: @cmd = (&decompression_utility('tar'),"-tf");
13442: }
13443: if (@cmd) {
13444: undef($!);
13445: undef($@);
13446: if (open(my $fh,"-|", @cmd, $file)) {
13447: while (my $line = <$fh>) {
13448: $output .= $line;
13449: chomp($line);
13450: my $item;
13451: if ($needsregexp) {
13452: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
13453: } else {
13454: $item = $line;
13455: }
13456: if ($item ne '') {
13457: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
13458: push(@{$pathsref},$item);
13459: }
13460: }
13461: }
13462: close($fh);
13463: }
13464: }
13465: return $output;
13466: }
13467:
1.1053 raeburn 13468: sub decompress_uploaded_file {
13469: my ($file,$dir) = @_;
13470: &Apache::lonnet::appenv({'cgi.file' => $file});
13471: &Apache::lonnet::appenv({'cgi.dir' => $dir});
13472: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
13473: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
13474: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
13475: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
13476: my $decompressed = $env{'cgi.decompressed'};
13477: &Apache::lonnet::delenv('cgi.file');
13478: &Apache::lonnet::delenv('cgi.dir');
13479: &Apache::lonnet::delenv('cgi.decompressed');
13480: return ($decompressed,$result);
13481: }
13482:
1.1055 raeburn 13483: sub process_decompression {
13484: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 13485: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
13486: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13487: &mt('Unexpected file path.').'</p>'."\n";
13488: }
13489: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
13490: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13491: &mt('Unexpected course context.').'</p>'."\n";
13492: }
1.1293 raeburn 13493: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 13494: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13495: &mt('Filename contained unexpected characters.').'</p>'."\n";
13496: }
1.1055 raeburn 13497: my ($dir,$error,$warning,$output);
1.1180 raeburn 13498: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 13499: $error = &mt('Filename not a supported archive file type.').
13500: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 13501: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
13502: } else {
13503: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13504: if ($docuhome eq 'no_host') {
13505: $error = &mt('Could not determine home server for course.');
13506: } else {
13507: my @ids=&Apache::lonnet::current_machine_ids();
13508: my $currdir = "$dir_root/$destination";
13509: if (grep(/^\Q$docuhome\E$/,@ids)) {
13510: $dir = &LONCAPA::propath($docudom,$docuname).
13511: "$dir_root/$destination";
13512: } else {
13513: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
13514: "$dir_root/$docudom/$docuname/$destination";
13515: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
13516: $error = &mt('Archive file not found.');
13517: }
13518: }
1.1065 raeburn 13519: my (@to_overwrite,@to_skip);
13520: if ($env{'form.archive_overwrite_total'} > 0) {
13521: my $total = $env{'form.archive_overwrite_total'};
13522: for (my $i=0; $i<$total; $i++) {
13523: if ($env{'form.archive_overwrite_'.$i} == 1) {
13524: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
13525: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
13526: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
13527: }
13528: }
13529: }
13530: my $numskip = scalar(@to_skip);
1.1292 raeburn 13531: my $numoverwrite = scalar(@to_overwrite);
13532: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 13533: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
13534: } elsif ($dir eq '') {
1.1055 raeburn 13535: $error = &mt('Directory containing archive file unavailable.');
13536: } elsif (!$error) {
1.1065 raeburn 13537: my ($decompressed,$display);
1.1292 raeburn 13538: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 13539: my $tempdir = time.'_'.$$.int(rand(10000));
13540: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 13541: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
13542: ($decompressed,$display) =
13543: &decompress_uploaded_file($file,"$dir/$tempdir");
13544: foreach my $item (@to_skip) {
13545: if (($item ne '') && ($item !~ /\.\./)) {
13546: if (-f "$dir/$tempdir/$item") {
13547: unlink("$dir/$tempdir/$item");
13548: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 13549: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 13550: }
13551: }
13552: }
13553: foreach my $item (@to_overwrite) {
13554: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
13555: if (($item ne '') && ($item !~ /\.\./)) {
13556: if (-f "$dir/$item") {
13557: unlink("$dir/$item");
13558: } elsif (-d "$dir/$item") {
1.1300 raeburn 13559: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 13560: }
13561: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
13562: }
1.1065 raeburn 13563: }
13564: }
1.1292 raeburn 13565: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 13566: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 13567: }
1.1065 raeburn 13568: }
13569: } else {
13570: ($decompressed,$display) =
13571: &decompress_uploaded_file($file,$dir);
13572: }
1.1055 raeburn 13573: if ($decompressed eq 'ok') {
1.1065 raeburn 13574: $output = '<p class="LC_info">'.
13575: &mt('Files extracted successfully from archive.').
13576: '</p>'."\n";
1.1055 raeburn 13577: my ($warning,$result,@contents);
13578: my ($newdirlistref,$newlisterror) =
13579: &Apache::lonnet::dirlist($currdir,$docudom,
13580: $docuname,1);
13581: my (%is_dir,%changes,@newitems);
13582: my $dirptr = 16384;
1.1065 raeburn 13583: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 13584: foreach my $dir_line (@{$newdirlistref}) {
13585: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 13586: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 13587: push(@newitems,$item);
13588: if ($dirptr&$testdir) {
13589: $is_dir{$item} = 1;
13590: }
13591: $changes{$item} = 1;
13592: }
13593: }
13594: }
13595: if (keys(%changes) > 0) {
13596: foreach my $item (sort(@newitems)) {
13597: if ($changes{$item}) {
13598: push(@contents,$item);
13599: }
13600: }
13601: }
13602: if (@contents > 0) {
1.1067 raeburn 13603: my $wantform;
13604: unless ($env{'form.autoextract_camtasia'}) {
13605: $wantform = 1;
13606: }
1.1056 raeburn 13607: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 13608: my ($count,$datatable) = &get_extracted($docudom,$docuname,
13609: $currdir,\%is_dir,
13610: \%children,\%parent,
1.1056 raeburn 13611: \@contents,\%dirorder,
13612: \%titles,$wantform);
1.1055 raeburn 13613: if ($datatable ne '') {
13614: $output .= &archive_options_form('decompressed',$datatable,
13615: $count,$hiddenelem);
1.1065 raeburn 13616: my $startcount = 6;
1.1055 raeburn 13617: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 13618: \%titles,\%children);
1.1055 raeburn 13619: }
1.1067 raeburn 13620: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 13621: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 13622: my %displayed;
13623: my $total = 1;
13624: $env{'form.archive_directory'} = [];
13625: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
13626: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
13627: $path =~ s{/$}{};
13628: my $item;
13629: if ($path ne '') {
13630: $item = "$path/$titles{$i}";
13631: } else {
13632: $item = $titles{$i};
13633: }
13634: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
13635: if ($item eq $contents[0]) {
13636: push(@{$env{'form.archive_directory'}},$i);
13637: $env{'form.archive_'.$i} = 'display';
13638: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
13639: $displayed{'folder'} = $i;
1.1164 raeburn 13640: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
13641: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 13642: $env{'form.archive_'.$i} = 'display';
13643: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
13644: $displayed{'web'} = $i;
13645: } else {
1.1164 raeburn 13646: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
13647: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
13648: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 13649: push(@{$env{'form.archive_directory'}},$i);
13650: }
13651: $env{'form.archive_'.$i} = 'dependency';
13652: }
13653: $total ++;
13654: }
13655: for (my $i=1; $i<$total; $i++) {
13656: next if ($i == $displayed{'web'});
13657: next if ($i == $displayed{'folder'});
13658: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
13659: }
13660: $env{'form.phase'} = 'decompress_cleanup';
13661: $env{'form.archivedelete'} = 1;
13662: $env{'form.archive_count'} = $total-1;
13663: $output .=
13664: &process_extracted_files('coursedocs',$docudom,
13665: $docuname,$destination,
13666: $dir_root,$hiddenelem);
13667: }
1.1055 raeburn 13668: } else {
13669: $warning = &mt('No new items extracted from archive file.');
13670: }
13671: } else {
13672: $output = $display;
13673: $error = &mt('An error occurred during extraction from the archive file.');
13674: }
13675: }
13676: }
13677: }
13678: if ($error) {
13679: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13680: $error.'</p>'."\n";
13681: }
13682: if ($warning) {
13683: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13684: }
13685: return $output;
13686: }
13687:
13688: sub get_extracted {
1.1056 raeburn 13689: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
13690: $titles,$wantform) = @_;
1.1055 raeburn 13691: my $count = 0;
13692: my $depth = 0;
13693: my $datatable;
1.1056 raeburn 13694: my @hierarchy;
1.1055 raeburn 13695: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 13696: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
13697: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 13698: foreach my $item (@{$contents}) {
13699: $count ++;
1.1056 raeburn 13700: @{$dirorder->{$count}} = @hierarchy;
13701: $titles->{$count} = $item;
1.1055 raeburn 13702: &archive_hierarchy($depth,$count,$parent,$children);
13703: if ($wantform) {
13704: $datatable .= &archive_row($is_dir->{$item},$item,
13705: $currdir,$depth,$count);
13706: }
13707: if ($is_dir->{$item}) {
13708: $depth ++;
1.1056 raeburn 13709: push(@hierarchy,$count);
13710: $parent->{$depth} = $count;
1.1055 raeburn 13711: $datatable .=
13712: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 13713: \$depth,\$count,\@hierarchy,$dirorder,
13714: $children,$parent,$titles,$wantform);
1.1055 raeburn 13715: $depth --;
1.1056 raeburn 13716: pop(@hierarchy);
1.1055 raeburn 13717: }
13718: }
13719: return ($count,$datatable);
13720: }
13721:
13722: sub recurse_extracted_archive {
1.1056 raeburn 13723: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
13724: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 13725: my $result='';
1.1056 raeburn 13726: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
13727: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
13728: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 13729: return $result;
13730: }
13731: my $dirptr = 16384;
13732: my ($newdirlistref,$newlisterror) =
13733: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
13734: if (ref($newdirlistref) eq 'ARRAY') {
13735: foreach my $dir_line (@{$newdirlistref}) {
13736: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
13737: unless ($item =~ /^\.+$/) {
13738: $$count ++;
1.1056 raeburn 13739: @{$dirorder->{$$count}} = @{$hierarchy};
13740: $titles->{$$count} = $item;
1.1055 raeburn 13741: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 13742:
1.1055 raeburn 13743: my $is_dir;
13744: if ($dirptr&$testdir) {
13745: $is_dir = 1;
13746: }
13747: if ($wantform) {
13748: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
13749: }
13750: if ($is_dir) {
13751: $$depth ++;
1.1056 raeburn 13752: push(@{$hierarchy},$$count);
13753: $parent->{$$depth} = $$count;
1.1055 raeburn 13754: $result .=
13755: &recurse_extracted_archive("$currdir/$item",$docudom,
13756: $docuname,$depth,$count,
1.1056 raeburn 13757: $hierarchy,$dirorder,$children,
13758: $parent,$titles,$wantform);
1.1055 raeburn 13759: $$depth --;
1.1056 raeburn 13760: pop(@{$hierarchy});
1.1055 raeburn 13761: }
13762: }
13763: }
13764: }
13765: return $result;
13766: }
13767:
13768: sub archive_hierarchy {
13769: my ($depth,$count,$parent,$children) =@_;
13770: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
13771: if (exists($parent->{$depth})) {
13772: $children->{$parent->{$depth}} .= $count.':';
13773: }
13774: }
13775: return;
13776: }
13777:
13778: sub archive_row {
13779: my ($is_dir,$item,$currdir,$depth,$count) = @_;
13780: my ($name) = ($item =~ m{([^/]+)$});
13781: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 13782: 'display' => 'Add as file',
1.1055 raeburn 13783: 'dependency' => 'Include as dependency',
13784: 'discard' => 'Discard',
13785: );
13786: if ($is_dir) {
1.1059 raeburn 13787: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 13788: }
1.1056 raeburn 13789: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
13790: my $offset = 0;
1.1055 raeburn 13791: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 13792: $offset ++;
1.1065 raeburn 13793: if ($action ne 'display') {
13794: $offset ++;
13795: }
1.1055 raeburn 13796: $output .= '<td><span class="LC_nobreak">'.
13797: '<label><input type="radio" name="archive_'.$count.
13798: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
13799: my $text = $choices{$action};
13800: if ($is_dir) {
13801: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
13802: if ($action eq 'display') {
1.1059 raeburn 13803: $text = &mt('Add as folder');
1.1055 raeburn 13804: }
1.1056 raeburn 13805: } else {
13806: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
13807:
13808: }
13809: $output .= ' /> '.$choices{$action}.'</label></span>';
13810: if ($action eq 'dependency') {
13811: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
13812: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
13813: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
13814: '<option value=""></option>'."\n".
13815: '</select>'."\n".
13816: '</div>';
1.1059 raeburn 13817: } elsif ($action eq 'display') {
13818: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
13819: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
13820: '</div>';
1.1055 raeburn 13821: }
1.1056 raeburn 13822: $output .= '</td>';
1.1055 raeburn 13823: }
13824: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
13825: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
13826: for (my $i=0; $i<$depth; $i++) {
13827: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
13828: }
13829: if ($is_dir) {
13830: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
13831: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
13832: } else {
13833: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
13834: }
13835: $output .= ' '.$name.'</td>'."\n".
13836: &end_data_table_row();
13837: return $output;
13838: }
13839:
13840: sub archive_options_form {
1.1065 raeburn 13841: my ($form,$display,$count,$hiddenelem) = @_;
13842: my %lt = &Apache::lonlocal::texthash(
13843: perm => 'Permanently remove archive file?',
13844: hows => 'How should each extracted item be incorporated in the course?',
13845: cont => 'Content actions for all',
13846: addf => 'Add as folder/file',
13847: incd => 'Include as dependency for a displayed file',
13848: disc => 'Discard',
13849: no => 'No',
13850: yes => 'Yes',
13851: save => 'Save',
13852: );
13853: my $output = <<"END";
13854: <form name="$form" method="post" action="">
13855: <p><span class="LC_nobreak">$lt{'perm'}
13856: <label>
13857: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
13858: </label>
13859:
13860: <label>
13861: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
13862: </span>
13863: </p>
13864: <input type="hidden" name="phase" value="decompress_cleanup" />
13865: <br />$lt{'hows'}
13866: <div class="LC_columnSection">
13867: <fieldset>
13868: <legend>$lt{'cont'}</legend>
13869: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
13870: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
13871: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
13872: </fieldset>
13873: </div>
13874: END
13875: return $output.
1.1055 raeburn 13876: &start_data_table()."\n".
1.1065 raeburn 13877: $display."\n".
1.1055 raeburn 13878: &end_data_table()."\n".
13879: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
13880: $hiddenelem.
1.1065 raeburn 13881: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 13882: '</form>';
13883: }
13884:
13885: sub archive_javascript {
1.1056 raeburn 13886: my ($startcount,$numitems,$titles,$children) = @_;
13887: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 13888: my $maintitle = $env{'form.comment'};
1.1055 raeburn 13889: my $scripttag = <<START;
13890: <script type="text/javascript">
13891: // <![CDATA[
13892:
13893: function checkAll(form,prefix) {
13894: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
13895: for (var i=0; i < form.elements.length; i++) {
13896: var id = form.elements[i].id;
13897: if ((id != '') && (id != undefined)) {
13898: if (idstr.test(id)) {
13899: if (form.elements[i].type == 'radio') {
13900: form.elements[i].checked = true;
1.1056 raeburn 13901: var nostart = i-$startcount;
1.1059 raeburn 13902: var offset = nostart%7;
13903: var count = (nostart-offset)/7;
1.1056 raeburn 13904: dependencyCheck(form,count,offset);
1.1055 raeburn 13905: }
13906: }
13907: }
13908: }
13909: }
13910:
13911: function propagateCheck(form,count) {
13912: if (count > 0) {
1.1059 raeburn 13913: var startelement = $startcount + ((count-1) * 7);
13914: for (var j=1; j<6; j++) {
13915: if ((j != 2) && (j != 4)) {
1.1056 raeburn 13916: var item = startelement + j;
13917: if (form.elements[item].type == 'radio') {
13918: if (form.elements[item].checked) {
13919: containerCheck(form,count,j);
13920: break;
13921: }
1.1055 raeburn 13922: }
13923: }
13924: }
13925: }
13926: }
13927:
13928: numitems = $numitems
1.1056 raeburn 13929: var titles = new Array(numitems);
13930: var parents = new Array(numitems);
1.1055 raeburn 13931: for (var i=0; i<numitems; i++) {
1.1056 raeburn 13932: parents[i] = new Array;
1.1055 raeburn 13933: }
1.1059 raeburn 13934: var maintitle = '$maintitle';
1.1055 raeburn 13935:
13936: START
13937:
1.1056 raeburn 13938: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
13939: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 13940: for (my $i=0; $i<@contents; $i ++) {
13941: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
13942: }
13943: }
13944:
1.1056 raeburn 13945: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
13946: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
13947: }
13948:
1.1055 raeburn 13949: $scripttag .= <<END;
13950:
13951: function containerCheck(form,count,offset) {
13952: if (count > 0) {
1.1056 raeburn 13953: dependencyCheck(form,count,offset);
1.1059 raeburn 13954: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 13955: form.elements[item].checked = true;
13956: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
13957: if (parents[count].length > 0) {
13958: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 13959: containerCheck(form,parents[count][j],offset);
13960: }
13961: }
13962: }
13963: }
13964: }
13965:
13966: function dependencyCheck(form,count,offset) {
13967: if (count > 0) {
1.1059 raeburn 13968: var chosen = (offset+$startcount)+7*(count-1);
13969: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 13970: var currtype = form.elements[depitem].type;
13971: if (form.elements[chosen].value == 'dependency') {
13972: document.getElementById('arc_depon_'+count).style.display='block';
13973: form.elements[depitem].options.length = 0;
13974: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 13975: for (var i=1; i<=numitems; i++) {
13976: if (i == count) {
13977: continue;
13978: }
1.1059 raeburn 13979: var startelement = $startcount + (i-1) * 7;
13980: for (var j=1; j<6; j++) {
13981: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 13982: var item = startelement + j;
13983: if (form.elements[item].type == 'radio') {
13984: if (form.elements[item].checked) {
13985: if (form.elements[item].value == 'display') {
13986: var n = form.elements[depitem].options.length;
13987: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
13988: }
13989: }
13990: }
13991: }
13992: }
13993: }
13994: } else {
13995: document.getElementById('arc_depon_'+count).style.display='none';
13996: form.elements[depitem].options.length = 0;
13997: form.elements[depitem].options[0] = new Option('Select','',true,true);
13998: }
1.1059 raeburn 13999: titleCheck(form,count,offset);
1.1056 raeburn 14000: }
14001: }
14002:
14003: function propagateSelect(form,count,offset) {
14004: if (count > 0) {
1.1065 raeburn 14005: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 14006: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
14007: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14008: if (parents[count].length > 0) {
14009: for (var j=0; j<parents[count].length; j++) {
14010: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 14011: }
14012: }
14013: }
14014: }
14015: }
1.1056 raeburn 14016:
14017: function containerSelect(form,count,offset,picked) {
14018: if (count > 0) {
1.1065 raeburn 14019: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 14020: if (form.elements[item].type == 'radio') {
14021: if (form.elements[item].value == 'dependency') {
14022: if (form.elements[item+1].type == 'select-one') {
14023: for (var i=0; i<form.elements[item+1].options.length; i++) {
14024: if (form.elements[item+1].options[i].value == picked) {
14025: form.elements[item+1].selectedIndex = i;
14026: break;
14027: }
14028: }
14029: }
14030: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14031: if (parents[count].length > 0) {
14032: for (var j=0; j<parents[count].length; j++) {
14033: containerSelect(form,parents[count][j],offset,picked);
14034: }
14035: }
14036: }
14037: }
14038: }
14039: }
14040: }
14041:
1.1059 raeburn 14042: function titleCheck(form,count,offset) {
14043: if (count > 0) {
14044: var chosen = (offset+$startcount)+7*(count-1);
14045: var depitem = $startcount + ((count-1) * 7) + 2;
14046: var currtype = form.elements[depitem].type;
14047: if (form.elements[chosen].value == 'display') {
14048: document.getElementById('arc_title_'+count).style.display='block';
14049: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
14050: document.getElementById('archive_title_'+count).value=maintitle;
14051: }
14052: } else {
14053: document.getElementById('arc_title_'+count).style.display='none';
14054: if (currtype == 'text') {
14055: document.getElementById('archive_title_'+count).value='';
14056: }
14057: }
14058: }
14059: return;
14060: }
14061:
1.1055 raeburn 14062: // ]]>
14063: </script>
14064: END
14065: return $scripttag;
14066: }
14067:
14068: sub process_extracted_files {
1.1067 raeburn 14069: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 14070: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 14071: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 14072: my @ids=&Apache::lonnet::current_machine_ids();
14073: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 14074: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 14075: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14076: if (grep(/^\Q$docuhome\E$/,@ids)) {
14077: $prefix = &LONCAPA::propath($docudom,$docuname);
14078: $pathtocheck = "$dir_root/$destination";
14079: $dir = $dir_root;
14080: $ishome = 1;
14081: } else {
14082: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
14083: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 14084: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 14085: }
14086: my $currdir = "$dir_root/$destination";
14087: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
14088: if ($env{'form.folderpath'}) {
14089: my @items = split('&',$env{'form.folderpath'});
14090: $folders{'0'} = $items[-2];
1.1099 raeburn 14091: if ($env{'form.folderpath'} =~ /\:1$/) {
14092: $containers{'0'}='page';
14093: } else {
14094: $containers{'0'}='sequence';
14095: }
1.1055 raeburn 14096: }
14097: my @archdirs = &get_env_multiple('form.archive_directory');
14098: if ($numitems) {
14099: for (my $i=1; $i<=$numitems; $i++) {
14100: my $path = $env{'form.archive_content_'.$i};
14101: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
14102: my $item = $1;
14103: $toplevelitems{$item} = $i;
14104: if (grep(/^\Q$i\E$/,@archdirs)) {
14105: $is_dir{$item} = 1;
14106: }
14107: }
14108: }
14109: }
1.1067 raeburn 14110: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 14111: if (keys(%toplevelitems) > 0) {
14112: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 14113: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
14114: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 14115: }
1.1066 raeburn 14116: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 14117: if ($numitems) {
14118: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 14119: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 14120: my $path = $env{'form.archive_content_'.$i};
14121: if ($path =~ /^\Q$pathtocheck\E/) {
14122: if ($env{'form.archive_'.$i} eq 'discard') {
14123: if ($prefix ne '' && $path ne '') {
14124: if (-e $prefix.$path) {
1.1066 raeburn 14125: if ((@archdirs > 0) &&
14126: (grep(/^\Q$i\E$/,@archdirs))) {
14127: $todeletedir{$prefix.$path} = 1;
14128: } else {
14129: $todelete{$prefix.$path} = 1;
14130: }
1.1055 raeburn 14131: }
14132: }
14133: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 14134: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 14135: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 14136: $docstitle = $env{'form.archive_title_'.$i};
14137: if ($docstitle eq '') {
14138: $docstitle = $title;
14139: }
1.1055 raeburn 14140: $outer = 0;
1.1056 raeburn 14141: if (ref($dirorder{$i}) eq 'ARRAY') {
14142: if (@{$dirorder{$i}} > 0) {
14143: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 14144: if ($env{'form.archive_'.$item} eq 'display') {
14145: $outer = $item;
14146: last;
14147: }
14148: }
14149: }
14150: }
14151: my ($errtext,$fatal) =
14152: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
14153: '/'.$folders{$outer}.'.'.
14154: $containers{$outer});
14155: next if ($fatal);
14156: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
14157: if ($context eq 'coursedocs') {
1.1056 raeburn 14158: $mapinner{$i} = time;
1.1055 raeburn 14159: $folders{$i} = 'default_'.$mapinner{$i};
14160: $containers{$i} = 'sequence';
14161: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14162: $folders{$i}.'.'.$containers{$i};
14163: my $newidx = &LONCAPA::map::getresidx();
14164: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 14165: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 14166: push(@LONCAPA::map::order,$newidx);
14167: my ($outtext,$errtext) =
14168: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14169: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 14170: '.'.$containers{$outer},1,1);
1.1056 raeburn 14171: $newseqid{$i} = $newidx;
1.1067 raeburn 14172: unless ($errtext) {
1.1294 raeburn 14173: $result .= '<li>'.&mt('Folder: [_1] added to course',
14174: &HTML::Entities::encode($docstitle,'<>&"')).
14175: '</li>'."\n";
1.1067 raeburn 14176: }
1.1055 raeburn 14177: }
14178: } else {
14179: if ($context eq 'coursedocs') {
14180: my $newidx=&LONCAPA::map::getresidx();
14181: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14182: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
14183: $title;
1.1294 raeburn 14184: if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
14185: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
14186: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
14187: }
14188: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14189: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
14190: }
14191: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14192: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
14193: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
14194: unless ($ishome) {
14195: my $fetch = "$newdest{$i}/$title";
14196: $fetch =~ s/^\Q$prefix$dir\E//;
14197: $prompttofetch{$fetch} = 1;
14198: }
1.1292 raeburn 14199: }
1.1067 raeburn 14200: }
1.1294 raeburn 14201: $LONCAPA::map::resources[$newidx]=
14202: $docstitle.':'.$url.':false:normal:res';
14203: push(@LONCAPA::map::order, $newidx);
14204: my ($outtext,$errtext)=
14205: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14206: $docuname.'/'.$folders{$outer}.
14207: '.'.$containers{$outer},1,1);
14208: unless ($errtext) {
14209: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
14210: $result .= '<li>'.&mt('File: [_1] added to course',
14211: &HTML::Entities::encode($docstitle,'<>&"')).
14212: '</li>'."\n";
14213: }
1.1067 raeburn 14214: }
1.1294 raeburn 14215: } else {
14216: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14217: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 14218: }
1.1055 raeburn 14219: }
14220: }
1.1086 raeburn 14221: }
14222: } else {
1.1294 raeburn 14223: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14224: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 14225: }
14226: }
14227: for (my $i=1; $i<=$numitems; $i++) {
14228: next unless ($env{'form.archive_'.$i} eq 'dependency');
14229: my $path = $env{'form.archive_content_'.$i};
14230: if ($path =~ /^\Q$pathtocheck\E/) {
14231: my ($title) = ($path =~ m{/([^/]+)$});
14232: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
14233: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
14234: if (ref($dirorder{$i}) eq 'ARRAY') {
14235: my ($itemidx,$fullpath,$relpath);
14236: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
14237: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 14238: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 14239: if ($dirorder{$i}->[$j] eq $container) {
14240: $itemidx = $j;
1.1056 raeburn 14241: }
14242: }
1.1086 raeburn 14243: }
14244: if ($itemidx eq '') {
14245: $itemidx = 0;
14246: }
14247: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
14248: if ($mapinner{$referrer{$i}}) {
14249: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
14250: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14251: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14252: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14253: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14254: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14255: if (!-e $fullpath) {
14256: mkdir($fullpath,0755);
1.1056 raeburn 14257: }
14258: }
1.1086 raeburn 14259: } else {
14260: last;
1.1056 raeburn 14261: }
1.1086 raeburn 14262: }
14263: }
14264: } elsif ($newdest{$referrer{$i}}) {
14265: $fullpath = $newdest{$referrer{$i}};
14266: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14267: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
14268: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
14269: last;
14270: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14271: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14272: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14273: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14274: if (!-e $fullpath) {
14275: mkdir($fullpath,0755);
1.1056 raeburn 14276: }
14277: }
1.1086 raeburn 14278: } else {
14279: last;
1.1056 raeburn 14280: }
1.1055 raeburn 14281: }
14282: }
1.1086 raeburn 14283: if ($fullpath ne '') {
14284: if (-e "$prefix$path") {
1.1292 raeburn 14285: unless (rename("$prefix$path","$fullpath/$title")) {
14286: $warning .= &mt('Failed to rename dependency').'<br />';
14287: }
1.1086 raeburn 14288: }
14289: if (-e "$fullpath/$title") {
14290: my $showpath;
14291: if ($relpath ne '') {
14292: $showpath = "$relpath/$title";
14293: } else {
14294: $showpath = "/$title";
14295: }
1.1294 raeburn 14296: $result .= '<li>'.&mt('[_1] included as a dependency',
14297: &HTML::Entities::encode($showpath,'<>&"')).
14298: '</li>'."\n";
1.1292 raeburn 14299: unless ($ishome) {
14300: my $fetch = "$fullpath/$title";
14301: $fetch =~ s/^\Q$prefix$dir\E//;
14302: $prompttofetch{$fetch} = 1;
14303: }
1.1086 raeburn 14304: }
14305: }
1.1055 raeburn 14306: }
1.1086 raeburn 14307: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
14308: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 14309: &HTML::Entities::encode($path,'<>&"'),
14310: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
14311: '<br />';
1.1055 raeburn 14312: }
14313: } else {
1.1294 raeburn 14314: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 14315: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 14316: }
14317: }
14318: if (keys(%todelete)) {
14319: foreach my $key (keys(%todelete)) {
14320: unlink($key);
1.1066 raeburn 14321: }
14322: }
14323: if (keys(%todeletedir)) {
14324: foreach my $key (keys(%todeletedir)) {
14325: rmdir($key);
14326: }
14327: }
14328: foreach my $dir (sort(keys(%is_dir))) {
14329: if (($pathtocheck ne '') && ($dir ne '')) {
14330: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 14331: }
14332: }
1.1067 raeburn 14333: if ($result ne '') {
14334: $output .= '<ul>'."\n".
14335: $result."\n".
14336: '</ul>';
14337: }
14338: unless ($ishome) {
14339: my $replicationfail;
14340: foreach my $item (keys(%prompttofetch)) {
14341: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
14342: unless ($fetchresult eq 'ok') {
14343: $replicationfail .= '<li>'.$item.'</li>'."\n";
14344: }
14345: }
14346: if ($replicationfail) {
14347: $output .= '<p class="LC_error">'.
14348: &mt('Course home server failed to retrieve:').'<ul>'.
14349: $replicationfail.
14350: '</ul></p>';
14351: }
14352: }
1.1055 raeburn 14353: } else {
14354: $warning = &mt('No items found in archive.');
14355: }
14356: if ($error) {
14357: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14358: $error.'</p>'."\n";
14359: }
14360: if ($warning) {
14361: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14362: }
14363: return $output;
14364: }
14365:
1.1066 raeburn 14366: sub cleanup_empty_dirs {
14367: my ($path) = @_;
14368: if (($path ne '') && (-d $path)) {
14369: if (opendir(my $dirh,$path)) {
14370: my @dircontents = grep(!/^\./,readdir($dirh));
14371: my $numitems = 0;
14372: foreach my $item (@dircontents) {
14373: if (-d "$path/$item") {
1.1111 raeburn 14374: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 14375: if (-e "$path/$item") {
14376: $numitems ++;
14377: }
14378: } else {
14379: $numitems ++;
14380: }
14381: }
14382: if ($numitems == 0) {
14383: rmdir($path);
14384: }
14385: closedir($dirh);
14386: }
14387: }
14388: return;
14389: }
14390:
1.41 ng 14391: =pod
1.45 matthew 14392:
1.1162 raeburn 14393: =item * &get_folder_hierarchy()
1.1068 raeburn 14394:
14395: Provides hierarchy of names of folders/sub-folders containing the current
14396: item,
14397:
14398: Inputs: 3
14399: - $navmap - navmaps object
14400:
14401: - $map - url for map (either the trigger itself, or map containing
14402: the resource, which is the trigger).
14403:
14404: - $showitem - 1 => show title for map itself; 0 => do not show.
14405:
14406: Outputs: 1 @pathitems - array of folder/subfolder names.
14407:
14408: =cut
14409:
14410: sub get_folder_hierarchy {
14411: my ($navmap,$map,$showitem) = @_;
14412: my @pathitems;
14413: if (ref($navmap)) {
14414: my $mapres = $navmap->getResourceByUrl($map);
14415: if (ref($mapres)) {
14416: my $pcslist = $mapres->map_hierarchy();
14417: if ($pcslist ne '') {
14418: my @pcs = split(/,/,$pcslist);
14419: foreach my $pc (@pcs) {
14420: if ($pc == 1) {
1.1129 raeburn 14421: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 14422: } else {
14423: my $res = $navmap->getByMapPc($pc);
14424: if (ref($res)) {
14425: my $title = $res->compTitle();
14426: $title =~ s/\W+/_/g;
14427: if ($title ne '') {
14428: push(@pathitems,$title);
14429: }
14430: }
14431: }
14432: }
14433: }
1.1071 raeburn 14434: if ($showitem) {
14435: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 14436: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 14437: } else {
14438: my $maptitle = $mapres->compTitle();
14439: $maptitle =~ s/\W+/_/g;
14440: if ($maptitle ne '') {
14441: push(@pathitems,$maptitle);
14442: }
1.1068 raeburn 14443: }
14444: }
14445: }
14446: }
14447: return @pathitems;
14448: }
14449:
14450: =pod
14451:
1.1015 raeburn 14452: =item * &get_turnedin_filepath()
14453:
14454: Determines path in a user's portfolio file for storage of files uploaded
14455: to a specific essayresponse or dropbox item.
14456:
14457: Inputs: 3 required + 1 optional.
14458: $symb is symb for resource, $uname and $udom are for current user (required).
14459: $caller is optional (can be "submission", if routine is called when storing
14460: an upoaded file when "Submit Answer" button was pressed).
14461:
14462: Returns array containing $path and $multiresp.
14463: $path is path in portfolio. $multiresp is 1 if this resource contains more
14464: than one file upload item. Callers of routine should append partid as a
14465: subdirectory to $path in cases where $multiresp is 1.
14466:
14467: Called by: homework/essayresponse.pm and homework/structuretags.pm
14468:
14469: =cut
14470:
14471: sub get_turnedin_filepath {
14472: my ($symb,$uname,$udom,$caller) = @_;
14473: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
14474: my $turnindir;
14475: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
14476: $turnindir = $userhash{'turnindir'};
14477: my ($path,$multiresp);
14478: if ($turnindir eq '') {
14479: if ($caller eq 'submission') {
14480: $turnindir = &mt('turned in');
14481: $turnindir =~ s/\W+/_/g;
14482: my %newhash = (
14483: 'turnindir' => $turnindir,
14484: );
14485: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
14486: }
14487: }
14488: if ($turnindir ne '') {
14489: $path = '/'.$turnindir.'/';
14490: my ($multipart,$turnin,@pathitems);
14491: my $navmap = Apache::lonnavmaps::navmap->new();
14492: if (defined($navmap)) {
14493: my $mapres = $navmap->getResourceByUrl($map);
14494: if (ref($mapres)) {
14495: my $pcslist = $mapres->map_hierarchy();
14496: if ($pcslist ne '') {
14497: foreach my $pc (split(/,/,$pcslist)) {
14498: my $res = $navmap->getByMapPc($pc);
14499: if (ref($res)) {
14500: my $title = $res->compTitle();
14501: $title =~ s/\W+/_/g;
14502: if ($title ne '') {
1.1149 raeburn 14503: if (($pc > 1) && (length($title) > 12)) {
14504: $title = substr($title,0,12);
14505: }
1.1015 raeburn 14506: push(@pathitems,$title);
14507: }
14508: }
14509: }
14510: }
14511: my $maptitle = $mapres->compTitle();
14512: $maptitle =~ s/\W+/_/g;
14513: if ($maptitle ne '') {
1.1149 raeburn 14514: if (length($maptitle) > 12) {
14515: $maptitle = substr($maptitle,0,12);
14516: }
1.1015 raeburn 14517: push(@pathitems,$maptitle);
14518: }
14519: unless ($env{'request.state'} eq 'construct') {
14520: my $res = $navmap->getBySymb($symb);
14521: if (ref($res)) {
14522: my $partlist = $res->parts();
14523: my $totaluploads = 0;
14524: if (ref($partlist) eq 'ARRAY') {
14525: foreach my $part (@{$partlist}) {
14526: my @types = $res->responseType($part);
14527: my @ids = $res->responseIds($part);
14528: for (my $i=0; $i < scalar(@ids); $i++) {
14529: if ($types[$i] eq 'essay') {
14530: my $partid = $part.'_'.$ids[$i];
14531: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
14532: $totaluploads ++;
14533: }
14534: }
14535: }
14536: }
14537: if ($totaluploads > 1) {
14538: $multiresp = 1;
14539: }
14540: }
14541: }
14542: }
14543: } else {
14544: return;
14545: }
14546: } else {
14547: return;
14548: }
14549: my $restitle=&Apache::lonnet::gettitle($symb);
14550: $restitle =~ s/\W+/_/g;
14551: if ($restitle eq '') {
14552: $restitle = ($resurl =~ m{/[^/]+$});
14553: if ($restitle eq '') {
14554: $restitle = time;
14555: }
14556: }
1.1149 raeburn 14557: if (length($restitle) > 12) {
14558: $restitle = substr($restitle,0,12);
14559: }
1.1015 raeburn 14560: push(@pathitems,$restitle);
14561: $path .= join('/',@pathitems);
14562: }
14563: return ($path,$multiresp);
14564: }
14565:
14566: =pod
14567:
1.464 albertel 14568: =back
1.41 ng 14569:
1.112 bowersj2 14570: =head1 CSV Upload/Handling functions
1.38 albertel 14571:
1.41 ng 14572: =over 4
14573:
1.648 raeburn 14574: =item * &upfile_store($r)
1.41 ng 14575:
14576: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 14577: needs $env{'form.upfile'}
1.41 ng 14578: returns $datatoken to be put into hidden field
14579:
14580: =cut
1.31 albertel 14581:
14582: sub upfile_store {
14583: my $r=shift;
1.258 albertel 14584: $env{'form.upfile'}=~s/\r/\n/gs;
14585: $env{'form.upfile'}=~s/\f/\n/gs;
14586: $env{'form.upfile'}=~s/\n+/\n/gs;
14587: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 14588:
1.1299 raeburn 14589: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
14590: '_enroll_'.$env{'request.course.id'}.'_'.
14591: time.'_'.$$);
14592: return if ($datatoken eq '');
14593:
1.31 albertel 14594: {
1.158 raeburn 14595: my $datafile = $r->dir_config('lonDaemons').
14596: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 14597: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 14598: print $fh $env{'form.upfile'};
1.158 raeburn 14599: close($fh);
14600: }
1.31 albertel 14601: }
14602: return $datatoken;
14603: }
14604:
1.56 matthew 14605: =pod
14606:
1.1290 raeburn 14607: =item * &load_tmp_file($r,$datatoken)
1.41 ng 14608:
14609: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 14610: $datatoken is the name to assign to the temporary file.
1.258 albertel 14611: sets $env{'form.upfile'} to the contents of the file
1.41 ng 14612:
14613: =cut
1.31 albertel 14614:
14615: sub load_tmp_file {
1.1290 raeburn 14616: my ($r,$datatoken) = @_;
14617: return if ($datatoken eq '');
1.31 albertel 14618: my @studentdata=();
14619: {
1.158 raeburn 14620: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 14621: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 14622: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 14623: @studentdata=<$fh>;
14624: close($fh);
14625: }
1.31 albertel 14626: }
1.258 albertel 14627: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 14628: }
14629:
1.1290 raeburn 14630: sub valid_datatoken {
14631: my ($datatoken) = @_;
1.1325 raeburn 14632: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290 raeburn 14633: return $datatoken;
14634: }
14635: return;
14636: }
14637:
1.56 matthew 14638: =pod
14639:
1.648 raeburn 14640: =item * &upfile_record_sep()
1.41 ng 14641:
14642: Separate uploaded file into records
14643: returns array of records,
1.258 albertel 14644: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 14645:
14646: =cut
1.31 albertel 14647:
14648: sub upfile_record_sep {
1.258 albertel 14649: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 14650: } else {
1.248 albertel 14651: my @records;
1.258 albertel 14652: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 14653: if ($line=~/^\s*$/) { next; }
14654: push(@records,$line);
14655: }
14656: return @records;
1.31 albertel 14657: }
14658: }
14659:
1.56 matthew 14660: =pod
14661:
1.648 raeburn 14662: =item * &record_sep($record)
1.41 ng 14663:
1.258 albertel 14664: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 14665:
14666: =cut
14667:
1.263 www 14668: sub takeleft {
14669: my $index=shift;
14670: return substr('0000'.$index,-4,4);
14671: }
14672:
1.31 albertel 14673: sub record_sep {
14674: my $record=shift;
14675: my %components=();
1.258 albertel 14676: if ($env{'form.upfiletype'} eq 'xml') {
14677: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 14678: my $i=0;
1.356 albertel 14679: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 14680: $field=~s/^(\"|\')//;
14681: $field=~s/(\"|\')$//;
1.263 www 14682: $components{&takeleft($i)}=$field;
1.31 albertel 14683: $i++;
14684: }
1.258 albertel 14685: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 14686: my $i=0;
1.356 albertel 14687: foreach my $field (split(/\t/,$record)) {
1.31 albertel 14688: $field=~s/^(\"|\')//;
14689: $field=~s/(\"|\')$//;
1.263 www 14690: $components{&takeleft($i)}=$field;
1.31 albertel 14691: $i++;
14692: }
14693: } else {
1.561 www 14694: my $separator=',';
1.480 banghart 14695: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 14696: $separator=';';
1.480 banghart 14697: }
1.31 albertel 14698: my $i=0;
1.561 www 14699: # the character we are looking for to indicate the end of a quote or a record
14700: my $looking_for=$separator;
14701: # do not add the characters to the fields
14702: my $ignore=0;
14703: # we just encountered a separator (or the beginning of the record)
14704: my $just_found_separator=1;
14705: # store the field we are working on here
14706: my $field='';
14707: # work our way through all characters in record
14708: foreach my $character ($record=~/(.)/g) {
14709: if ($character eq $looking_for) {
14710: if ($character ne $separator) {
14711: # Found the end of a quote, again looking for separator
14712: $looking_for=$separator;
14713: $ignore=1;
14714: } else {
14715: # Found a separator, store away what we got
14716: $components{&takeleft($i)}=$field;
14717: $i++;
14718: $just_found_separator=1;
14719: $ignore=0;
14720: $field='';
14721: }
14722: next;
14723: }
14724: # single or double quotation marks after a separator indicate beginning of a quote
14725: # we are now looking for the end of the quote and need to ignore separators
14726: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
14727: $looking_for=$character;
14728: next;
14729: }
14730: # ignore would be true after we reached the end of a quote
14731: if ($ignore) { next; }
14732: if (($just_found_separator) && ($character=~/\s/)) { next; }
14733: $field.=$character;
14734: $just_found_separator=0;
1.31 albertel 14735: }
1.561 www 14736: # catch the very last entry, since we never encountered the separator
14737: $components{&takeleft($i)}=$field;
1.31 albertel 14738: }
14739: return %components;
14740: }
14741:
1.144 matthew 14742: ######################################################
14743: ######################################################
14744:
1.56 matthew 14745: =pod
14746:
1.648 raeburn 14747: =item * &upfile_select_html()
1.41 ng 14748:
1.144 matthew 14749: Return HTML code to select a file from the users machine and specify
14750: the file type.
1.41 ng 14751:
14752: =cut
14753:
1.144 matthew 14754: ######################################################
14755: ######################################################
1.31 albertel 14756: sub upfile_select_html {
1.144 matthew 14757: my %Types = (
14758: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 14759: semisv => &mt('Semicolon separated values'),
1.144 matthew 14760: space => &mt('Space separated'),
14761: tab => &mt('Tabulator separated'),
14762: # xml => &mt('HTML/XML'),
14763: );
14764: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 14765: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 14766: foreach my $type (sort(keys(%Types))) {
14767: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
14768: }
14769: $Str .= "</select>\n";
14770: return $Str;
1.31 albertel 14771: }
14772:
1.301 albertel 14773: sub get_samples {
14774: my ($records,$toget) = @_;
14775: my @samples=({});
14776: my $got=0;
14777: foreach my $rec (@$records) {
14778: my %temp = &record_sep($rec);
14779: if (! grep(/\S/, values(%temp))) { next; }
14780: if (%temp) {
14781: $samples[$got]=\%temp;
14782: $got++;
14783: if ($got == $toget) { last; }
14784: }
14785: }
14786: return \@samples;
14787: }
14788:
1.144 matthew 14789: ######################################################
14790: ######################################################
14791:
1.56 matthew 14792: =pod
14793:
1.648 raeburn 14794: =item * &csv_print_samples($r,$records)
1.41 ng 14795:
14796: Prints a table of sample values from each column uploaded $r is an
14797: Apache Request ref, $records is an arrayref from
14798: &Apache::loncommon::upfile_record_sep
14799:
14800: =cut
14801:
1.144 matthew 14802: ######################################################
14803: ######################################################
1.31 albertel 14804: sub csv_print_samples {
14805: my ($r,$records) = @_;
1.662 bisitz 14806: my $samples = &get_samples($records,5);
1.301 albertel 14807:
1.594 raeburn 14808: $r->print(&mt('Samples').'<br />'.&start_data_table().
14809: &start_data_table_header_row());
1.356 albertel 14810: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 14811: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 14812: $r->print(&end_data_table_header_row());
1.301 albertel 14813: foreach my $hash (@$samples) {
1.594 raeburn 14814: $r->print(&start_data_table_row());
1.356 albertel 14815: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 14816: $r->print('<td>');
1.356 albertel 14817: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 14818: $r->print('</td>');
14819: }
1.594 raeburn 14820: $r->print(&end_data_table_row());
1.31 albertel 14821: }
1.594 raeburn 14822: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 14823: }
14824:
1.144 matthew 14825: ######################################################
14826: ######################################################
14827:
1.56 matthew 14828: =pod
14829:
1.648 raeburn 14830: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 14831:
14832: Prints a table to create associations between values and table columns.
1.144 matthew 14833:
1.41 ng 14834: $r is an Apache Request ref,
14835: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 14836: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 14837:
14838: =cut
14839:
1.144 matthew 14840: ######################################################
14841: ######################################################
1.31 albertel 14842: sub csv_print_select_table {
14843: my ($r,$records,$d) = @_;
1.301 albertel 14844: my $i=0;
14845: my $samples = &get_samples($records,1);
1.144 matthew 14846: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 14847: &start_data_table().&start_data_table_header_row().
1.144 matthew 14848: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 14849: '<th>'.&mt('Column').'</th>'.
14850: &end_data_table_header_row()."\n");
1.356 albertel 14851: foreach my $array_ref (@$d) {
14852: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 14853: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 14854:
1.875 bisitz 14855: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 14856: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 14857: $r->print('<option value="none"></option>');
1.356 albertel 14858: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
14859: $r->print('<option value="'.$sample.'"'.
14860: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 14861: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 14862: }
1.594 raeburn 14863: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 14864: $i++;
14865: }
1.594 raeburn 14866: $r->print(&end_data_table());
1.31 albertel 14867: $i--;
14868: return $i;
14869: }
1.56 matthew 14870:
1.144 matthew 14871: ######################################################
14872: ######################################################
14873:
1.56 matthew 14874: =pod
1.31 albertel 14875:
1.648 raeburn 14876: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 14877:
14878: Prints a table of sample values from the upload and can make associate samples to internal names.
14879:
14880: $r is an Apache Request ref,
14881: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
14882: $d is an array of 2 element arrays (internal name, displayed name)
14883:
14884: =cut
14885:
1.144 matthew 14886: ######################################################
14887: ######################################################
1.31 albertel 14888: sub csv_samples_select_table {
14889: my ($r,$records,$d) = @_;
14890: my $i=0;
1.144 matthew 14891: #
1.662 bisitz 14892: my $max_samples = 5;
14893: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 14894: $r->print(&start_data_table().
14895: &start_data_table_header_row().'<th>'.
14896: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
14897: &end_data_table_header_row());
1.301 albertel 14898:
14899: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 14900: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 14901: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 14902: foreach my $option (@$d) {
14903: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 14904: $r->print('<option value="'.$value.'"'.
1.253 albertel 14905: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 14906: $display.'</option>');
1.31 albertel 14907: }
14908: $r->print('</select></td><td>');
1.662 bisitz 14909: foreach my $line (0..($max_samples-1)) {
1.301 albertel 14910: if (defined($samples->[$line]{$key})) {
14911: $r->print($samples->[$line]{$key}."<br />\n");
14912: }
14913: }
1.594 raeburn 14914: $r->print('</td>'.&end_data_table_row());
1.31 albertel 14915: $i++;
14916: }
1.594 raeburn 14917: $r->print(&end_data_table());
1.31 albertel 14918: $i--;
14919: return($i);
1.115 matthew 14920: }
14921:
1.144 matthew 14922: ######################################################
14923: ######################################################
14924:
1.115 matthew 14925: =pod
14926:
1.648 raeburn 14927: =item * &clean_excel_name($name)
1.115 matthew 14928:
14929: Returns a replacement for $name which does not contain any illegal characters.
14930:
14931: =cut
14932:
1.144 matthew 14933: ######################################################
14934: ######################################################
1.115 matthew 14935: sub clean_excel_name {
14936: my ($name) = @_;
14937: $name =~ s/[:\*\?\/\\]//g;
14938: if (length($name) > 31) {
14939: $name = substr($name,0,31);
14940: }
14941: return $name;
1.25 albertel 14942: }
1.84 albertel 14943:
1.85 albertel 14944: =pod
14945:
1.648 raeburn 14946: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 14947:
14948: Returns either 1 or undef
14949:
14950: 1 if the part is to be hidden, undef if it is to be shown
14951:
14952: Arguments are:
14953:
14954: $id the id of the part to be checked
14955: $symb, optional the symb of the resource to check
14956: $udom, optional the domain of the user to check for
14957: $uname, optional the username of the user to check for
14958:
14959: =cut
1.84 albertel 14960:
14961: sub check_if_partid_hidden {
14962: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 14963: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 14964: $symb,$udom,$uname);
1.141 albertel 14965: my $truth=1;
14966: #if the string starts with !, then the list is the list to show not hide
14967: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 14968: my @hiddenlist=split(/,/,$hiddenparts);
14969: foreach my $checkid (@hiddenlist) {
1.141 albertel 14970: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 14971: }
1.141 albertel 14972: return !$truth;
1.84 albertel 14973: }
1.127 matthew 14974:
1.138 matthew 14975:
14976: ############################################################
14977: ############################################################
14978:
14979: =pod
14980:
1.157 matthew 14981: =back
14982:
1.138 matthew 14983: =head1 cgi-bin script and graphing routines
14984:
1.157 matthew 14985: =over 4
14986:
1.648 raeburn 14987: =item * &get_cgi_id()
1.138 matthew 14988:
14989: Inputs: none
14990:
14991: Returns an id which can be used to pass environment variables
14992: to various cgi-bin scripts. These environment variables will
14993: be removed from the users environment after a given time by
14994: the routine &Apache::lonnet::transfer_profile_to_env.
14995:
14996: =cut
14997:
14998: ############################################################
14999: ############################################################
1.152 albertel 15000: my $uniq=0;
1.136 matthew 15001: sub get_cgi_id {
1.154 albertel 15002: $uniq=($uniq+1)%100000;
1.280 albertel 15003: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 15004: }
15005:
1.127 matthew 15006: ############################################################
15007: ############################################################
15008:
15009: =pod
15010:
1.648 raeburn 15011: =item * &DrawBarGraph()
1.127 matthew 15012:
1.138 matthew 15013: Facilitates the plotting of data in a (stacked) bar graph.
15014: Puts plot definition data into the users environment in order for
15015: graph.png to plot it. Returns an <img> tag for the plot.
15016: The bars on the plot are labeled '1','2',...,'n'.
15017:
15018: Inputs:
15019:
15020: =over 4
15021:
15022: =item $Title: string, the title of the plot
15023:
15024: =item $xlabel: string, text describing the X-axis of the plot
15025:
15026: =item $ylabel: string, text describing the Y-axis of the plot
15027:
15028: =item $Max: scalar, the maximum Y value to use in the plot
15029: If $Max is < any data point, the graph will not be rendered.
15030:
1.140 matthew 15031: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 15032: they are plotted. If undefined, default values will be used.
15033:
1.178 matthew 15034: =item $labels: array ref holding the labels to use on the x-axis for the bars.
15035:
1.138 matthew 15036: =item @Values: An array of array references. Each array reference holds data
15037: to be plotted in a stacked bar chart.
15038:
1.239 matthew 15039: =item If the final element of @Values is a hash reference the key/value
15040: pairs will be added to the graph definition.
15041:
1.138 matthew 15042: =back
15043:
15044: Returns:
15045:
15046: An <img> tag which references graph.png and the appropriate identifying
15047: information for the plot.
15048:
1.127 matthew 15049: =cut
15050:
15051: ############################################################
15052: ############################################################
1.134 matthew 15053: sub DrawBarGraph {
1.178 matthew 15054: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 15055: #
15056: if (! defined($colors)) {
15057: $colors = ['#33ff00',
15058: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
15059: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
15060: ];
15061: }
1.228 matthew 15062: my $extra_settings = {};
15063: if (ref($Values[-1]) eq 'HASH') {
15064: $extra_settings = pop(@Values);
15065: }
1.127 matthew 15066: #
1.136 matthew 15067: my $identifier = &get_cgi_id();
15068: my $id = 'cgi.'.$identifier;
1.129 matthew 15069: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 15070: return '';
15071: }
1.225 matthew 15072: #
15073: my @Labels;
15074: if (defined($labels)) {
15075: @Labels = @$labels;
15076: } else {
15077: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 15078: push(@Labels,$i+1);
1.225 matthew 15079: }
15080: }
15081: #
1.129 matthew 15082: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 15083: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 15084: my %ValuesHash;
15085: my $NumSets=1;
15086: foreach my $array (@Values) {
15087: next if (! ref($array));
1.136 matthew 15088: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 15089: join(',',@$array);
1.129 matthew 15090: }
1.127 matthew 15091: #
1.136 matthew 15092: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 15093: if ($NumBars < 3) {
15094: $width = 120+$NumBars*32;
1.220 matthew 15095: $xskip = 1;
1.225 matthew 15096: $bar_width = 30;
15097: } elsif ($NumBars < 5) {
15098: $width = 120+$NumBars*20;
15099: $xskip = 1;
15100: $bar_width = 20;
1.220 matthew 15101: } elsif ($NumBars < 10) {
1.136 matthew 15102: $width = 120+$NumBars*15;
15103: $xskip = 1;
15104: $bar_width = 15;
15105: } elsif ($NumBars <= 25) {
15106: $width = 120+$NumBars*11;
15107: $xskip = 5;
15108: $bar_width = 8;
15109: } elsif ($NumBars <= 50) {
15110: $width = 120+$NumBars*8;
15111: $xskip = 5;
15112: $bar_width = 4;
15113: } else {
15114: $width = 120+$NumBars*8;
15115: $xskip = 5;
15116: $bar_width = 4;
15117: }
15118: #
1.137 matthew 15119: $Max = 1 if ($Max < 1);
15120: if ( int($Max) < $Max ) {
15121: $Max++;
15122: $Max = int($Max);
15123: }
1.127 matthew 15124: $Title = '' if (! defined($Title));
15125: $xlabel = '' if (! defined($xlabel));
15126: $ylabel = '' if (! defined($ylabel));
1.369 www 15127: $ValuesHash{$id.'.title'} = &escape($Title);
15128: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
15129: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 15130: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 15131: $ValuesHash{$id.'.NumBars'} = $NumBars;
15132: $ValuesHash{$id.'.NumSets'} = $NumSets;
15133: $ValuesHash{$id.'.PlotType'} = 'bar';
15134: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15135: $ValuesHash{$id.'.height'} = $height;
15136: $ValuesHash{$id.'.width'} = $width;
15137: $ValuesHash{$id.'.xskip'} = $xskip;
15138: $ValuesHash{$id.'.bar_width'} = $bar_width;
15139: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 15140: #
1.228 matthew 15141: # Deal with other parameters
15142: while (my ($key,$value) = each(%$extra_settings)) {
15143: $ValuesHash{$id.'.'.$key} = $value;
15144: }
15145: #
1.646 raeburn 15146: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 15147: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15148: }
15149:
15150: ############################################################
15151: ############################################################
15152:
15153: =pod
15154:
1.648 raeburn 15155: =item * &DrawXYGraph()
1.137 matthew 15156:
1.138 matthew 15157: Facilitates the plotting of data in an XY graph.
15158: Puts plot definition data into the users environment in order for
15159: graph.png to plot it. Returns an <img> tag for the plot.
15160:
15161: Inputs:
15162:
15163: =over 4
15164:
15165: =item $Title: string, the title of the plot
15166:
15167: =item $xlabel: string, text describing the X-axis of the plot
15168:
15169: =item $ylabel: string, text describing the Y-axis of the plot
15170:
15171: =item $Max: scalar, the maximum Y value to use in the plot
15172: If $Max is < any data point, the graph will not be rendered.
15173:
15174: =item $colors: Array ref containing the hex color codes for the data to be
15175: plotted in. If undefined, default values will be used.
15176:
15177: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15178:
15179: =item $Ydata: Array ref containing Array refs.
1.185 www 15180: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 15181:
15182: =item %Values: hash indicating or overriding any default values which are
15183: passed to graph.png.
15184: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15185:
15186: =back
15187:
15188: Returns:
15189:
15190: An <img> tag which references graph.png and the appropriate identifying
15191: information for the plot.
15192:
1.137 matthew 15193: =cut
15194:
15195: ############################################################
15196: ############################################################
15197: sub DrawXYGraph {
15198: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
15199: #
15200: # Create the identifier for the graph
15201: my $identifier = &get_cgi_id();
15202: my $id = 'cgi.'.$identifier;
15203: #
15204: $Title = '' if (! defined($Title));
15205: $xlabel = '' if (! defined($xlabel));
15206: $ylabel = '' if (! defined($ylabel));
15207: my %ValuesHash =
15208: (
1.369 www 15209: $id.'.title' => &escape($Title),
15210: $id.'.xlabel' => &escape($xlabel),
15211: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 15212: $id.'.y_max_value'=> $Max,
15213: $id.'.labels' => join(',',@$Xlabels),
15214: $id.'.PlotType' => 'XY',
15215: );
15216: #
15217: if (defined($colors) && ref($colors) eq 'ARRAY') {
15218: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15219: }
15220: #
15221: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
15222: return '';
15223: }
15224: my $NumSets=1;
1.138 matthew 15225: foreach my $array (@{$Ydata}){
1.137 matthew 15226: next if (! ref($array));
15227: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
15228: }
1.138 matthew 15229: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 15230: #
15231: # Deal with other parameters
15232: while (my ($key,$value) = each(%Values)) {
15233: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 15234: }
15235: #
1.646 raeburn 15236: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 15237: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15238: }
15239:
15240: ############################################################
15241: ############################################################
15242:
15243: =pod
15244:
1.648 raeburn 15245: =item * &DrawXYYGraph()
1.138 matthew 15246:
15247: Facilitates the plotting of data in an XY graph with two Y axes.
15248: Puts plot definition data into the users environment in order for
15249: graph.png to plot it. Returns an <img> tag for the plot.
15250:
15251: Inputs:
15252:
15253: =over 4
15254:
15255: =item $Title: string, the title of the plot
15256:
15257: =item $xlabel: string, text describing the X-axis of the plot
15258:
15259: =item $ylabel: string, text describing the Y-axis of the plot
15260:
15261: =item $colors: Array ref containing the hex color codes for the data to be
15262: plotted in. If undefined, default values will be used.
15263:
15264: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15265:
15266: =item $Ydata1: The first data set
15267:
15268: =item $Min1: The minimum value of the left Y-axis
15269:
15270: =item $Max1: The maximum value of the left Y-axis
15271:
15272: =item $Ydata2: The second data set
15273:
15274: =item $Min2: The minimum value of the right Y-axis
15275:
15276: =item $Max2: The maximum value of the left Y-axis
15277:
15278: =item %Values: hash indicating or overriding any default values which are
15279: passed to graph.png.
15280: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15281:
15282: =back
15283:
15284: Returns:
15285:
15286: An <img> tag which references graph.png and the appropriate identifying
15287: information for the plot.
1.136 matthew 15288:
15289: =cut
15290:
15291: ############################################################
15292: ############################################################
1.137 matthew 15293: sub DrawXYYGraph {
15294: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
15295: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 15296: #
15297: # Create the identifier for the graph
15298: my $identifier = &get_cgi_id();
15299: my $id = 'cgi.'.$identifier;
15300: #
15301: $Title = '' if (! defined($Title));
15302: $xlabel = '' if (! defined($xlabel));
15303: $ylabel = '' if (! defined($ylabel));
15304: my %ValuesHash =
15305: (
1.369 www 15306: $id.'.title' => &escape($Title),
15307: $id.'.xlabel' => &escape($xlabel),
15308: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 15309: $id.'.labels' => join(',',@$Xlabels),
15310: $id.'.PlotType' => 'XY',
15311: $id.'.NumSets' => 2,
1.137 matthew 15312: $id.'.two_axes' => 1,
15313: $id.'.y1_max_value' => $Max1,
15314: $id.'.y1_min_value' => $Min1,
15315: $id.'.y2_max_value' => $Max2,
15316: $id.'.y2_min_value' => $Min2,
1.136 matthew 15317: );
15318: #
1.137 matthew 15319: if (defined($colors) && ref($colors) eq 'ARRAY') {
15320: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15321: }
15322: #
15323: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
15324: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 15325: return '';
15326: }
15327: my $NumSets=1;
1.137 matthew 15328: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 15329: next if (! ref($array));
15330: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 15331: }
15332: #
15333: # Deal with other parameters
15334: while (my ($key,$value) = each(%Values)) {
15335: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 15336: }
15337: #
1.646 raeburn 15338: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 15339: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 15340: }
15341:
15342: ############################################################
15343: ############################################################
15344:
15345: =pod
15346:
1.157 matthew 15347: =back
15348:
1.139 matthew 15349: =head1 Statistics helper routines?
15350:
15351: Bad place for them but what the hell.
15352:
1.157 matthew 15353: =over 4
15354:
1.648 raeburn 15355: =item * &chartlink()
1.139 matthew 15356:
15357: Returns a link to the chart for a specific student.
15358:
15359: Inputs:
15360:
15361: =over 4
15362:
15363: =item $linktext: The text of the link
15364:
15365: =item $sname: The students username
15366:
15367: =item $sdomain: The students domain
15368:
15369: =back
15370:
1.157 matthew 15371: =back
15372:
1.139 matthew 15373: =cut
15374:
15375: ############################################################
15376: ############################################################
15377: sub chartlink {
15378: my ($linktext, $sname, $sdomain) = @_;
15379: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 15380: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 15381: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 15382: '">'.$linktext.'</a>';
1.153 matthew 15383: }
15384:
15385: #######################################################
15386: #######################################################
15387:
15388: =pod
15389:
15390: =head1 Course Environment Routines
1.157 matthew 15391:
15392: =over 4
1.153 matthew 15393:
1.648 raeburn 15394: =item * &restore_course_settings()
1.153 matthew 15395:
1.648 raeburn 15396: =item * &store_course_settings()
1.153 matthew 15397:
15398: Restores/Store indicated form parameters from the course environment.
15399: Will not overwrite existing values of the form parameters.
15400:
15401: Inputs:
15402: a scalar describing the data (e.g. 'chart', 'problem_analysis')
15403:
15404: a hash ref describing the data to be stored. For example:
15405:
15406: %Save_Parameters = ('Status' => 'scalar',
15407: 'chartoutputmode' => 'scalar',
15408: 'chartoutputdata' => 'scalar',
15409: 'Section' => 'array',
1.373 raeburn 15410: 'Group' => 'array',
1.153 matthew 15411: 'StudentData' => 'array',
15412: 'Maps' => 'array');
15413:
15414: Returns: both routines return nothing
15415:
1.631 raeburn 15416: =back
15417:
1.153 matthew 15418: =cut
15419:
15420: #######################################################
15421: #######################################################
15422: sub store_course_settings {
1.496 albertel 15423: return &store_settings($env{'request.course.id'},@_);
15424: }
15425:
15426: sub store_settings {
1.153 matthew 15427: # save to the environment
15428: # appenv the same items, just to be safe
1.300 albertel 15429: my $udom = $env{'user.domain'};
15430: my $uname = $env{'user.name'};
1.496 albertel 15431: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15432: my %SaveHash;
15433: my %AppHash;
15434: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 15435: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 15436: my $envname = 'environment.'.$basename;
1.258 albertel 15437: if (exists($env{'form.'.$setting})) {
1.153 matthew 15438: # Save this value away
15439: if ($type eq 'scalar' &&
1.258 albertel 15440: (! exists($env{$envname}) ||
15441: $env{$envname} ne $env{'form.'.$setting})) {
15442: $SaveHash{$basename} = $env{'form.'.$setting};
15443: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 15444: } elsif ($type eq 'array') {
15445: my $stored_form;
1.258 albertel 15446: if (ref($env{'form.'.$setting})) {
1.153 matthew 15447: $stored_form = join(',',
15448: map {
1.369 www 15449: &escape($_);
1.258 albertel 15450: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 15451: } else {
15452: $stored_form =
1.369 www 15453: &escape($env{'form.'.$setting});
1.153 matthew 15454: }
15455: # Determine if the array contents are the same.
1.258 albertel 15456: if ($stored_form ne $env{$envname}) {
1.153 matthew 15457: $SaveHash{$basename} = $stored_form;
15458: $AppHash{$envname} = $stored_form;
15459: }
15460: }
15461: }
15462: }
15463: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 15464: $udom,$uname);
1.153 matthew 15465: if ($put_result !~ /^(ok|delayed)/) {
15466: &Apache::lonnet::logthis('unable to save form parameters, '.
15467: 'got error:'.$put_result);
15468: }
15469: # Make sure these settings stick around in this session, too
1.646 raeburn 15470: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 15471: return;
15472: }
15473:
15474: sub restore_course_settings {
1.499 albertel 15475: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 15476: }
15477:
15478: sub restore_settings {
15479: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15480: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 15481: next if (exists($env{'form.'.$setting}));
1.496 albertel 15482: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 15483: '.'.$setting;
1.258 albertel 15484: if (exists($env{$envname})) {
1.153 matthew 15485: if ($type eq 'scalar') {
1.258 albertel 15486: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 15487: } elsif ($type eq 'array') {
1.258 albertel 15488: $env{'form.'.$setting} = [
1.153 matthew 15489: map {
1.369 www 15490: &unescape($_);
1.258 albertel 15491: } split(',',$env{$envname})
1.153 matthew 15492: ];
15493: }
15494: }
15495: }
1.127 matthew 15496: }
15497:
1.618 raeburn 15498: #######################################################
15499: #######################################################
15500:
15501: =pod
15502:
15503: =head1 Domain E-mail Routines
15504:
15505: =over 4
15506:
1.648 raeburn 15507: =item * &build_recipient_list()
1.618 raeburn 15508:
1.1144 raeburn 15509: Build recipient lists for following types of e-mail:
1.766 raeburn 15510: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 15511: (d) Help requests, (e) Course requests needing approval, (f) loncapa
15512: module change checking, student/employee ID conflict checks, as
15513: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
15514: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 15515:
15516: Inputs:
1.619 raeburn 15517: defmail (scalar - email address of default recipient),
1.1144 raeburn 15518: mailing type (scalar: errormail, packagesmail, helpdeskmail,
15519: requestsmail, updatesmail, or idconflictsmail).
15520:
1.619 raeburn 15521: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 15522:
1.619 raeburn 15523: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 15524: i.e., predates configuration by DC via domainprefs.pm
15525:
15526: $requname username of requester (if mailing type is helpdeskmail)
15527:
15528: $requdom domain of requester (if mailing type is helpdeskmail)
15529:
15530: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
15531:
1.618 raeburn 15532:
1.655 raeburn 15533: Returns: comma separated list of addresses to which to send e-mail.
15534:
15535: =back
1.618 raeburn 15536:
15537: =cut
15538:
15539: ############################################################
15540: ############################################################
15541: sub build_recipient_list {
1.1297 raeburn 15542: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 15543: my @recipients;
1.1270 raeburn 15544: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 15545: my %domconfig =
1.1270 raeburn 15546: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 15547: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 15548: if (exists($domconfig{'contacts'}{$mailing})) {
15549: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
15550: my @contacts = ('adminemail','supportemail');
15551: foreach my $item (@contacts) {
15552: if ($domconfig{'contacts'}{$mailing}{$item}) {
15553: my $addr = $domconfig{'contacts'}{$item};
15554: if (!grep(/^\Q$addr\E$/,@recipients)) {
15555: push(@recipients,$addr);
15556: }
1.619 raeburn 15557: }
1.1270 raeburn 15558: }
15559: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
15560: if ($mailing eq 'helpdeskmail') {
15561: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
15562: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
15563: my @ok_bccs;
15564: foreach my $bcc (@bccs) {
15565: $bcc =~ s/^\s+//g;
15566: $bcc =~ s/\s+$//g;
15567: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15568: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15569: push(@ok_bccs,$bcc);
15570: }
15571: }
15572: }
15573: if (@ok_bccs > 0) {
15574: $allbcc = join(', ',@ok_bccs);
15575: }
15576: }
15577: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 15578: }
15579: }
1.766 raeburn 15580: } elsif ($origmail ne '') {
1.1270 raeburn 15581: $lastresort = $origmail;
1.618 raeburn 15582: }
1.1297 raeburn 15583: if ($mailing eq 'helpdeskmail') {
15584: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
15585: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
15586: my ($inststatus,$inststatus_checked);
15587: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
15588: ($env{'user.domain'} ne 'public')) {
15589: $inststatus_checked = 1;
15590: $inststatus = $env{'environment.inststatus'};
15591: }
15592: unless ($inststatus_checked) {
15593: if (($requname ne '') && ($requdom ne '')) {
15594: if (($requname =~ /^$match_username$/) &&
15595: ($requdom =~ /^$match_domain$/) &&
15596: (&Apache::lonnet::domain($requdom))) {
15597: my $requhome = &Apache::lonnet::homeserver($requname,
15598: $requdom);
15599: unless ($requhome eq 'no_host') {
15600: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
15601: $inststatus = $userenv{'inststatus'};
15602: $inststatus_checked = 1;
15603: }
15604: }
15605: }
15606: }
15607: unless ($inststatus_checked) {
15608: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
15609: my %srch = (srchby => 'email',
15610: srchdomain => $defdom,
15611: srchterm => $reqemail,
15612: srchtype => 'exact');
15613: my %srch_results = &Apache::lonnet::usersearch(\%srch);
15614: foreach my $uname (keys(%srch_results)) {
15615: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15616: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15617: $inststatus_checked = 1;
15618: last;
15619: }
15620: }
15621: unless ($inststatus_checked) {
15622: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
15623: if ($dirsrchres eq 'ok') {
15624: foreach my $uname (keys(%srch_results)) {
15625: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15626: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15627: $inststatus_checked = 1;
15628: last;
15629: }
15630: }
15631: }
15632: }
15633: }
15634: }
15635: if ($inststatus ne '') {
15636: foreach my $status (split(/\:/,$inststatus)) {
15637: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
15638: my @contacts = ('adminemail','supportemail');
15639: foreach my $item (@contacts) {
15640: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
15641: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
15642: if (!grep(/^\Q$addr\E$/,@recipients)) {
15643: push(@recipients,$addr);
15644: }
15645: }
15646: }
15647: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
15648: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
15649: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
15650: my @ok_bccs;
15651: foreach my $bcc (@bccs) {
15652: $bcc =~ s/^\s+//g;
15653: $bcc =~ s/\s+$//g;
15654: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15655: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15656: push(@ok_bccs,$bcc);
15657: }
15658: }
15659: }
15660: if (@ok_bccs > 0) {
15661: $allbcc = join(', ',@ok_bccs);
15662: }
15663: }
15664: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
15665: last;
15666: }
15667: }
15668: }
15669: }
15670: }
1.619 raeburn 15671: } elsif ($origmail ne '') {
1.1270 raeburn 15672: $lastresort = $origmail;
15673: }
1.1297 raeburn 15674: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 15675: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
15676: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
15677: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
15678: my %what = (
15679: perlvar => 1,
15680: );
15681: my $primary = &Apache::lonnet::domain($defdom,'primary');
15682: if ($primary) {
15683: my $gotaddr;
15684: my ($result,$returnhash) =
15685: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
15686: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
15687: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
15688: $lastresort = $returnhash->{'lonSupportEMail'};
15689: $gotaddr = 1;
15690: }
15691: }
15692: unless ($gotaddr) {
15693: my $uintdom = &Apache::lonnet::internet_dom($primary);
15694: my $intdom = &Apache::lonnet::internet_dom($lonhost);
15695: unless ($uintdom eq $intdom) {
15696: my %domconfig =
15697: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
15698: if (ref($domconfig{'contacts'}) eq 'HASH') {
15699: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
15700: my @contacts = ('adminemail','supportemail');
15701: foreach my $item (@contacts) {
15702: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
15703: my $addr = $domconfig{'contacts'}{$item};
15704: if (!grep(/^\Q$addr\E$/,@recipients)) {
15705: push(@recipients,$addr);
15706: }
15707: }
15708: }
15709: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
15710: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
15711: }
15712: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
15713: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
15714: my @ok_bccs;
15715: foreach my $bcc (@bccs) {
15716: $bcc =~ s/^\s+//g;
15717: $bcc =~ s/\s+$//g;
15718: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15719: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15720: push(@ok_bccs,$bcc);
15721: }
15722: }
15723: }
15724: if (@ok_bccs > 0) {
15725: $allbcc = join(', ',@ok_bccs);
15726: }
15727: }
15728: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
15729: }
15730: }
15731: }
15732: }
15733: }
15734: }
1.618 raeburn 15735: }
1.688 raeburn 15736: if (defined($defmail)) {
15737: if ($defmail ne '') {
15738: push(@recipients,$defmail);
15739: }
1.618 raeburn 15740: }
15741: if ($otheremails) {
1.619 raeburn 15742: my @others;
15743: if ($otheremails =~ /,/) {
15744: @others = split(/,/,$otheremails);
1.618 raeburn 15745: } else {
1.619 raeburn 15746: push(@others,$otheremails);
15747: }
15748: foreach my $addr (@others) {
15749: if (!grep(/^\Q$addr\E$/,@recipients)) {
15750: push(@recipients,$addr);
15751: }
1.618 raeburn 15752: }
15753: }
1.1298 raeburn 15754: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 15755: if ((!@recipients) && ($lastresort ne '')) {
15756: push(@recipients,$lastresort);
15757: }
15758: } elsif ($lastresort ne '') {
15759: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
15760: push(@recipients,$lastresort);
15761: }
15762: }
1.1271 raeburn 15763: my $recipientlist = join(',',@recipients);
1.1270 raeburn 15764: if (wantarray) {
15765: return ($recipientlist,$allbcc,$addtext);
15766: } else {
15767: return $recipientlist;
15768: }
1.618 raeburn 15769: }
15770:
1.127 matthew 15771: ############################################################
15772: ############################################################
1.154 albertel 15773:
1.655 raeburn 15774: =pod
15775:
1.1224 musolffc 15776: =over 4
15777:
1.1223 musolffc 15778: =item * &mime_email()
15779:
15780: Sends an email with a possible attachment
15781:
15782: Inputs:
15783:
15784: =over 4
15785:
15786: from - Sender's email address
15787:
1.1343 raeburn 15788: replyto - Reply-To email address
15789:
1.1223 musolffc 15790: to - Email address of recipient
15791:
15792: subject - Subject of email
15793:
15794: body - Body of email
15795:
15796: cc_string - Carbon copy email address
15797:
15798: bcc - Blind carbon copy email address
15799:
15800: attachment_path - Path of file to be attached
15801:
15802: file_name - Name of file to be attached
15803:
15804: attachment_text - The body of an attachment of type "TEXT"
15805:
15806: =back
15807:
15808: =back
15809:
15810: =cut
15811:
15812: ############################################################
15813: ############################################################
15814:
15815: sub mime_email {
1.1343 raeburn 15816: my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
15817: $file_name,$attachment_text) = @_;
15818:
1.1223 musolffc 15819: my $msg = MIME::Lite->new(
15820: From => $from,
15821: To => $to,
15822: Subject => $subject,
15823: Type =>'TEXT',
15824: Data => $body,
15825: );
1.1343 raeburn 15826: if ($replyto ne '') {
15827: $msg->add("Reply-To" => $replyto);
15828: }
1.1223 musolffc 15829: if ($cc_string ne '') {
15830: $msg->add("Cc" => $cc_string);
15831: }
15832: if ($bcc ne '') {
15833: $msg->add("Bcc" => $bcc);
15834: }
15835: $msg->attr("content-type" => "text/plain");
15836: $msg->attr("content-type.charset" => "UTF-8");
15837: # Attach file if given
15838: if ($attachment_path) {
15839: unless ($file_name) {
15840: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
15841: }
15842: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
15843: $msg->attach(Type => $type,
15844: Path => $attachment_path,
15845: Filename => $file_name
15846: );
15847: # Otherwise attach text if given
15848: } elsif ($attachment_text) {
15849: $msg->attach(Type => 'TEXT',
15850: Data => $attachment_text);
15851: }
15852: # Send it
15853: $msg->send('sendmail');
15854: }
15855:
15856: ############################################################
15857: ############################################################
15858:
15859: =pod
15860:
1.655 raeburn 15861: =head1 Course Catalog Routines
15862:
15863: =over 4
15864:
15865: =item * &gather_categories()
15866:
15867: Converts category definitions - keys of categories hash stored in
15868: coursecategories in configuration.db on the primary library server in a
15869: domain - to an array. Also generates javascript and idx hash used to
15870: generate Domain Coordinator interface for editing Course Categories.
15871:
15872: Inputs:
1.663 raeburn 15873:
1.655 raeburn 15874: categories (reference to hash of category definitions).
1.663 raeburn 15875:
1.655 raeburn 15876: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15877: categories and subcategories).
1.663 raeburn 15878:
1.655 raeburn 15879: idx (reference to hash of counters used in Domain Coordinator interface for
15880: editing Course Categories).
1.663 raeburn 15881:
1.655 raeburn 15882: jsarray (reference to array of categories used to create Javascript arrays for
15883: Domain Coordinator interface for editing Course Categories).
15884:
15885: Returns: nothing
15886:
15887: Side effects: populates cats, idx and jsarray.
15888:
15889: =cut
15890:
15891: sub gather_categories {
15892: my ($categories,$cats,$idx,$jsarray) = @_;
15893: my %counters;
15894: my $num = 0;
15895: foreach my $item (keys(%{$categories})) {
15896: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
15897: if ($container eq '' && $depth == 0) {
15898: $cats->[$depth][$categories->{$item}] = $cat;
15899: } else {
15900: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
15901: }
15902: my ($escitem,$tail) = split(/:/,$item,2);
15903: if ($counters{$tail} eq '') {
15904: $counters{$tail} = $num;
15905: $num ++;
15906: }
15907: if (ref($idx) eq 'HASH') {
15908: $idx->{$item} = $counters{$tail};
15909: }
15910: if (ref($jsarray) eq 'ARRAY') {
15911: push(@{$jsarray->[$counters{$tail}]},$item);
15912: }
15913: }
15914: return;
15915: }
15916:
15917: =pod
15918:
15919: =item * &extract_categories()
15920:
15921: Used to generate breadcrumb trails for course categories.
15922:
15923: Inputs:
1.663 raeburn 15924:
1.655 raeburn 15925: categories (reference to hash of category definitions).
1.663 raeburn 15926:
1.655 raeburn 15927: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15928: categories and subcategories).
1.663 raeburn 15929:
1.655 raeburn 15930: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 15931:
1.655 raeburn 15932: allitems (reference to hash - key is category key
15933: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15934:
1.655 raeburn 15935: idx (reference to hash of counters used in Domain Coordinator interface for
15936: editing Course Categories).
1.663 raeburn 15937:
1.655 raeburn 15938: jsarray (reference to array of categories used to create Javascript arrays for
15939: Domain Coordinator interface for editing Course Categories).
15940:
1.665 raeburn 15941: subcats (reference to hash of arrays containing all subcategories within each
15942: category, -recursive)
15943:
1.1321 raeburn 15944: maxd (reference to hash used to hold max depth for all top-level categories).
15945:
1.655 raeburn 15946: Returns: nothing
15947:
15948: Side effects: populates trails and allitems hash references.
15949:
15950: =cut
15951:
15952: sub extract_categories {
1.1321 raeburn 15953: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 15954: if (ref($categories) eq 'HASH') {
15955: &gather_categories($categories,$cats,$idx,$jsarray);
15956: if (ref($cats->[0]) eq 'ARRAY') {
15957: for (my $i=0; $i<@{$cats->[0]}; $i++) {
15958: my $name = $cats->[0][$i];
15959: my $item = &escape($name).'::0';
15960: my $trailstr;
15961: if ($name eq 'instcode') {
15962: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 15963: } elsif ($name eq 'communities') {
15964: $trailstr = &mt('Communities');
1.1239 raeburn 15965: } elsif ($name eq 'placement') {
15966: $trailstr = &mt('Placement Tests');
1.655 raeburn 15967: } else {
15968: $trailstr = $name;
15969: }
15970: if ($allitems->{$item} eq '') {
15971: push(@{$trails},$trailstr);
15972: $allitems->{$item} = scalar(@{$trails})-1;
15973: }
15974: my @parents = ($name);
15975: if (ref($cats->[1]{$name}) eq 'ARRAY') {
15976: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
15977: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 15978: if (ref($subcats) eq 'HASH') {
15979: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
15980: }
1.1321 raeburn 15981: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 15982: }
15983: } else {
15984: if (ref($subcats) eq 'HASH') {
15985: $subcats->{$item} = [];
1.655 raeburn 15986: }
1.1321 raeburn 15987: if (ref($maxd) eq 'HASH') {
15988: $maxd->{$name} = 1;
15989: }
1.655 raeburn 15990: }
15991: }
15992: }
15993: }
15994: return;
15995: }
15996:
15997: =pod
15998:
1.1162 raeburn 15999: =item * &recurse_categories()
1.655 raeburn 16000:
16001: Recursively used to generate breadcrumb trails for course categories.
16002:
16003: Inputs:
1.663 raeburn 16004:
1.655 raeburn 16005: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16006: categories and subcategories).
1.663 raeburn 16007:
1.655 raeburn 16008: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 16009:
16010: category (current course category, for which breadcrumb trail is being generated).
16011:
16012: trails (reference to array of breadcrumb trails for each category).
16013:
1.655 raeburn 16014: allitems (reference to hash - key is category key
16015: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16016:
1.655 raeburn 16017: parents (array containing containers directories for current category,
16018: back to top level).
16019:
16020: Returns: nothing
16021:
16022: Side effects: populates trails and allitems hash references
16023:
16024: =cut
16025:
16026: sub recurse_categories {
1.1321 raeburn 16027: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 16028: my $shallower = $depth - 1;
16029: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
16030: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
16031: my $name = $cats->[$depth]{$category}[$k];
16032: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16033: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16034: if ($allitems->{$item} eq '') {
16035: push(@{$trails},$trailstr);
16036: $allitems->{$item} = scalar(@{$trails})-1;
16037: }
16038: my $deeper = $depth+1;
16039: push(@{$parents},$category);
1.665 raeburn 16040: if (ref($subcats) eq 'HASH') {
16041: my $subcat = &escape($name).':'.$category.':'.$depth;
16042: for (my $j=@{$parents}; $j>=0; $j--) {
16043: my $higher;
16044: if ($j > 0) {
16045: $higher = &escape($parents->[$j]).':'.
16046: &escape($parents->[$j-1]).':'.$j;
16047: } else {
16048: $higher = &escape($parents->[$j]).'::'.$j;
16049: }
16050: push(@{$subcats->{$higher}},$subcat);
16051: }
16052: }
16053: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321 raeburn 16054: $subcats,$maxd);
1.655 raeburn 16055: pop(@{$parents});
16056: }
16057: } else {
16058: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16059: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16060: if ($allitems->{$item} eq '') {
16061: push(@{$trails},$trailstr);
16062: $allitems->{$item} = scalar(@{$trails})-1;
16063: }
1.1321 raeburn 16064: if (ref($maxd) eq 'HASH') {
16065: if ($depth > $maxd->{$parents->[0]}) {
16066: $maxd->{$parents->[0]} = $depth;
16067: }
16068: }
1.655 raeburn 16069: }
16070: return;
16071: }
16072:
1.663 raeburn 16073: =pod
16074:
1.1162 raeburn 16075: =item * &assign_categories_table()
1.663 raeburn 16076:
16077: Create a datatable for display of hierarchical categories in a domain,
16078: with checkboxes to allow a course to be categorized.
16079:
16080: Inputs:
16081:
16082: cathash - reference to hash of categories defined for the domain (from
16083: configuration.db)
16084:
16085: currcat - scalar with an & separated list of categories assigned to a course.
16086:
1.919 raeburn 16087: type - scalar contains course type (Course or Community).
16088:
1.1260 raeburn 16089: disabled - scalar (optional) contains disabled="disabled" if input elements are
16090: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16091:
1.663 raeburn 16092: Returns: $output (markup to be displayed)
16093:
16094: =cut
16095:
16096: sub assign_categories_table {
1.1259 raeburn 16097: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 16098: my $output;
16099: if (ref($cathash) eq 'HASH') {
1.1321 raeburn 16100: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
16101: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 16102: $maxdepth = scalar(@cats);
16103: if (@cats > 0) {
16104: my $itemcount = 0;
16105: if (ref($cats[0]) eq 'ARRAY') {
16106: my @currcategories;
16107: if ($currcat ne '') {
16108: @currcategories = split('&',$currcat);
16109: }
1.919 raeburn 16110: my $table;
1.663 raeburn 16111: for (my $i=0; $i<@{$cats[0]}; $i++) {
16112: my $parent = $cats[0][$i];
1.919 raeburn 16113: next if ($parent eq 'instcode');
16114: if ($type eq 'Community') {
16115: next unless ($parent eq 'communities');
1.1239 raeburn 16116: } elsif ($type eq 'Placement') {
16117: next unless ($parent eq 'placement');
1.919 raeburn 16118: } else {
1.1239 raeburn 16119: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 16120: }
1.663 raeburn 16121: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
16122: my $item = &escape($parent).'::0';
16123: my $checked = '';
16124: if (@currcategories > 0) {
16125: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 16126: $checked = ' checked="checked"';
1.663 raeburn 16127: }
16128: }
1.919 raeburn 16129: my $parent_title = $parent;
16130: if ($parent eq 'communities') {
16131: $parent_title = &mt('Communities');
1.1239 raeburn 16132: } elsif ($parent eq 'placement') {
16133: $parent_title = &mt('Placement Tests');
1.919 raeburn 16134: }
16135: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
16136: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16137: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 16138: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 16139: my $depth = 1;
16140: push(@path,$parent);
1.1259 raeburn 16141: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 16142: pop(@path);
1.919 raeburn 16143: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 16144: $itemcount ++;
16145: }
1.919 raeburn 16146: if ($itemcount) {
16147: $output = &Apache::loncommon::start_data_table().
16148: $table.
16149: &Apache::loncommon::end_data_table();
16150: }
1.663 raeburn 16151: }
16152: }
16153: }
16154: return $output;
16155: }
16156:
16157: =pod
16158:
1.1162 raeburn 16159: =item * &assign_category_rows()
1.663 raeburn 16160:
16161: Create a datatable row for display of nested categories in a domain,
16162: with checkboxes to allow a course to be categorized,called recursively.
16163:
16164: Inputs:
16165:
16166: itemcount - track row number for alternating colors
16167:
16168: cats - reference to array of arrays/hashes which encapsulates hierarchy of
16169: categories and subcategories.
16170:
16171: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
16172:
16173: parent - parent of current category item
16174:
16175: path - Array containing all categories back up through the hierarchy from the
16176: current category to the top level.
16177:
16178: currcategories - reference to array of current categories assigned to the course
16179:
1.1260 raeburn 16180: disabled - scalar (optional) contains disabled="disabled" if input elements are
16181: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16182:
1.663 raeburn 16183: Returns: $output (markup to be displayed).
16184:
16185: =cut
16186:
16187: sub assign_category_rows {
1.1259 raeburn 16188: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 16189: my ($text,$name,$item,$chgstr);
16190: if (ref($cats) eq 'ARRAY') {
16191: my $maxdepth = scalar(@{$cats});
16192: if (ref($cats->[$depth]) eq 'HASH') {
16193: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
16194: my $numchildren = @{$cats->[$depth]{$parent}};
16195: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 16196: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 16197: for (my $j=0; $j<$numchildren; $j++) {
16198: $name = $cats->[$depth]{$parent}[$j];
16199: $item = &escape($name).':'.&escape($parent).':'.$depth;
16200: my $deeper = $depth+1;
16201: my $checked = '';
16202: if (ref($currcategories) eq 'ARRAY') {
16203: if (@{$currcategories} > 0) {
16204: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 16205: $checked = ' checked="checked"';
1.663 raeburn 16206: }
16207: }
16208: }
1.664 raeburn 16209: $text .= '<tr><td><span class="LC_nobreak"><label>'.
16210: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16211: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 16212: '<input type="hidden" name="catname" value="'.$name.'" />'.
16213: '</td><td>';
1.663 raeburn 16214: if (ref($path) eq 'ARRAY') {
16215: push(@{$path},$name);
1.1259 raeburn 16216: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 16217: pop(@{$path});
16218: }
16219: $text .= '</td></tr>';
16220: }
16221: $text .= '</table></td>';
16222: }
16223: }
16224: }
16225: return $text;
16226: }
16227:
1.1181 raeburn 16228: =pod
16229:
16230: =back
16231:
16232: =cut
16233:
1.655 raeburn 16234: ############################################################
16235: ############################################################
16236:
16237:
1.443 albertel 16238: sub commit_customrole {
1.664 raeburn 16239: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 16240: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 16241: ($start?', '.&mt('starting').' '.localtime($start):'').
16242: ($end?', ending '.localtime($end):'').': <b>'.
16243: &Apache::lonnet::assigncustomrole(
1.664 raeburn 16244: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 16245: '</b><br />';
16246: return $output;
16247: }
16248:
16249: sub commit_standardrole {
1.1116 raeburn 16250: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 16251: my ($output,$logmsg,$linefeed);
16252: if ($context eq 'auto') {
16253: $linefeed = "\n";
16254: } else {
16255: $linefeed = "<br />\n";
16256: }
1.443 albertel 16257: if ($three eq 'st') {
1.541 raeburn 16258: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 16259: $one,$two,$sec,$context,$credits);
1.541 raeburn 16260: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 16261: ($result eq 'unknown_course') || ($result eq 'refused')) {
16262: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 16263: } else {
1.541 raeburn 16264: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 16265: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16266: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
16267: if ($context eq 'auto') {
16268: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
16269: } else {
16270: $output .= '<b>'.$result.'</b>'.$linefeed.
16271: &mt('Add to classlist').': <b>ok</b>';
16272: }
16273: $output .= $linefeed;
1.443 albertel 16274: }
16275: } else {
16276: $output = &mt('Assigning').' '.$three.' in '.$url.
16277: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16278: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 16279: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 16280: if ($context eq 'auto') {
16281: $output .= $result.$linefeed;
16282: } else {
16283: $output .= '<b>'.$result.'</b>'.$linefeed;
16284: }
1.443 albertel 16285: }
16286: return $output;
16287: }
16288:
16289: sub commit_studentrole {
1.1116 raeburn 16290: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
16291: $credits) = @_;
1.626 raeburn 16292: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 16293: if ($context eq 'auto') {
16294: $linefeed = "\n";
16295: } else {
16296: $linefeed = '<br />'."\n";
16297: }
1.443 albertel 16298: if (defined($one) && defined($two)) {
16299: my $cid=$one.'_'.$two;
16300: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
16301: my $secchange = 0;
16302: my $expire_role_result;
16303: my $modify_section_result;
1.628 raeburn 16304: if ($oldsec ne '-1') {
16305: if ($oldsec ne $sec) {
1.443 albertel 16306: $secchange = 1;
1.628 raeburn 16307: my $now = time;
1.443 albertel 16308: my $uurl='/'.$cid;
16309: $uurl=~s/\_/\//g;
16310: if ($oldsec) {
16311: $uurl.='/'.$oldsec;
16312: }
1.626 raeburn 16313: $oldsecurl = $uurl;
1.628 raeburn 16314: $expire_role_result =
1.652 raeburn 16315: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 16316: if ($env{'request.course.sec'} ne '') {
16317: if ($expire_role_result eq 'refused') {
16318: my @roles = ('st');
16319: my @statuses = ('previous');
16320: my @roledoms = ($one);
16321: my $withsec = 1;
16322: my %roleshash =
16323: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
16324: \@statuses,\@roles,\@roledoms,$withsec);
16325: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
16326: my ($oldstart,$oldend) =
16327: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
16328: if ($oldend > 0 && $oldend <= $now) {
16329: $expire_role_result = 'ok';
16330: }
16331: }
16332: }
16333: }
1.443 albertel 16334: $result = $expire_role_result;
16335: }
16336: }
16337: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 16338: $modify_section_result =
16339: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
16340: undef,undef,undef,$sec,
16341: $end,$start,'','',$cid,
16342: '',$context,$credits);
1.443 albertel 16343: if ($modify_section_result =~ /^ok/) {
16344: if ($secchange == 1) {
1.628 raeburn 16345: if ($sec eq '') {
16346: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
16347: } else {
16348: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
16349: }
1.443 albertel 16350: } elsif ($oldsec eq '-1') {
1.628 raeburn 16351: if ($sec eq '') {
16352: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
16353: } else {
16354: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16355: }
1.443 albertel 16356: } else {
1.628 raeburn 16357: if ($sec eq '') {
16358: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
16359: } else {
16360: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16361: }
1.443 albertel 16362: }
16363: } else {
1.1115 raeburn 16364: if ($secchange) {
1.628 raeburn 16365: $$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;
16366: } else {
16367: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
16368: }
1.443 albertel 16369: }
16370: $result = $modify_section_result;
16371: } elsif ($secchange == 1) {
1.628 raeburn 16372: if ($oldsec eq '') {
1.1103 raeburn 16373: $$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 16374: } else {
16375: $$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;
16376: }
1.626 raeburn 16377: if ($expire_role_result eq 'refused') {
16378: my $newsecurl = '/'.$cid;
16379: $newsecurl =~ s/\_/\//g;
16380: if ($sec ne '') {
16381: $newsecurl.='/'.$sec;
16382: }
16383: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
16384: if ($sec eq '') {
16385: $$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;
16386: } else {
16387: $$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;
16388: }
16389: }
16390: }
1.443 albertel 16391: }
16392: } else {
1.626 raeburn 16393: $$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 16394: $result = "error: incomplete course id\n";
16395: }
16396: return $result;
16397: }
16398:
1.1108 raeburn 16399: sub show_role_extent {
16400: my ($scope,$context,$role) = @_;
16401: $scope =~ s{^/}{};
16402: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
16403: push(@courseroles,'co');
16404: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
16405: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
16406: $scope =~ s{/}{_};
16407: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
16408: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
16409: my ($audom,$auname) = split(/\//,$scope);
16410: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
16411: &Apache::loncommon::plainname($auname,$audom).'</span>');
16412: } else {
16413: $scope =~ s{/$}{};
16414: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
16415: &Apache::lonnet::domain($scope,'description').'</span>');
16416: }
16417: }
16418:
1.443 albertel 16419: ############################################################
16420: ############################################################
16421:
1.566 albertel 16422: sub check_clone {
1.578 raeburn 16423: my ($args,$linefeed) = @_;
1.566 albertel 16424: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
16425: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
16426: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344 raeburn 16427: my $clonetitle;
16428: my @clonemsg;
1.566 albertel 16429: my $can_clone = 0;
1.944 raeburn 16430: my $lctype = lc($args->{'crstype'});
1.908 raeburn 16431: if ($lctype ne 'community') {
16432: $lctype = 'course';
16433: }
1.566 albertel 16434: if ($clonehome eq 'no_host') {
1.944 raeburn 16435: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16436: push(@clonemsg,({
16437: mt => 'No new community created.',
16438: args => [],
16439: },
16440: {
16441: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
16442: args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
16443: }));
1.908 raeburn 16444: } else {
1.1344 raeburn 16445: push(@clonemsg,({
16446: mt => 'No new course created.',
16447: args => [],
16448: },
16449: {
16450: mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
16451: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16452: }));
16453: }
1.566 albertel 16454: } else {
16455: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344 raeburn 16456: $clonetitle = $clonedesc{'description'};
1.944 raeburn 16457: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 16458: if ($clonedesc{'type'} ne 'Community') {
1.1344 raeburn 16459: push(@clonemsg,({
16460: mt => 'No new community created.',
16461: args => [],
16462: },
16463: {
16464: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
16465: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16466: }));
16467: return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 16468: }
16469: }
1.1262 raeburn 16470: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 16471: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 16472: $can_clone = 1;
16473: } else {
1.1221 raeburn 16474: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 16475: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 16476: if ($clonehash{'cloners'} eq '') {
16477: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
16478: if ($domdefs{'canclone'}) {
16479: unless ($domdefs{'canclone'} eq 'none') {
16480: if ($domdefs{'canclone'} eq 'domain') {
16481: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
16482: $can_clone = 1;
16483: }
16484: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16485: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
16486: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
16487: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
16488: $can_clone = 1;
16489: }
16490: }
16491: }
16492: }
1.578 raeburn 16493: } else {
1.1221 raeburn 16494: my @cloners = split(/,/,$clonehash{'cloners'});
16495: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 16496: $can_clone = 1;
1.1221 raeburn 16497: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 16498: $can_clone = 1;
1.1225 raeburn 16499: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
16500: $can_clone = 1;
1.1221 raeburn 16501: }
16502: unless ($can_clone) {
1.1225 raeburn 16503: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16504: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 16505: my (%gotdomdefaults,%gotcodedefaults);
16506: foreach my $cloner (@cloners) {
16507: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
16508: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
16509: my (%codedefaults,@code_order);
16510: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
16511: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
16512: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
16513: }
16514: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
16515: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
16516: }
16517: } else {
16518: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
16519: \%codedefaults,
16520: \@code_order);
16521: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
16522: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
16523: }
16524: if (@code_order > 0) {
16525: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
16526: $cloner,$clonehash{'internal.coursecode'},
16527: $args->{'crscode'})) {
16528: $can_clone = 1;
16529: last;
16530: }
16531: }
16532: }
16533: }
16534: }
1.1225 raeburn 16535: }
16536: }
16537: unless ($can_clone) {
16538: my $ccrole = 'cc';
16539: if ($args->{'crstype'} eq 'Community') {
16540: $ccrole = 'co';
16541: }
16542: my %roleshash =
16543: &Apache::lonnet::get_my_roles($args->{'ccuname'},
16544: $args->{'ccdomain'},
16545: 'userroles',['active'],[$ccrole],
16546: [$args->{'clonedomain'}]);
16547: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
16548: $can_clone = 1;
16549: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
16550: $args->{'ccuname'},$args->{'ccdomain'})) {
16551: $can_clone = 1;
1.1221 raeburn 16552: }
16553: }
16554: unless ($can_clone) {
16555: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16556: push(@clonemsg,({
16557: mt => 'No new community created.',
16558: args => [],
16559: },
16560: {
16561: 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]).',
16562: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16563: }));
1.942 raeburn 16564: } else {
1.1344 raeburn 16565: push(@clonemsg,({
16566: mt => 'No new course created.',
16567: args => [],
16568: },
16569: {
16570: 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]).',
16571: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16572: }));
1.1221 raeburn 16573: }
1.566 albertel 16574: }
1.578 raeburn 16575: }
1.566 albertel 16576: }
1.1344 raeburn 16577: return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16578: }
16579:
1.444 albertel 16580: sub construct_course {
1.1262 raeburn 16581: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344 raeburn 16582: $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
16583: my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 16584: my $linefeed = '<br />'."\n";
16585: if ($context eq 'auto') {
16586: $linefeed = "\n";
16587: }
1.566 albertel 16588:
16589: #
16590: # Are we cloning?
16591: #
1.1344 raeburn 16592: my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16593: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344 raeburn 16594: ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 16595: if (!$can_clone) {
1.1344 raeburn 16596: return (0,$outcome,$clonemsgref);
1.566 albertel 16597: }
16598: }
16599:
1.444 albertel 16600: #
16601: # Open course
16602: #
1.1239 raeburn 16603: my $showncrstype;
16604: if ($args->{'crstype'} eq 'Placement') {
16605: $showncrstype = 'placement test';
16606: } else {
16607: $showncrstype = lc($args->{'crstype'});
16608: }
1.444 albertel 16609: my %cenv=();
16610: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
16611: $args->{'cdescr'},
16612: $args->{'curl'},
16613: $args->{'course_home'},
16614: $args->{'nonstandard'},
16615: $args->{'crscode'},
16616: $args->{'ccuname'}.':'.
16617: $args->{'ccdomain'},
1.882 raeburn 16618: $args->{'crstype'},
1.1344 raeburn 16619: $cnum,$context,$category,
16620: $callercontext);
1.444 albertel 16621:
16622: # Note: The testing routines depend on this being output; see
16623: # Utils::Course. This needs to at least be output as a comment
16624: # if anyone ever decides to not show this, and Utils::Course::new
16625: # will need to be suitably modified.
1.1344 raeburn 16626: if (($callercontext eq 'auto') && ($user_lh ne '')) {
16627: $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
16628: } else {
16629: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
16630: }
1.943 raeburn 16631: if ($$courseid =~ /^error:/) {
1.1344 raeburn 16632: return (0,$outcome,$clonemsgref);
1.943 raeburn 16633: }
16634:
1.444 albertel 16635: #
16636: # Check if created correctly
16637: #
1.479 albertel 16638: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 16639: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 16640: if ($crsuhome eq 'no_host') {
1.1344 raeburn 16641: if (($callercontext eq 'auto') && ($user_lh ne '')) {
16642: $outcome .= &mt_user($user_lh,
16643: 'Course creation failed, unrecognized course home server.');
16644: } else {
16645: $outcome .= &mt('Course creation failed, unrecognized course home server.');
16646: }
16647: $outcome .= $linefeed;
16648: return (0,$outcome,$clonemsgref);
1.943 raeburn 16649: }
1.541 raeburn 16650: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 16651:
1.444 albertel 16652: #
1.566 albertel 16653: # Do the cloning
16654: #
1.1344 raeburn 16655: my @clonemsg;
1.566 albertel 16656: if ($can_clone && $cloneid) {
1.1344 raeburn 16657: push(@clonemsg,
16658: {
16659: mt => 'Created [_1] by cloning from [_2]',
16660: args => [$showncrstype,$clonetitle],
16661: });
1.566 albertel 16662: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 16663: # Copy all files
1.1344 raeburn 16664: my @info =
16665: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
16666: $args->{'dateshift'},$args->{'crscode'},
16667: $args->{'ccuname'}.':'.$args->{'ccdomain'},
16668: $args->{'tinyurls'});
16669: if (@info) {
16670: push(@clonemsg,@info);
16671: }
1.444 albertel 16672: # Restore URL
1.566 albertel 16673: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 16674: # Restore title
1.566 albertel 16675: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 16676: # Restore creation date, creator and creation context.
16677: $cenv{'internal.created'}=$oldcenv{'internal.created'};
16678: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
16679: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 16680: # Mark as cloned
1.566 albertel 16681: $cenv{'clonedfrom'}=$cloneid;
1.638 www 16682: # Need to clone grading mode
16683: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
16684: $cenv{'grading'}=$newenv{'grading'};
16685: # Do not clone these environment entries
16686: &Apache::lonnet::del('environment',
16687: ['default_enrollment_start_date',
16688: 'default_enrollment_end_date',
16689: 'question.email',
16690: 'policy.email',
16691: 'comment.email',
16692: 'pch.users.denied',
1.725 raeburn 16693: 'plc.users.denied',
16694: 'hidefromcat',
1.1121 raeburn 16695: 'checkforpriv',
1.1355 raeburn 16696: 'categories'],
1.638 www 16697: $$crsudom,$$crsunum);
1.1170 raeburn 16698: if ($args->{'textbook'}) {
16699: $cenv{'internal.textbook'} = $args->{'textbook'};
16700: }
1.444 albertel 16701: }
1.566 albertel 16702:
1.444 albertel 16703: #
16704: # Set environment (will override cloned, if existing)
16705: #
16706: my @sections = ();
16707: my @xlists = ();
16708: if ($args->{'crstype'}) {
16709: $cenv{'type'}=$args->{'crstype'};
16710: }
1.1371 raeburn 16711: if ($args->{'lti'}) {
16712: $cenv{'internal.lti'}=$args->{'lti'};
16713: }
1.444 albertel 16714: if ($args->{'crsid'}) {
16715: $cenv{'courseid'}=$args->{'crsid'};
16716: }
16717: if ($args->{'crscode'}) {
16718: $cenv{'internal.coursecode'}=$args->{'crscode'};
16719: }
16720: if ($args->{'crsquota'} ne '') {
16721: $cenv{'internal.coursequota'}=$args->{'crsquota'};
16722: } else {
16723: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
16724: }
16725: if ($args->{'ccuname'}) {
16726: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
16727: ':'.$args->{'ccdomain'};
16728: } else {
16729: $cenv{'internal.courseowner'} = $args->{'curruser'};
16730: }
1.1116 raeburn 16731: if ($args->{'defaultcredits'}) {
16732: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
16733: }
1.444 albertel 16734: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
16735: if ($args->{'crssections'}) {
16736: $cenv{'internal.sectionnums'} = '';
16737: if ($args->{'crssections'} =~ m/,/) {
16738: @sections = split/,/,$args->{'crssections'};
16739: } else {
16740: $sections[0] = $args->{'crssections'};
16741: }
16742: if (@sections > 0) {
16743: foreach my $item (@sections) {
16744: my ($sec,$gp) = split/:/,$item;
16745: my $class = $args->{'crscode'}.$sec;
16746: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
16747: $cenv{'internal.sectionnums'} .= $item.',';
16748: unless ($addcheck eq 'ok') {
1.1263 raeburn 16749: push(@badclasses,$class);
1.444 albertel 16750: }
16751: }
16752: $cenv{'internal.sectionnums'} =~ s/,$//;
16753: }
16754: }
16755: # do not hide course coordinator from staff listing,
16756: # even if privileged
16757: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 16758: # add course coordinator's domain to domains to check for privileged users
16759: # if different to course domain
16760: if ($$crsudom ne $args->{'ccdomain'}) {
16761: $cenv{'checkforpriv'} = $args->{'ccdomain'};
16762: }
1.444 albertel 16763: # add crosslistings
16764: if ($args->{'crsxlist'}) {
16765: $cenv{'internal.crosslistings'}='';
16766: if ($args->{'crsxlist'} =~ m/,/) {
16767: @xlists = split/,/,$args->{'crsxlist'};
16768: } else {
16769: $xlists[0] = $args->{'crsxlist'};
16770: }
16771: if (@xlists > 0) {
16772: foreach my $item (@xlists) {
16773: my ($xl,$gp) = split/:/,$item;
16774: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
16775: $cenv{'internal.crosslistings'} .= $item.',';
16776: unless ($addcheck eq 'ok') {
1.1263 raeburn 16777: push(@badclasses,$xl);
1.444 albertel 16778: }
16779: }
16780: $cenv{'internal.crosslistings'} =~ s/,$//;
16781: }
16782: }
16783: if ($args->{'autoadds'}) {
16784: $cenv{'internal.autoadds'}=$args->{'autoadds'};
16785: }
16786: if ($args->{'autodrops'}) {
16787: $cenv{'internal.autodrops'}=$args->{'autodrops'};
16788: }
16789: # check for notification of enrollment changes
16790: my @notified = ();
16791: if ($args->{'notify_owner'}) {
16792: if ($args->{'ccuname'} ne '') {
16793: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
16794: }
16795: }
16796: if ($args->{'notify_dc'}) {
16797: if ($uname ne '') {
1.630 raeburn 16798: push(@notified,$uname.':'.$udom);
1.444 albertel 16799: }
16800: }
16801: if (@notified > 0) {
16802: my $notifylist;
16803: if (@notified > 1) {
16804: $notifylist = join(',',@notified);
16805: } else {
16806: $notifylist = $notified[0];
16807: }
16808: $cenv{'internal.notifylist'} = $notifylist;
16809: }
16810: if (@badclasses > 0) {
16811: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 16812: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
16813: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
16814: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 16815: );
1.1264 raeburn 16816: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
16817: &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 16818: if ($context eq 'auto') {
16819: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 16820: } else {
1.566 albertel 16821: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 16822: }
16823: foreach my $item (@badclasses) {
1.541 raeburn 16824: if ($context eq 'auto') {
1.1261 raeburn 16825: $outcome .= " - $item\n";
1.541 raeburn 16826: } else {
1.1261 raeburn 16827: $outcome .= "<li>$item</li>\n";
1.541 raeburn 16828: }
1.1261 raeburn 16829: }
16830: if ($context eq 'auto') {
16831: $outcome .= $linefeed;
16832: } else {
16833: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 16834: }
1.444 albertel 16835: }
16836: if ($args->{'no_end_date'}) {
16837: $args->{'endaccess'} = 0;
16838: }
16839: $cenv{'internal.autostart'}=$args->{'enrollstart'};
16840: $cenv{'internal.autoend'}=$args->{'enrollend'};
16841: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
16842: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
16843: if ($args->{'showphotos'}) {
16844: $cenv{'internal.showphotos'}=$args->{'showphotos'};
16845: }
16846: $cenv{'internal.authtype'} = $args->{'authtype'};
16847: $cenv{'internal.autharg'} = $args->{'autharg'};
16848: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
16849: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 16850: 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');
16851: if ($context eq 'auto') {
16852: $outcome .= $krb_msg;
16853: } else {
1.566 albertel 16854: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 16855: }
16856: $outcome .= $linefeed;
1.444 albertel 16857: }
16858: }
16859: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
16860: if ($args->{'setpolicy'}) {
16861: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16862: }
16863: if ($args->{'setcontent'}) {
16864: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16865: }
1.1251 raeburn 16866: if ($args->{'setcomment'}) {
16867: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16868: }
1.444 albertel 16869: }
16870: if ($args->{'reshome'}) {
16871: $cenv{'reshome'}=$args->{'reshome'}.'/';
16872: $cenv{'reshome'}=~s/\/+$/\//;
16873: }
16874: #
16875: # course has keyed access
16876: #
16877: if ($args->{'setkeys'}) {
16878: $cenv{'keyaccess'}='yes';
16879: }
16880: # if specified, key authority is not course, but user
16881: # only active if keyaccess is yes
16882: if ($args->{'keyauth'}) {
1.487 albertel 16883: my ($user,$domain) = split(':',$args->{'keyauth'});
16884: $user = &LONCAPA::clean_username($user);
16885: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 16886: if ($user ne '' && $domain ne '') {
1.487 albertel 16887: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 16888: }
16889: }
16890:
1.1166 raeburn 16891: #
1.1167 raeburn 16892: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 16893: #
16894: if ($args->{'uniquecode'}) {
16895: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
16896: if ($code) {
16897: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 16898: my %crsinfo =
16899: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
16900: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
16901: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
16902: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
16903: }
1.1166 raeburn 16904: if (ref($coderef)) {
16905: $$coderef = $code;
16906: }
16907: }
16908: }
16909:
1.444 albertel 16910: if ($args->{'disresdis'}) {
16911: $cenv{'pch.roles.denied'}='st';
16912: }
16913: if ($args->{'disablechat'}) {
16914: $cenv{'plc.roles.denied'}='st';
16915: }
16916:
16917: # Record we've not yet viewed the Course Initialization Helper for this
16918: # course
16919: $cenv{'course.helper.not.run'} = 1;
16920: #
16921: # Use new Randomseed
16922: #
16923: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
16924: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
16925: #
16926: # The encryption code and receipt prefix for this course
16927: #
16928: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
16929: $cenv{'internal.encpref'}=100+int(9*rand(99));
16930: #
16931: # By default, use standard grading
16932: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
16933:
1.541 raeburn 16934: $outcome .= $linefeed.&mt('Setting environment').': '.
16935: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16936: #
16937: # Open all assignments
16938: #
16939: if ($args->{'openall'}) {
1.1341 raeburn 16940: my $opendate = time;
16941: if ($args->{'openallfrom'} =~ /^\d+$/) {
16942: $opendate = $args->{'openallfrom'};
16943: }
1.444 albertel 16944: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341 raeburn 16945: my %storecontent = ($storeunder => $opendate,
1.444 albertel 16946: $storeunder.'.type' => 'date_start');
1.1341 raeburn 16947: $outcome .= &mt('All assignments open starting [_1]',
16948: &Apache::lonlocal::locallocaltime($opendate)).': '.
16949: &Apache::lonnet::cput
16950: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16951: }
16952: #
16953: # Set first page
16954: #
16955: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
16956: || ($cloneid)) {
1.445 albertel 16957: use LONCAPA::map;
1.444 albertel 16958: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 16959:
16960: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
16961: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
16962:
1.444 albertel 16963: $outcome .= ($fatal?$errtext:'read ok').' - ';
16964: my $title; my $url;
16965: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 16966: $title=&mt('Syllabus');
1.444 albertel 16967: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
16968: } else {
1.963 raeburn 16969: $title=&mt('Table of Contents');
1.444 albertel 16970: $url='/adm/navmaps';
16971: }
1.445 albertel 16972:
16973: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
16974: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
16975:
16976: if ($errtext) { $fatal=2; }
1.541 raeburn 16977: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 16978: }
1.566 albertel 16979:
1.1237 raeburn 16980: #
16981: # Set params for Placement Tests
16982: #
1.1239 raeburn 16983: if ($args->{'crstype'} eq 'Placement') {
16984: my %storecontent;
16985: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
16986: my %defaults = (
16987: buttonshide => { value => 'yes',
16988: type => 'string_yesno',},
16989: type => { value => 'randomizetry',
16990: type => 'string_questiontype',},
16991: maxtries => { value => 1,
16992: type => 'int_pos',},
16993: problemstatus => { value => 'no',
16994: type => 'string_problemstatus',},
16995: );
16996: foreach my $key (keys(%defaults)) {
16997: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
16998: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
16999: }
1.1237 raeburn 17000: &Apache::lonnet::cput
17001: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
17002: }
17003:
1.1344 raeburn 17004: return (1,$outcome,\@clonemsg);
1.444 albertel 17005: }
17006:
1.1166 raeburn 17007: sub make_unique_code {
17008: my ($cdom,$cnum) = @_;
17009: # get lock on uniquecodes db
17010: my $lockhash = {
17011: $cnum."\0".'uniquecodes' => $env{'user.name'}.
17012: ':'.$env{'user.domain'},
17013: };
17014: my $tries = 0;
17015: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17016: my ($code,$error);
17017:
17018: while (($gotlock ne 'ok') && ($tries<3)) {
17019: $tries ++;
17020: sleep 1;
17021: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17022: }
17023: if ($gotlock eq 'ok') {
17024: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
17025: my $gotcode;
17026: my $attempts = 0;
17027: while ((!$gotcode) && ($attempts < 100)) {
17028: $code = &generate_code();
17029: if (!exists($currcodes{$code})) {
17030: $gotcode = 1;
17031: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
17032: $error = 'nostore';
17033: }
17034: }
17035: $attempts ++;
17036: }
17037: my @del_lock = ($cnum."\0".'uniquecodes');
17038: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
17039: } else {
17040: $error = 'nolock';
17041: }
17042: return ($code,$error);
17043: }
17044:
17045: sub generate_code {
17046: my $code;
17047: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
17048: for (my $i=0; $i<6; $i++) {
17049: my $lettnum = int (rand 2);
17050: my $item = '';
17051: if ($lettnum) {
17052: $item = $letts[int( rand(18) )];
17053: } else {
17054: $item = 1+int( rand(8) );
17055: }
17056: $code .= $item;
17057: }
17058: return $code;
17059: }
17060:
1.444 albertel 17061: ############################################################
17062: ############################################################
17063:
1.1237 raeburn 17064: # Community, Course and Placement Test
1.378 raeburn 17065: sub course_type {
17066: my ($cid) = @_;
17067: if (!defined($cid)) {
17068: $cid = $env{'request.course.id'};
17069: }
1.404 albertel 17070: if (defined($env{'course.'.$cid.'.type'})) {
17071: return $env{'course.'.$cid.'.type'};
1.378 raeburn 17072: } else {
17073: return 'Course';
1.377 raeburn 17074: }
17075: }
1.156 albertel 17076:
1.406 raeburn 17077: sub group_term {
17078: my $crstype = &course_type();
17079: my %names = (
17080: 'Course' => 'group',
1.865 raeburn 17081: 'Community' => 'group',
1.1237 raeburn 17082: 'Placement' => 'group',
1.406 raeburn 17083: );
17084: return $names{$crstype};
17085: }
17086:
1.902 raeburn 17087: sub course_types {
1.1310 raeburn 17088: my @types = ('official','unofficial','community','textbook','placement','lti');
1.902 raeburn 17089: my %typename = (
17090: official => 'Official course',
17091: unofficial => 'Unofficial course',
17092: community => 'Community',
1.1165 raeburn 17093: textbook => 'Textbook course',
1.1237 raeburn 17094: placement => 'Placement test',
1.1310 raeburn 17095: lti => 'LTI provider',
1.902 raeburn 17096: );
17097: return (\@types,\%typename);
17098: }
17099:
1.156 albertel 17100: sub icon {
17101: my ($file)=@_;
1.505 albertel 17102: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 17103: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 17104: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 17105: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
17106: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
17107: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17108: $curfext.".gif") {
17109: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17110: $curfext.".gif";
17111: }
17112: }
1.249 albertel 17113: return &lonhttpdurl($iconname);
1.154 albertel 17114: }
1.84 albertel 17115:
1.575 albertel 17116: sub lonhttpdurl {
1.692 www 17117: #
17118: # Had been used for "small fry" static images on separate port 8080.
17119: # Modify here if lightweight http functionality desired again.
17120: # Currently eliminated due to increasing firewall issues.
17121: #
1.575 albertel 17122: my ($url)=@_;
1.692 www 17123: return $url;
1.215 albertel 17124: }
17125:
1.213 albertel 17126: sub connection_aborted {
17127: my ($r)=@_;
17128: $r->print(" ");$r->rflush();
17129: my $c = $r->connection;
17130: return $c->aborted();
17131: }
17132:
1.221 foxr 17133: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 17134: # strings as 'strings'.
17135: sub escape_single {
1.221 foxr 17136: my ($input) = @_;
1.223 albertel 17137: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 17138: $input =~ s/\'/\\\'/g; # Esacpe the 's....
17139: return $input;
17140: }
1.223 albertel 17141:
1.222 foxr 17142: # Same as escape_single, but escape's "'s This
17143: # can be used for "strings"
17144: sub escape_double {
17145: my ($input) = @_;
17146: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
17147: $input =~ s/\"/\\\"/g; # Esacpe the "s....
17148: return $input;
17149: }
1.223 albertel 17150:
1.222 foxr 17151: # Escapes the last element of a full URL.
17152: sub escape_url {
17153: my ($url) = @_;
1.238 raeburn 17154: my @urlslices = split(/\//, $url,-1);
1.369 www 17155: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 17156: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 17157: }
1.462 albertel 17158:
1.820 raeburn 17159: sub compare_arrays {
17160: my ($arrayref1,$arrayref2) = @_;
17161: my (@difference,%count);
17162: @difference = ();
17163: %count = ();
17164: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
17165: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
17166: foreach my $element (keys(%count)) {
17167: if ($count{$element} == 1) {
17168: push(@difference,$element);
17169: }
17170: }
17171: }
17172: return @difference;
17173: }
17174:
1.1322 raeburn 17175: sub lon_status_items {
17176: my %defaults = (
17177: E => 100,
17178: W => 4,
17179: N => 1,
1.1324 raeburn 17180: U => 5,
1.1322 raeburn 17181: threshold => 200,
17182: sysmail => 2500,
17183: );
17184: my %names = (
17185: E => 'Errors',
17186: W => 'Warnings',
17187: N => 'Notices',
1.1324 raeburn 17188: U => 'Unsent',
1.1322 raeburn 17189: );
17190: return (\%defaults,\%names);
17191: }
17192:
1.817 bisitz 17193: # -------------------------------------------------------- Initialize user login
1.462 albertel 17194: sub init_user_environment {
1.463 albertel 17195: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 17196: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
17197:
17198: my $public=($username eq 'public' && $domain eq 'public');
17199:
1.1062 raeburn 17200: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 17201: my $now=time;
17202:
17203: if ($public) {
17204: my $max_public=100;
17205: my $oldest;
17206: my $oldest_time=0;
17207: for(my $next=1;$next<=$max_public;$next++) {
17208: if (-e $lonids."/publicuser_$next.id") {
17209: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
17210: if ($mtime<$oldest_time || !$oldest_time) {
17211: $oldest_time=$mtime;
17212: $oldest=$next;
17213: }
17214: } else {
17215: $cookie="publicuser_$next";
17216: last;
17217: }
17218: }
17219: if (!$cookie) { $cookie="publicuser_$oldest"; }
17220: } else {
1.1275 raeburn 17221: # See if old ID present, if so, remove if this isn't a robot,
17222: # killing any existing non-robot sessions
1.463 albertel 17223: if (!$args->{'robot'}) {
17224: opendir(DIR,$lonids);
17225: while ($filename=readdir(DIR)) {
17226: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320 raeburn 17227: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
17228: &GDBM_READER(),0640)) {
1.1295 raeburn 17229: my $linkedfile;
1.1320 raeburn 17230: if (exists($oldenv{'user.linkedenv'})) {
17231: $linkedfile = $oldenv{'user.linkedenv'};
1.1295 raeburn 17232: }
1.1320 raeburn 17233: untie(%oldenv);
17234: if (unlink("$lonids/$filename")) {
17235: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
17236: if (-l "$lonids/$linkedfile.id") {
17237: unlink("$lonids/$linkedfile.id");
17238: }
1.1295 raeburn 17239: }
17240: }
17241: } else {
17242: unlink($lonids.'/'.$filename);
17243: }
1.463 albertel 17244: }
1.462 albertel 17245: }
1.463 albertel 17246: closedir(DIR);
1.1204 raeburn 17247: # If there is a undeleted lockfile for the user's paste buffer remove it.
17248: my $namespace = 'nohist_courseeditor';
17249: my $lockingkey = 'paste'."\0".'locked_num';
17250: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
17251: $domain,$username);
17252: if (exists($lockhash{$lockingkey})) {
17253: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
17254: unless ($delresult eq 'ok') {
17255: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
17256: }
17257: }
1.462 albertel 17258: }
17259: # Give them a new cookie
1.463 albertel 17260: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 17261: : $now.$$.int(rand(10000)));
1.463 albertel 17262: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 17263:
17264: # Initialize roles
17265:
1.1062 raeburn 17266: ($userroles,$firstaccenv,$timerintenv) =
17267: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 17268: }
17269: # ------------------------------------ Check browser type and MathML capability
17270:
1.1194 raeburn 17271: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
17272: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 17273:
17274: # ------------------------------------------------------------- Get environment
17275:
17276: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
17277: my ($tmp) = keys(%userenv);
1.1275 raeburn 17278: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 17279: undef(%userenv);
17280: }
17281: if (($userenv{'interface'}) && (!$form->{'interface'})) {
17282: $form->{'interface'}=$userenv{'interface'};
17283: }
17284: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
17285:
17286: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 17287: foreach my $option ('interface','localpath','localres') {
17288: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 17289: }
17290: # --------------------------------------------------------- Write first profile
17291:
17292: {
1.1350 raeburn 17293: my $ip = &Apache::lonnet::get_requestor_ip($r);
1.462 albertel 17294: my %initial_env =
17295: ("user.name" => $username,
17296: "user.domain" => $domain,
17297: "user.home" => $authhost,
17298: "browser.type" => $clientbrowser,
17299: "browser.version" => $clientversion,
17300: "browser.mathml" => $clientmathml,
17301: "browser.unicode" => $clientunicode,
17302: "browser.os" => $clientos,
1.1137 raeburn 17303: "browser.mobile" => $clientmobile,
1.1141 raeburn 17304: "browser.info" => $clientinfo,
1.1194 raeburn 17305: "browser.osversion" => $clientosversion,
1.462 albertel 17306: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
17307: "request.course.fn" => '',
17308: "request.course.uri" => '',
17309: "request.course.sec" => '',
17310: "request.role" => 'cm',
17311: "request.role.adv" => $env{'user.adv'},
1.1350 raeburn 17312: "request.host" => $ip,);
1.462 albertel 17313:
17314: if ($form->{'localpath'}) {
17315: $initial_env{"browser.localpath"} = $form->{'localpath'};
17316: $initial_env{"browser.localres"} = $form->{'localres'};
17317: }
17318:
17319: if ($form->{'interface'}) {
17320: $form->{'interface'}=~s/\W//gs;
17321: $initial_env{"browser.interface"} = $form->{'interface'};
17322: $env{'browser.interface'}=$form->{'interface'};
17323: }
17324:
1.1157 raeburn 17325: if ($form->{'iptoken'}) {
17326: my $lonhost = $r->dir_config('lonHostID');
17327: $initial_env{"user.noloadbalance"} = $lonhost;
17328: $env{'user.noloadbalance'} = $lonhost;
17329: }
17330:
1.1268 raeburn 17331: if ($form->{'noloadbalance'}) {
17332: my @hosts = &Apache::lonnet::current_machine_ids();
17333: my $hosthere = $form->{'noloadbalance'};
17334: if (grep(/^\Q$hosthere\E$/,@hosts)) {
17335: $initial_env{"user.noloadbalance"} = $hosthere;
17336: $env{'user.noloadbalance'} = $hosthere;
17337: }
17338: }
17339:
1.1016 raeburn 17340: unless ($domain eq 'public') {
1.1273 raeburn 17341: my %is_adv = ( is_adv => $env{'user.adv'} );
17342: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
17343:
17344: foreach my $tool ('aboutme','blog','webdav','portfolio') {
17345: $userenv{'availabletools.'.$tool} =
17346: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
17347: undef,\%userenv,\%domdef,\%is_adv);
17348: }
1.980 raeburn 17349:
1.1311 raeburn 17350: foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273 raeburn 17351: $userenv{'canrequest.'.$crstype} =
17352: &Apache::lonnet::usertools_access($username,$domain,$crstype,
17353: 'reload','requestcourses',
17354: \%userenv,\%domdef,\%is_adv);
17355: }
1.724 raeburn 17356:
1.1273 raeburn 17357: $userenv{'canrequest.author'} =
17358: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
17359: 'reload','requestauthor',
1.980 raeburn 17360: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 17361: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
17362: $domain,$username);
17363: my $reqstatus = $reqauthor{'author_status'};
17364: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
17365: if (ref($reqauthor{'author'}) eq 'HASH') {
17366: $userenv{'requestauthorqueued'} = $reqstatus.':'.
17367: $reqauthor{'author'}{'timestamp'};
17368: }
1.1092 raeburn 17369: }
1.1287 raeburn 17370: my ($types,$typename) = &course_types();
17371: if (ref($types) eq 'ARRAY') {
17372: my @options = ('approval','validate','autolimit');
17373: my $optregex = join('|',@options);
17374: my (%willtrust,%trustchecked);
17375: foreach my $type (@{$types}) {
17376: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
17377: if ($dom_str ne '') {
17378: my $updatedstr = '';
17379: my @possdomains = split(',',$dom_str);
17380: foreach my $entry (@possdomains) {
17381: my ($extdom,$extopt) = split(':',$entry);
17382: unless ($trustchecked{$extdom}) {
17383: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
17384: $trustchecked{$extdom} = 1;
17385: }
17386: if ($willtrust{$extdom}) {
17387: $updatedstr .= $entry.',';
17388: }
17389: }
17390: $updatedstr =~ s/,$//;
17391: if ($updatedstr) {
17392: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
17393: } else {
17394: delete($userenv{'reqcrsotherdom.'.$type});
17395: }
17396: }
17397: }
17398: }
1.1092 raeburn 17399: }
1.462 albertel 17400: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 17401:
1.462 albertel 17402: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
17403: &GDBM_WRCREAT(),0640)) {
17404: &_add_to_env(\%disk_env,\%initial_env);
17405: &_add_to_env(\%disk_env,\%userenv,'environment.');
17406: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 17407: if (ref($firstaccenv) eq 'HASH') {
17408: &_add_to_env(\%disk_env,$firstaccenv);
17409: }
17410: if (ref($timerintenv) eq 'HASH') {
17411: &_add_to_env(\%disk_env,$timerintenv);
17412: }
1.463 albertel 17413: if (ref($args->{'extra_env'})) {
17414: &_add_to_env(\%disk_env,$args->{'extra_env'});
17415: }
1.462 albertel 17416: untie(%disk_env);
17417: } else {
1.705 tempelho 17418: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
17419: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 17420: return 'error: '.$!;
17421: }
17422: }
17423: $env{'request.role'}='cm';
17424: $env{'request.role.adv'}=$env{'user.adv'};
17425: $env{'browser.type'}=$clientbrowser;
17426:
17427: return $cookie;
17428:
17429: }
17430:
17431: sub _add_to_env {
17432: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 17433: if (ref($env_data) eq 'HASH') {
17434: while (my ($key,$value) = each(%$env_data)) {
17435: $idf->{$prefix.$key} = $value;
17436: $env{$prefix.$key} = $value;
17437: }
1.462 albertel 17438: }
17439: }
17440:
1.685 tempelho 17441: # --- Get the symbolic name of a problem and the url
17442: sub get_symb {
17443: my ($request,$silent) = @_;
1.726 raeburn 17444: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 17445: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
17446: if ($symb eq '') {
17447: if (!$silent) {
1.1071 raeburn 17448: if (ref($request)) {
17449: $request->print("Unable to handle ambiguous references:$url:.");
17450: }
1.685 tempelho 17451: return ();
17452: }
17453: }
17454: &Apache::lonenc::check_decrypt(\$symb);
17455: return ($symb);
17456: }
17457:
17458: # --------------------------------------------------------------Get annotation
17459:
17460: sub get_annotation {
17461: my ($symb,$enc) = @_;
17462:
17463: my $key = $symb;
17464: if (!$enc) {
17465: $key =
17466: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
17467: }
17468: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
17469: return $annotation{$key};
17470: }
17471:
17472: sub clean_symb {
1.731 raeburn 17473: my ($symb,$delete_enc) = @_;
1.685 tempelho 17474:
17475: &Apache::lonenc::check_decrypt(\$symb);
17476: my $enc = $env{'request.enc'};
1.731 raeburn 17477: if ($delete_enc) {
1.730 raeburn 17478: delete($env{'request.enc'});
17479: }
1.685 tempelho 17480:
17481: return ($symb,$enc);
17482: }
1.462 albertel 17483:
1.1181 raeburn 17484: ############################################################
17485: ############################################################
17486:
17487: =pod
17488:
17489: =head1 Routines for building display used to search for courses
17490:
17491:
17492: =over 4
17493:
17494: =item * &build_filters()
17495:
17496: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 17497: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
17498: and quotacheck.pl
17499:
1.1181 raeburn 17500:
17501: Inputs:
17502:
17503: filterlist - anonymous array of fields to include as potential filters
17504:
17505: crstype - course type
17506:
17507: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
17508: to pop-open a course selector (will contain "extra element").
17509:
17510: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
17511:
17512: filter - anonymous hash of criteria and their values
17513:
17514: action - form action
17515:
17516: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
17517:
1.1182 raeburn 17518: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 17519:
17520: cloneruname - username of owner of new course who wants to clone
17521:
17522: clonerudom - domain of owner of new course who wants to clone
17523:
17524: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
17525:
17526: codetitlesref - reference to array of titles of components in institutional codes (official courses)
17527:
17528: codedom - domain
17529:
17530: formname - value of form element named "form".
17531:
17532: fixeddom - domain, if fixed.
17533:
17534: prevphase - value to assign to form element named "phase" when going back to the previous screen
17535:
17536: cnameelement - name of form element in form on opener page which will receive title of selected course
17537:
17538: cnumelement - name of form element in form on opener page which will receive courseID of selected course
17539:
17540: cdomelement - name of form element in form on opener page which will receive domain of selected course
17541:
17542: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
17543:
17544: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
17545:
17546: clonewarning - warning message about missing information for intended course owner when DC creates a course
17547:
1.1182 raeburn 17548:
1.1181 raeburn 17549: Returns: $output - HTML for display of search criteria, and hidden form elements.
17550:
1.1182 raeburn 17551:
1.1181 raeburn 17552: Side Effects: None
17553:
17554: =cut
17555:
17556: # ---------------------------------------------- search for courses based on last activity etc.
17557:
17558: sub build_filters {
17559: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
17560: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
17561: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
17562: $cnameelement,$cnumelement,$cdomelement,$setroles,
17563: $clonetext,$clonewarning) = @_;
1.1182 raeburn 17564: my ($list,$jscript);
1.1181 raeburn 17565: my $onchange = 'javascript:updateFilters(this)';
17566: my ($domainselectform,$sincefilterform,$createdfilterform,
17567: $ownerdomselectform,$persondomselectform,$instcodeform,
17568: $typeselectform,$instcodetitle);
17569: if ($formname eq '') {
17570: $formname = $caller;
17571: }
17572: foreach my $item (@{$filterlist}) {
17573: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
17574: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
17575: if ($item eq 'domainfilter') {
17576: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
17577: } elsif ($item eq 'coursefilter') {
17578: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
17579: } elsif ($item eq 'ownerfilter') {
17580: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17581: } elsif ($item eq 'ownerdomfilter') {
17582: $filter->{'ownerdomfilter'} =
17583: &LONCAPA::clean_domain($filter->{$item});
17584: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
17585: 'ownerdomfilter',1);
17586: } elsif ($item eq 'personfilter') {
17587: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17588: } elsif ($item eq 'persondomfilter') {
17589: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
17590: 'persondomfilter',1);
17591: } else {
17592: $filter->{$item} =~ s/\W//g;
17593: }
17594: if (!$filter->{$item}) {
17595: $filter->{$item} = '';
17596: }
17597: }
17598: if ($item eq 'domainfilter') {
17599: my $allow_blank = 1;
17600: if ($formname eq 'portform') {
17601: $allow_blank=0;
17602: } elsif ($formname eq 'studentform') {
17603: $allow_blank=0;
17604: }
17605: if ($fixeddom) {
17606: $domainselectform = '<input type="hidden" name="domainfilter"'.
17607: ' value="'.$codedom.'" />'.
17608: &Apache::lonnet::domain($codedom,'description');
17609: } else {
17610: $domainselectform = &select_dom_form($filter->{$item},
17611: 'domainfilter',
17612: $allow_blank,'',$onchange);
17613: }
17614: } else {
17615: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
17616: }
17617: }
17618:
17619: # last course activity filter and selection
17620: $sincefilterform = &timebased_select_form('sincefilter',$filter);
17621:
17622: # course created filter and selection
17623: if (exists($filter->{'createdfilter'})) {
17624: $createdfilterform = &timebased_select_form('createdfilter',$filter);
17625: }
17626:
1.1239 raeburn 17627: my $prefix = $crstype;
17628: if ($crstype eq 'Placement') {
17629: $prefix = 'Placement Test'
17630: }
1.1181 raeburn 17631: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 17632: 'cac' => "$prefix Activity",
17633: 'ccr' => "$prefix Created",
17634: 'cde' => "$prefix Title",
17635: 'cdo' => "$prefix Domain",
1.1181 raeburn 17636: 'ins' => 'Institutional Code',
17637: 'inc' => 'Institutional Categorization',
1.1239 raeburn 17638: 'cow' => "$prefix Owner/Co-owner",
17639: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 17640: 'cog' => 'Type',
17641: );
17642:
17643: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17644: my $typeval = 'Course';
17645: if ($crstype eq 'Community') {
17646: $typeval = 'Community';
1.1239 raeburn 17647: } elsif ($crstype eq 'Placement') {
17648: $typeval = 'Placement';
1.1181 raeburn 17649: }
17650: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
17651: } else {
17652: $typeselectform = '<select name="type" size="1"';
17653: if ($onchange) {
17654: $typeselectform .= ' onchange="'.$onchange.'"';
17655: }
17656: $typeselectform .= '>'."\n";
1.1237 raeburn 17657: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 17658: my $shown;
17659: if ($posstype eq 'Placement') {
17660: $shown = &mt('Placement Test');
17661: } else {
17662: $shown = &mt($posstype);
17663: }
1.1181 raeburn 17664: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 17665: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 17666: }
17667: $typeselectform.="</select>";
17668: }
17669:
17670: my ($cloneableonlyform,$cloneabletitle);
17671: if (exists($filter->{'cloneableonly'})) {
17672: my $cloneableon = '';
17673: my $cloneableoff = ' checked="checked"';
17674: if ($filter->{'cloneableonly'}) {
17675: $cloneableon = $cloneableoff;
17676: $cloneableoff = '';
17677: }
17678: $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>';
17679: if ($formname eq 'ccrs') {
1.1187 bisitz 17680: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 17681: } else {
17682: $cloneabletitle = &mt('Cloneable by you');
17683: }
17684: }
17685: my $officialjs;
17686: if ($crstype eq 'Course') {
17687: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 17688: # if (($fixeddom) || ($formname eq 'requestcrs') ||
17689: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
17690: if ($codedom) {
1.1181 raeburn 17691: $officialjs = 1;
17692: ($instcodeform,$jscript,$$numtitlesref) =
17693: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
17694: $officialjs,$codetitlesref);
17695: if ($jscript) {
1.1182 raeburn 17696: $jscript = '<script type="text/javascript">'."\n".
17697: '// <![CDATA['."\n".
17698: $jscript."\n".
17699: '// ]]>'."\n".
17700: '</script>'."\n";
1.1181 raeburn 17701: }
17702: }
17703: if ($instcodeform eq '') {
17704: $instcodeform =
17705: '<input type="text" name="instcodefilter" size="10" value="'.
17706: $list->{'instcodefilter'}.'" />';
17707: $instcodetitle = $lt{'ins'};
17708: } else {
17709: $instcodetitle = $lt{'inc'};
17710: }
17711: if ($fixeddom) {
17712: $instcodetitle .= '<br />('.$codedom.')';
17713: }
17714: }
17715: }
17716: my $output = qq|
17717: <form method="post" name="filterpicker" action="$action">
17718: <input type="hidden" name="form" value="$formname" />
17719: |;
17720: if ($formname eq 'modifycourse') {
17721: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
17722: '<input type="hidden" name="prevphase" value="'.
17723: $prevphase.'" />'."\n";
1.1198 musolffc 17724: } elsif ($formname eq 'quotacheck') {
17725: $output .= qq|
17726: <input type="hidden" name="sortby" value="" />
17727: <input type="hidden" name="sortorder" value="" />
17728: |;
17729: } else {
1.1181 raeburn 17730: my $name_input;
17731: if ($cnameelement ne '') {
17732: $name_input = '<input type="hidden" name="cnameelement" value="'.
17733: $cnameelement.'" />';
17734: }
17735: $output .= qq|
1.1182 raeburn 17736: <input type="hidden" name="cnumelement" value="$cnumelement" />
17737: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 17738: $name_input
17739: $roleelement
17740: $multelement
17741: $typeelement
17742: |;
17743: if ($formname eq 'portform') {
17744: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
17745: }
17746: }
17747: if ($fixeddom) {
17748: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
17749: }
17750: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
17751: if ($sincefilterform) {
17752: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
17753: .$sincefilterform
17754: .&Apache::lonhtmlcommon::row_closure();
17755: }
17756: if ($createdfilterform) {
17757: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
17758: .$createdfilterform
17759: .&Apache::lonhtmlcommon::row_closure();
17760: }
17761: if ($domainselectform) {
17762: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
17763: .$domainselectform
17764: .&Apache::lonhtmlcommon::row_closure();
17765: }
17766: if ($typeselectform) {
17767: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17768: $output .= $typeselectform;
17769: } else {
17770: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
17771: .$typeselectform
17772: .&Apache::lonhtmlcommon::row_closure();
17773: }
17774: }
17775: if ($instcodeform) {
17776: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
17777: .$instcodeform
17778: .&Apache::lonhtmlcommon::row_closure();
17779: }
17780: if (exists($filter->{'ownerfilter'})) {
17781: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
17782: '<table><tr><td>'.&mt('Username').'<br />'.
17783: '<input type="text" name="ownerfilter" size="20" value="'.
17784: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17785: $ownerdomselectform.'</td></tr></table>'.
17786: &Apache::lonhtmlcommon::row_closure();
17787: }
17788: if (exists($filter->{'personfilter'})) {
17789: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
17790: '<table><tr><td>'.&mt('Username').'<br />'.
17791: '<input type="text" name="personfilter" size="20" value="'.
17792: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17793: $persondomselectform.'</td></tr></table>'.
17794: &Apache::lonhtmlcommon::row_closure();
17795: }
17796: if (exists($filter->{'coursefilter'})) {
17797: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
17798: .'<input type="text" name="coursefilter" size="25" value="'
17799: .$list->{'coursefilter'}.'" />'
17800: .&Apache::lonhtmlcommon::row_closure();
17801: }
17802: if ($cloneableonlyform) {
17803: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
17804: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
17805: }
17806: if (exists($filter->{'descriptfilter'})) {
17807: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
17808: .'<input type="text" name="descriptfilter" size="40" value="'
17809: .$list->{'descriptfilter'}.'" />'
17810: .&Apache::lonhtmlcommon::row_closure(1);
17811: }
17812: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
17813: '<input type="hidden" name="updater" value="" />'."\n".
17814: '<input type="submit" name="gosearch" value="'.
17815: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
17816: return $jscript.$clonewarning.$output;
17817: }
17818:
17819: =pod
17820:
17821: =item * &timebased_select_form()
17822:
1.1182 raeburn 17823: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 17824: filter e.g., Course Activity, Course Created, when searching for courses
17825: or communities
17826:
17827: Inputs:
17828:
17829: item - name of form element (sincefilter or createdfilter)
17830:
17831: filter - anonymous hash of criteria and their values
17832:
17833: Returns: HTML for a select box contained a blank, then six time selections,
17834: with value set in incoming form variables currently selected.
17835:
17836: Side Effects: None
17837:
17838: =cut
17839:
17840: sub timebased_select_form {
17841: my ($item,$filter) = @_;
17842: if (ref($filter) eq 'HASH') {
17843: $filter->{$item} =~ s/[^\d-]//g;
17844: if (!$filter->{$item}) { $filter->{$item}=-1; }
17845: return &select_form(
17846: $filter->{$item},
17847: $item,
17848: { '-1' => '',
17849: '86400' => &mt('today'),
17850: '604800' => &mt('last week'),
17851: '2592000' => &mt('last month'),
17852: '7776000' => &mt('last three months'),
17853: '15552000' => &mt('last six months'),
17854: '31104000' => &mt('last year'),
17855: 'select_form_order' =>
17856: ['-1','86400','604800','2592000','7776000',
17857: '15552000','31104000']});
17858: }
17859: }
17860:
17861: =pod
17862:
17863: =item * &js_changer()
17864:
17865: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 17866: when course type or domain is changed, and also to hide 'Searching ...' on
17867: page load completion for page showing search result.
1.1181 raeburn 17868:
17869: Inputs: None
17870:
1.1183 raeburn 17871: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 17872:
17873: Side Effects: None
17874:
17875: =cut
17876:
17877: sub js_changer {
17878: return <<ENDJS;
17879: <script type="text/javascript">
17880: // <![CDATA[
17881: function updateFilters(caller) {
17882: if (typeof(caller) != "undefined") {
17883: document.filterpicker.updater.value = caller.name;
17884: }
17885: document.filterpicker.submit();
17886: }
1.1183 raeburn 17887:
17888: function hideSearching() {
17889: if (document.getElementById('searching')) {
17890: document.getElementById('searching').style.display = 'none';
17891: }
17892: return;
17893: }
17894:
1.1181 raeburn 17895: // ]]>
17896: </script>
17897:
17898: ENDJS
17899: }
17900:
17901: =pod
17902:
1.1182 raeburn 17903: =item * &search_courses()
17904:
17905: Process selected filters form course search form and pass to lonnet::courseiddump
17906: to retrieve a hash for which keys are courseIDs which match the selected filters.
17907:
17908: Inputs:
17909:
17910: dom - domain being searched
17911:
17912: type - course type ('Course' or 'Community' or '.' if any).
17913:
17914: filter - anonymous hash of criteria and their values
17915:
17916: numtitles - for institutional codes - number of categories
17917:
17918: cloneruname - optional username of new course owner
17919:
17920: clonerudom - optional domain of new course owner
17921:
1.1221 raeburn 17922: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 17923: (used when DC is using course creation form)
17924:
17925: codetitles - reference to array of titles of components in institutional codes (official courses).
17926:
1.1221 raeburn 17927: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
17928: (and so can clone automatically)
17929:
17930: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
17931:
17932: reqinstcode - institutional code of new course, where search_courses is used to identify potential
17933: courses to clone
1.1182 raeburn 17934:
17935: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
17936:
17937:
17938: Side Effects: None
17939:
17940: =cut
17941:
17942:
17943: sub search_courses {
1.1221 raeburn 17944: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
17945: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 17946: my (%courses,%showcourses,$cloner);
17947: if (($filter->{'ownerfilter'} ne '') ||
17948: ($filter->{'ownerdomfilter'} ne '')) {
17949: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
17950: $filter->{'ownerdomfilter'};
17951: }
17952: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
17953: if (!$filter->{$item}) {
17954: $filter->{$item}='.';
17955: }
17956: }
17957: my $now = time;
17958: my $timefilter =
17959: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
17960: my ($createdbefore,$createdafter);
17961: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
17962: $createdbefore = $now;
17963: $createdafter = $now-$filter->{'createdfilter'};
17964: }
17965: my ($instcodefilter,$regexpok);
17966: if ($numtitles) {
17967: if ($env{'form.official'} eq 'on') {
17968: $instcodefilter =
17969: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17970: $regexpok = 1;
17971: } elsif ($env{'form.official'} eq 'off') {
17972: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17973: unless ($instcodefilter eq '') {
17974: $regexpok = -1;
17975: }
17976: }
17977: } else {
17978: $instcodefilter = $filter->{'instcodefilter'};
17979: }
17980: if ($instcodefilter eq '') { $instcodefilter = '.'; }
17981: if ($type eq '') { $type = '.'; }
17982:
17983: if (($clonerudom ne '') && ($cloneruname ne '')) {
17984: $cloner = $cloneruname.':'.$clonerudom;
17985: }
17986: %courses = &Apache::lonnet::courseiddump($dom,
17987: $filter->{'descriptfilter'},
17988: $timefilter,
17989: $instcodefilter,
17990: $filter->{'combownerfilter'},
17991: $filter->{'coursefilter'},
17992: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 17993: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 17994: $filter->{'cloneableonly'},
17995: $createdbefore,$createdafter,undef,
1.1221 raeburn 17996: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 17997: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
17998: my $ccrole;
17999: if ($type eq 'Community') {
18000: $ccrole = 'co';
18001: } else {
18002: $ccrole = 'cc';
18003: }
18004: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
18005: $filter->{'persondomfilter'},
18006: 'userroles',undef,
18007: [$ccrole,'in','ad','ep','ta','cr'],
18008: $dom);
18009: foreach my $role (keys(%rolehash)) {
18010: my ($cnum,$cdom,$courserole) = split(':',$role);
18011: my $cid = $cdom.'_'.$cnum;
18012: if (exists($courses{$cid})) {
18013: if (ref($courses{$cid}) eq 'HASH') {
18014: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
18015: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 18016: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 18017: }
18018: } else {
18019: $courses{$cid}{roles} = [$courserole];
18020: }
18021: $showcourses{$cid} = $courses{$cid};
18022: }
18023: }
18024: }
18025: %courses = %showcourses;
18026: }
18027: return %courses;
18028: }
18029:
18030: =pod
18031:
1.1181 raeburn 18032: =back
18033:
1.1207 raeburn 18034: =head1 Routines for version requirements for current course.
18035:
18036: =over 4
18037:
18038: =item * &check_release_required()
18039:
18040: Compares required LON-CAPA version with version on server, and
18041: if required version is newer looks for a server with the required version.
18042:
18043: Looks first at servers in user's owen domain; if none suitable, looks at
18044: servers in course's domain are permitted to host sessions for user's domain.
18045:
18046: Inputs:
18047:
18048: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18049:
18050: $courseid - Course ID of current course
18051:
18052: $rolecode - User's current role in course (for switchserver query string).
18053:
18054: $required - LON-CAPA version needed by course (format: Major.Minor).
18055:
18056:
18057: Returns:
18058:
18059: $switchserver - query string tp append to /adm/switchserver call (if
18060: current server's LON-CAPA version is too old.
18061:
18062: $warning - Message is displayed if no suitable server could be found.
18063:
18064: =cut
18065:
18066: sub check_release_required {
18067: my ($loncaparev,$courseid,$rolecode,$required) = @_;
18068: my ($switchserver,$warning);
18069: if ($required ne '') {
18070: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
18071: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18072: if ($reqdmajor ne '' && $reqdminor ne '') {
18073: my $otherserver;
18074: if (($major eq '' && $minor eq '') ||
18075: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
18076: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
18077: my $switchlcrev =
18078: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
18079: $userdomserver);
18080: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18081: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
18082: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
18083: my $cdom = $env{'course.'.$courseid.'.domain'};
18084: if ($cdom ne $env{'user.domain'}) {
18085: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
18086: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
18087: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
18088: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
18089: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
18090: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
18091: my $canhost =
18092: &Apache::lonnet::can_host_session($env{'user.domain'},
18093: $coursedomserver,
18094: $remoterev,
18095: $udomdefaults{'remotesessions'},
18096: $defdomdefaults{'hostedsessions'});
18097:
18098: if ($canhost) {
18099: $otherserver = $coursedomserver;
18100: } else {
18101: $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.");
18102: }
18103: } else {
18104: $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).");
18105: }
18106: } else {
18107: $otherserver = $userdomserver;
18108: }
18109: }
18110: if ($otherserver ne '') {
18111: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
18112: }
18113: }
18114: }
18115: return ($switchserver,$warning);
18116: }
18117:
18118: =pod
18119:
18120: =item * &check_release_result()
18121:
18122: Inputs:
18123:
18124: $switchwarning - Warning message if no suitable server found to host session.
18125:
18126: $switchserver - query string to append to /adm/switchserver containing lonHostID
18127: and current role.
18128:
18129: Returns: HTML to display with information about requirement to switch server.
18130: Either displaying warning with link to Roles/Courses screen or
18131: display link to switchserver.
18132:
1.1181 raeburn 18133: =cut
18134:
1.1207 raeburn 18135: sub check_release_result {
18136: my ($switchwarning,$switchserver) = @_;
18137: my $output = &start_page('Selected course unavailable on this server').
18138: '<p class="LC_warning">';
18139: if ($switchwarning) {
18140: $output .= $switchwarning.'<br /><a href="/adm/roles">';
18141: if (&show_course()) {
18142: $output .= &mt('Display courses');
18143: } else {
18144: $output .= &mt('Display roles');
18145: }
18146: $output .= '</a>';
18147: } elsif ($switchserver) {
18148: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
18149: '<br />'.
18150: '<a href="/adm/switchserver?'.$switchserver.'">'.
18151: &mt('Switch Server').
18152: '</a>';
18153: }
18154: $output .= '</p>'.&end_page();
18155: return $output;
18156: }
18157:
18158: =pod
18159:
18160: =item * &needs_coursereinit()
18161:
18162: Determine if course contents stored for user's session needs to be
18163: refreshed, because content has changed since "Big Hash" last tied.
18164:
18165: Check for change is made if time last checked is more than 10 minutes ago
18166: (by default).
18167:
18168: Inputs:
18169:
18170: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18171:
18172: $interval (optional) - Time which may elapse (in s) between last check for content
18173: change in current course. (default: 600 s).
18174:
18175: Returns: an array; first element is:
18176:
18177: =over 4
18178:
18179: 'switch' - if content updates mean user's session
18180: needs to be switched to a server running a newer LON-CAPA version
18181:
18182: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
18183: on current server hosting user's session
18184:
18185: '' - if no action required.
18186:
18187: =back
18188:
18189: If first item element is 'switch':
18190:
18191: second item is $switchwarning - Warning message if no suitable server found to host session.
18192:
18193: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
18194: and current role.
18195:
18196: otherwise: no other elements returned.
18197:
18198: =back
18199:
18200: =cut
18201:
18202: sub needs_coursereinit {
18203: my ($loncaparev,$interval) = @_;
18204: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
18205: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18206: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
18207: my $now = time;
18208: if ($interval eq '') {
18209: $interval = 600;
18210: }
18211: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 18212: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1372 raeburn 18213: my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 18214: if ($blocked) {
18215: return ();
18216: }
1.1207 raeburn 18217: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
18218: if ($lastchange > $env{'request.course.tied'}) {
18219: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18220: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
18221: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
18222: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
18223: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
18224: $curr_reqd_hash{'internal.releaserequired'}});
18225: my ($switchserver,$switchwarning) =
18226: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
18227: $curr_reqd_hash{'internal.releaserequired'});
18228: if ($switchwarning ne '' || $switchserver ne '') {
18229: return ('switch',$switchwarning,$switchserver);
18230: }
18231: }
18232: }
18233: return ('update');
18234: }
18235: }
18236: return ();
18237: }
1.1181 raeburn 18238:
1.1083 raeburn 18239: sub update_content_constraints {
1.1326 raeburn 18240: my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
1.1083 raeburn 18241: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18242: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 18243: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 18244: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 18245: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 18246: if ($item eq 'resourcetag') {
18247: if ($name eq 'responsetype') {
18248: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
18249: }
1.1307 raeburn 18250: } elsif ($item eq 'course') {
18251: if ($name eq 'courserestype') {
18252: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
18253: }
1.1083 raeburn 18254: }
18255: }
18256: my $navmap = Apache::lonnavmaps::navmap->new();
18257: if (defined($navmap)) {
1.1307 raeburn 18258: my (%allresponses,%allcrsrestypes);
18259: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
18260: if ($res->is_tool()) {
18261: if ($allcrsrestypes{'exttool'}) {
18262: $allcrsrestypes{'exttool'} ++;
18263: } else {
18264: $allcrsrestypes{'exttool'} = 1;
18265: }
18266: next;
18267: }
1.1083 raeburn 18268: my %responses = $res->responseTypes();
18269: foreach my $key (keys(%responses)) {
18270: next unless(exists($checkresponsetypes{$key}));
18271: $allresponses{$key} += $responses{$key};
18272: }
18273: }
18274: foreach my $key (keys(%allresponses)) {
18275: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
18276: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18277: ($reqdmajor,$reqdminor) = ($major,$minor);
18278: }
18279: }
1.1307 raeburn 18280: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 18281: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 18282: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18283: ($reqdmajor,$reqdminor) = ($major,$minor);
18284: }
18285: }
1.1083 raeburn 18286: undef($navmap);
18287: }
1.1326 raeburn 18288: my (@resources,@order,@resparms,@zombies);
18289: if ($keeporder) {
18290: use LONCAPA::map;
18291: @resources = @LONCAPA::map::resources;
18292: @order = @LONCAPA::map::order;
18293: @resparms = @LONCAPA::map::resparms;
18294: @zombies = @LONCAPA::map::zombies;
18295: }
1.1308 raeburn 18296: my $suppmap = 'supplemental.sequence';
18297: my ($suppcount,$supptools,$errors) = (0,0,0);
18298: ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
18299: $suppcount,$supptools,$errors);
1.1326 raeburn 18300: if ($keeporder) {
18301: @LONCAPA::map::resources = @resources;
18302: @LONCAPA::map::order = @order;
18303: @LONCAPA::map::resparms = @resparms;
18304: @LONCAPA::map::zombies = @zombies;
18305: }
1.1308 raeburn 18306: if ($supptools) {
18307: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
18308: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18309: ($reqdmajor,$reqdminor) = ($major,$minor);
18310: }
18311: }
1.1083 raeburn 18312: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
18313: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
18314: }
18315: return;
18316: }
18317:
1.1110 raeburn 18318: sub allmaps_incourse {
18319: my ($cdom,$cnum,$chome,$cid) = @_;
18320: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
18321: $cid = $env{'request.course.id'};
18322: $cdom = $env{'course.'.$cid.'.domain'};
18323: $cnum = $env{'course.'.$cid.'.num'};
18324: $chome = $env{'course.'.$cid.'.home'};
18325: }
18326: my %allmaps = ();
18327: my $lastchange =
18328: &Apache::lonnet::get_coursechange($cdom,$cnum);
18329: if ($lastchange > $env{'request.course.tied'}) {
18330: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
18331: unless ($ferr) {
1.1326 raeburn 18332: &update_content_constraints($cdom,$cnum,$chome,$cid,1);
1.1110 raeburn 18333: }
18334: }
18335: my $navmap = Apache::lonnavmaps::navmap->new();
18336: if (defined($navmap)) {
18337: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
18338: $allmaps{$res->src()} = 1;
18339: }
18340: }
18341: return \%allmaps;
18342: }
18343:
1.1083 raeburn 18344: sub parse_supplemental_title {
18345: my ($title) = @_;
18346:
18347: my ($foldertitle,$renametitle);
18348: if ($title =~ /&&&/) {
18349: $title = &HTML::Entites::decode($title);
18350: }
18351: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
18352: $renametitle=$4;
18353: my ($time,$uname,$udom) = ($1,$2,$3);
18354: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
18355: my $name = &plainname($uname,$udom);
18356: $name = &HTML::Entities::encode($name,'"<>&\'');
18357: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
18358: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
18359: $name.': <br />'.$foldertitle;
18360: }
18361: if (wantarray) {
18362: return ($title,$foldertitle,$renametitle);
18363: }
18364: return $title;
18365: }
18366:
1.1143 raeburn 18367: sub recurse_supplemental {
1.1308 raeburn 18368: my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
1.1143 raeburn 18369: if ($suppmap) {
18370: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
18371: if ($fatal) {
18372: $errors ++;
18373: } else {
18374: if ($#LONCAPA::map::resources > 0) {
18375: foreach my $res (@LONCAPA::map::resources) {
18376: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
18377: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 18378: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1308 raeburn 18379: ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
18380: $numfiles,$numexttools,$errors);
1.1143 raeburn 18381: } else {
1.1308 raeburn 18382: if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
18383: $numexttools ++;
18384: }
1.1143 raeburn 18385: $numfiles ++;
18386: }
18387: }
18388: }
18389: }
18390: }
18391: }
1.1308 raeburn 18392: return ($numfiles,$numexttools,$errors);
1.1143 raeburn 18393: }
18394:
1.1101 raeburn 18395: sub symb_to_docspath {
1.1267 raeburn 18396: my ($symb,$navmapref) = @_;
18397: return unless ($symb && ref($navmapref));
1.1101 raeburn 18398: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
18399: if ($resurl=~/\.(sequence|page)$/) {
18400: $mapurl=$resurl;
18401: } elsif ($resurl eq 'adm/navmaps') {
18402: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
18403: }
18404: my $mapresobj;
1.1267 raeburn 18405: unless (ref($$navmapref)) {
18406: $$navmapref = Apache::lonnavmaps::navmap->new();
18407: }
18408: if (ref($$navmapref)) {
18409: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 18410: }
18411: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
18412: my $type=$2;
18413: my $path;
18414: if (ref($mapresobj)) {
18415: my $pcslist = $mapresobj->map_hierarchy();
18416: if ($pcslist ne '') {
18417: foreach my $pc (split(/,/,$pcslist)) {
18418: next if ($pc <= 1);
1.1267 raeburn 18419: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 18420: if (ref($res)) {
18421: my $thisurl = $res->src();
18422: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
18423: my $thistitle = $res->title();
18424: $path .= '&'.
18425: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 18426: &escape($thistitle).
1.1101 raeburn 18427: ':'.$res->randompick().
18428: ':'.$res->randomout().
18429: ':'.$res->encrypted().
18430: ':'.$res->randomorder().
18431: ':'.$res->is_page();
18432: }
18433: }
18434: }
18435: $path =~ s/^\&//;
18436: my $maptitle = $mapresobj->title();
18437: if ($mapurl eq 'default') {
1.1129 raeburn 18438: $maptitle = 'Main Content';
1.1101 raeburn 18439: }
18440: $path .= (($path ne '')? '&' : '').
18441: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 18442: &escape($maptitle).
1.1101 raeburn 18443: ':'.$mapresobj->randompick().
18444: ':'.$mapresobj->randomout().
18445: ':'.$mapresobj->encrypted().
18446: ':'.$mapresobj->randomorder().
18447: ':'.$mapresobj->is_page();
18448: } else {
18449: my $maptitle = &Apache::lonnet::gettitle($mapurl);
18450: my $ispage = (($type eq 'page')? 1 : '');
18451: if ($mapurl eq 'default') {
1.1129 raeburn 18452: $maptitle = 'Main Content';
1.1101 raeburn 18453: }
18454: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 18455: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 18456: }
18457: unless ($mapurl eq 'default') {
18458: $path = 'default&'.
1.1146 raeburn 18459: &escape('Main Content').
1.1101 raeburn 18460: ':::::&'.$path;
18461: }
18462: return $path;
18463: }
18464:
1.1094 raeburn 18465: sub captcha_display {
1.1327 raeburn 18466: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 18467: my ($output,$error);
1.1234 raeburn 18468: my ($captcha,$pubkey,$privkey,$version) =
1.1327 raeburn 18469: &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 18470: if ($captcha eq 'original') {
1.1094 raeburn 18471: $output = &create_captcha();
18472: unless ($output) {
1.1172 raeburn 18473: $error = 'captcha';
1.1094 raeburn 18474: }
18475: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 18476: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 18477: unless ($output) {
1.1172 raeburn 18478: $error = 'recaptcha';
1.1094 raeburn 18479: }
18480: }
1.1234 raeburn 18481: return ($output,$error,$captcha,$version);
1.1094 raeburn 18482: }
18483:
18484: sub captcha_response {
1.1327 raeburn 18485: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 18486: my ($captcha_chk,$captcha_error);
1.1327 raeburn 18487: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 18488: if ($captcha eq 'original') {
1.1094 raeburn 18489: ($captcha_chk,$captcha_error) = &check_captcha();
18490: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 18491: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 18492: } else {
18493: $captcha_chk = 1;
18494: }
18495: return ($captcha_chk,$captcha_error);
18496: }
18497:
18498: sub get_captcha_config {
1.1327 raeburn 18499: my ($context,$lonhost,$dom_in_effect) = @_;
1.1234 raeburn 18500: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 18501: my $hostname = &Apache::lonnet::hostname($lonhost);
18502: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
18503: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 18504: if ($context eq 'usercreation') {
18505: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
18506: if (ref($domconfig{$context}) eq 'HASH') {
18507: $hashtocheck = $domconfig{$context}{'cancreate'};
18508: if (ref($hashtocheck) eq 'HASH') {
18509: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
18510: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
18511: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
18512: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
18513: }
18514: if ($privkey && $pubkey) {
18515: $captcha = 'recaptcha';
1.1234 raeburn 18516: $version = $hashtocheck->{'recaptchaversion'};
18517: if ($version ne '2') {
18518: $version = 1;
18519: }
1.1095 raeburn 18520: } else {
18521: $captcha = 'original';
18522: }
18523: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
18524: $captcha = 'original';
18525: }
1.1094 raeburn 18526: }
1.1095 raeburn 18527: } else {
18528: $captcha = 'captcha';
18529: }
18530: } elsif ($context eq 'login') {
18531: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
18532: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
18533: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
18534: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 18535: if ($privkey && $pubkey) {
18536: $captcha = 'recaptcha';
1.1234 raeburn 18537: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
18538: if ($version ne '2') {
18539: $version = 1;
18540: }
1.1095 raeburn 18541: } else {
18542: $captcha = 'original';
1.1094 raeburn 18543: }
1.1095 raeburn 18544: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
18545: $captcha = 'original';
1.1094 raeburn 18546: }
1.1327 raeburn 18547: } elsif ($context eq 'passwords') {
18548: if ($dom_in_effect) {
18549: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
18550: if ($passwdconf{'captcha'} eq 'recaptcha') {
18551: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
18552: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
18553: $privkey = $passwdconf{'recaptchakeys'}{'private'};
18554: }
18555: if ($privkey && $pubkey) {
18556: $captcha = 'recaptcha';
18557: $version = $passwdconf{'recaptchaversion'};
18558: if ($version ne '2') {
18559: $version = 1;
18560: }
18561: } else {
18562: $captcha = 'original';
18563: }
18564: } elsif ($passwdconf{'captcha'} ne 'notused') {
18565: $captcha = 'original';
18566: }
18567: }
18568: }
1.1234 raeburn 18569: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 18570: }
18571:
18572: sub create_captcha {
18573: my %captcha_params = &captcha_settings();
18574: my ($output,$maxtries,$tries) = ('',10,0);
18575: while ($tries < $maxtries) {
18576: $tries ++;
18577: my $captcha = Authen::Captcha->new (
18578: output_folder => $captcha_params{'output_dir'},
18579: data_folder => $captcha_params{'db_dir'},
18580: );
18581: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
18582:
18583: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
18584: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1367 raeburn 18585: '<span class="LC_nobreak">'.
1.1094 raeburn 18586: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 18587: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
1.1367 raeburn 18588: '</span><br />'.
1.1176 raeburn 18589: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 18590: last;
18591: }
18592: }
1.1323 raeburn 18593: if ($output eq '') {
18594: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
18595: }
1.1094 raeburn 18596: return $output;
18597: }
18598:
18599: sub captcha_settings {
18600: my %captcha_params = (
18601: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
18602: www_output_dir => "/captchaspool",
18603: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
18604: numchars => '5',
18605: );
18606: return %captcha_params;
18607: }
18608:
18609: sub check_captcha {
18610: my ($captcha_chk,$captcha_error);
18611: my $code = $env{'form.code'};
18612: my $md5sum = $env{'form.crypt'};
18613: my %captcha_params = &captcha_settings();
18614: my $captcha = Authen::Captcha->new(
18615: output_folder => $captcha_params{'output_dir'},
18616: data_folder => $captcha_params{'db_dir'},
18617: );
1.1109 raeburn 18618: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 18619: my %captcha_hash = (
18620: 0 => 'Code not checked (file error)',
18621: -1 => 'Failed: code expired',
18622: -2 => 'Failed: invalid code (not in database)',
18623: -3 => 'Failed: invalid code (code does not match crypt)',
18624: );
18625: if ($captcha_chk != 1) {
18626: $captcha_error = $captcha_hash{$captcha_chk}
18627: }
18628: return ($captcha_chk,$captcha_error);
18629: }
18630:
18631: sub create_recaptcha {
1.1234 raeburn 18632: my ($pubkey,$version) = @_;
18633: if ($version >= 2) {
1.1367 raeburn 18634: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
18635: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1234 raeburn 18636: } else {
18637: my $use_ssl;
18638: if ($ENV{'SERVER_PORT'} == 443) {
18639: $use_ssl = 1;
18640: }
18641: my $captcha = Captcha::reCAPTCHA->new;
18642: return $captcha->get_options_setter({theme => 'white'})."\n".
18643: $captcha->get_html($pubkey,undef,$use_ssl).
18644: &mt('If the text is hard to read, [_1] will replace them.',
18645: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
18646: '<br /><br />';
18647: }
1.1094 raeburn 18648: }
18649:
18650: sub check_recaptcha {
1.1234 raeburn 18651: my ($privkey,$version) = @_;
1.1094 raeburn 18652: my $captcha_chk;
1.1350 raeburn 18653: my $ip = &Apache::lonnet::get_requestor_ip();
1.1234 raeburn 18654: if ($version >= 2) {
18655: my %info = (
18656: secret => $privkey,
18657: response => $env{'form.g-recaptcha-response'},
1.1350 raeburn 18658: remoteip => $ip,
1.1234 raeburn 18659: );
1.1280 raeburn 18660: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
18661: $request->content(join('&',map {
18662: my $name = escape($_);
18663: "$name=" . ( ref($info{$_}) eq 'ARRAY'
18664: ? join("&$name=", map {escape($_) } @{$info{$_}})
18665: : &escape($info{$_}) );
18666: } keys(%info)));
18667: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 18668: if ($response->is_success) {
18669: my $data = JSON::DWIW->from_json($response->decoded_content);
18670: if (ref($data) eq 'HASH') {
18671: if ($data->{'success'}) {
18672: $captcha_chk = 1;
18673: }
18674: }
18675: }
18676: } else {
18677: my $captcha = Captcha::reCAPTCHA->new;
18678: my $captcha_result =
18679: $captcha->check_answer(
18680: $privkey,
1.1350 raeburn 18681: $ip,
1.1234 raeburn 18682: $env{'form.recaptcha_challenge_field'},
18683: $env{'form.recaptcha_response_field'},
18684: );
18685: if ($captcha_result->{is_valid}) {
18686: $captcha_chk = 1;
18687: }
1.1094 raeburn 18688: }
18689: return $captcha_chk;
18690: }
18691:
1.1174 raeburn 18692: sub emailusername_info {
1.1244 raeburn 18693: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 18694: my %titles = &Apache::lonlocal::texthash (
18695: lastname => 'Last Name',
18696: firstname => 'First Name',
18697: institution => 'School/college/university',
18698: location => "School's city, state/province, country",
18699: web => "School's web address",
18700: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 18701: id => 'Student/Employee ID',
1.1174 raeburn 18702: );
18703: return (\@fields,\%titles);
18704: }
18705:
1.1161 raeburn 18706: sub cleanup_html {
18707: my ($incoming) = @_;
18708: my $outgoing;
18709: if ($incoming ne '') {
18710: $outgoing = $incoming;
18711: $outgoing =~ s/;/;/g;
18712: $outgoing =~ s/\#/#/g;
18713: $outgoing =~ s/\&/&/g;
18714: $outgoing =~ s/</</g;
18715: $outgoing =~ s/>/>/g;
18716: $outgoing =~ s/\(/(/g;
18717: $outgoing =~ s/\)/)/g;
18718: $outgoing =~ s/"/"/g;
18719: $outgoing =~ s/'/'/g;
18720: $outgoing =~ s/\$/$/g;
18721: $outgoing =~ s{/}{/}g;
18722: $outgoing =~ s/=/=/g;
18723: $outgoing =~ s/\\/\/g
18724: }
18725: return $outgoing;
18726: }
18727:
1.1190 musolffc 18728: # Checks for critical messages and returns a redirect url if one exists.
18729: # $interval indicates how often to check for messages.
1.1282 raeburn 18730: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 18731: sub critical_redirect {
1.1282 raeburn 18732: my ($interval,$context) = @_;
1.1356 raeburn 18733: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
18734: return ();
18735: }
1.1190 musolffc 18736: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 18737: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
18738: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18739: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 18740: my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 18741: if ($blocked) {
18742: my $checkrole = "cm./$cdom/$cnum";
18743: if ($env{'request.course.sec'} ne '') {
18744: $checkrole .= "/$env{'request.course.sec'}";
18745: }
18746: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
18747: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
18748: return;
18749: }
18750: }
18751: }
1.1190 musolffc 18752: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
18753: $env{'user.name'});
18754: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 18755: my $redirecturl;
1.1190 musolffc 18756: if ($what[0]) {
1.1356 raeburn 18757: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1190 musolffc 18758: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 18759: my $url=&Apache::lonnet::absolute_url().$redirecturl;
18760: return (1, $url);
1.1190 musolffc 18761: }
1.1191 raeburn 18762: }
18763: }
18764: return ();
1.1190 musolffc 18765: }
18766:
1.1174 raeburn 18767: # Use:
18768: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
18769: #
18770: ##################################################
18771: # password associated functions #
18772: ##################################################
18773: sub des_keys {
18774: # Make a new key for DES encryption.
18775: # Each key has two parts which are returned separately.
18776: # Please note: Each key must be passed through the &hex function
18777: # before it is output to the web browser. The hex versions cannot
18778: # be used to decrypt.
18779: my @hexstr=('0','1','2','3','4','5','6','7',
18780: '8','9','a','b','c','d','e','f');
18781: my $lkey='';
18782: for (0..7) {
18783: $lkey.=$hexstr[rand(15)];
18784: }
18785: my $ukey='';
18786: for (0..7) {
18787: $ukey.=$hexstr[rand(15)];
18788: }
18789: return ($lkey,$ukey);
18790: }
18791:
18792: sub des_decrypt {
18793: my ($key,$cyphertext) = @_;
18794: my $keybin=pack("H16",$key);
18795: my $cypher;
18796: if ($Crypt::DES::VERSION>=2.03) {
18797: $cypher=new Crypt::DES $keybin;
18798: } else {
18799: $cypher=new DES $keybin;
18800: }
1.1233 raeburn 18801: my $plaintext='';
18802: my $cypherlength = length($cyphertext);
18803: my $numchunks = int($cypherlength/32);
18804: for (my $j=0; $j<$numchunks; $j++) {
18805: my $start = $j*32;
18806: my $cypherblock = substr($cyphertext,$start,32);
18807: my $chunk =
18808: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
18809: $chunk .=
18810: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
18811: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
18812: $plaintext .= $chunk;
18813: }
1.1174 raeburn 18814: return $plaintext;
18815: }
18816:
1.1344 raeburn 18817: sub get_requested_shorturls {
1.1309 raeburn 18818: my ($cdom,$cnum,$navmap) = @_;
18819: return unless (ref($navmap));
1.1344 raeburn 18820: my ($numnew,$errors);
1.1309 raeburn 18821: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
18822: if (@toshorten) {
18823: my (%maps,%resources,%titles);
18824: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
18825: 'shorturls',$cdom,$cnum);
18826: if (keys(%resources)) {
1.1344 raeburn 18827: my %tocreate;
1.1309 raeburn 18828: foreach my $item (sort {$a <=> $b} (@toshorten)) {
18829: my $symb = $resources{$item};
18830: if ($symb) {
18831: $tocreate{$cnum.'&'.$symb} = 1;
18832: }
18833: }
1.1344 raeburn 18834: if (keys(%tocreate)) {
18835: ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
18836: \%tocreate);
18837: }
1.1309 raeburn 18838: }
1.1344 raeburn 18839: }
18840: return ($numnew,$errors);
18841: }
18842:
18843: sub make_short_symbs {
18844: my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
18845: my ($numnew,@errors);
18846: if (ref($tocreateref) eq 'HASH') {
18847: my %tocreate = %{$tocreateref};
1.1309 raeburn 18848: if (keys(%tocreate)) {
18849: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
18850: my $su = Short::URL->new(no_vowels => 1);
18851: my $init = '';
18852: my (%newunique,%addcourse,%courseonly,%failed);
18853: # get lock on tiny db
18854: my $now = time;
1.1344 raeburn 18855: if ($lockuser eq '') {
18856: $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
18857: }
1.1309 raeburn 18858: my $lockhash = {
1.1344 raeburn 18859: "lock\0$now" => $lockuser,
1.1309 raeburn 18860: };
18861: my $tries = 0;
18862: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
18863: my ($code,$error);
18864: while (($gotlock ne 'ok') && ($tries<3)) {
18865: $tries ++;
18866: sleep 1;
1.1319 raeburn 18867: $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309 raeburn 18868: }
18869: if ($gotlock eq 'ok') {
18870: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
18871: \%addcourse,\%courseonly,\%failed);
18872: if (keys(%failed)) {
18873: my $numfailed = scalar(keys(%failed));
18874: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
18875: }
18876: if (keys(%newunique)) {
18877: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
18878: if ($putres eq 'ok') {
18879: $numnew = scalar(keys(%newunique));
18880: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
18881: unless ($newputres eq 'ok') {
18882: push(@errors,&mt('error: could not store course look-up of short URLs'));
18883: }
18884: } else {
18885: push(@errors,&mt('error: could not store unique six character URLs'));
18886: }
18887: }
18888: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
18889: unless ($dellockres eq 'ok') {
18890: push(@errors,&mt('error: could not release lockfile'));
18891: }
18892: } else {
18893: push(@errors,&mt('error: could not obtain lockfile'));
18894: }
18895: if (keys(%courseonly)) {
18896: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
18897: if ($result ne 'ok') {
18898: push(@errors,&mt('error: could not update course look-up of short URLs'));
18899: }
18900: }
18901: }
18902: }
18903: return ($numnew,\@errors);
18904: }
18905:
18906: sub shorten_symbs {
18907: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
18908: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
18909: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
18910: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
18911: my (%possibles,%collisions);
18912: foreach my $key (keys(%{$tocreate})) {
18913: my $num = String::CRC32::crc32($key);
18914: my $tiny = $su->encode($num,$init);
18915: if ($tiny) {
18916: $possibles{$tiny} = $key;
18917: }
18918: }
18919: if (!$init) {
18920: $init = 1;
18921: } else {
18922: $init ++;
18923: }
18924: if (keys(%possibles)) {
18925: my @posstiny = keys(%possibles);
18926: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
18927: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
18928: if (keys(%currtiny)) {
18929: foreach my $key (keys(%currtiny)) {
18930: next if ($currtiny{$key} eq '');
18931: if ($currtiny{$key} eq $possibles{$key}) {
18932: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
18933: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18934: $courseonly->{$tsymb} = $key;
18935: }
18936: } else {
18937: $collisions{$possibles{$key}} = 1;
18938: }
18939: delete($possibles{$key});
18940: }
18941: }
18942: foreach my $key (keys(%possibles)) {
18943: $newunique->{$key} = $possibles{$key};
18944: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
18945: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18946: $addcourse->{$tsymb} = $key;
18947: }
18948: }
18949: }
18950: if (keys(%collisions)) {
18951: if ($init <5) {
18952: if (!$init) {
18953: $init = 1;
18954: } else {
18955: $init ++;
18956: }
18957: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
18958: $newunique,$addcourse,$courseonly,$failed);
18959: } else {
18960: foreach my $key (keys(%collisions)) {
18961: $failed->{$key} = 1;
18962: }
18963: }
18964: }
18965: return $init;
18966: }
18967:
1.1328 raeburn 18968: sub is_nonframeable {
1.1329 raeburn 18969: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
18970: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330 raeburn 18971: return if (($remprotocol eq '') || ($remhost eq ''));
1.1329 raeburn 18972:
18973: $remprotocol = lc($remprotocol);
18974: $remhost = lc($remhost);
18975: my $remport = 80;
18976: if ($remprotocol eq 'https') {
18977: $remport = 443;
18978: }
1.1330 raeburn 18979: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329 raeburn 18980: if ($cached) {
18981: unless ($nocache) {
18982: if ($result) {
18983: return 1;
18984: } else {
18985: return 0;
18986: }
18987: }
18988: }
1.1328 raeburn 18989: my $uselink;
18990: my $request = new HTTP::Request('HEAD',$url);
18991: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
18992: if ($response->is_success()) {
18993: my $secpolicy = lc($response->header('content-security-policy'));
18994: my $xframeop = lc($response->header('x-frame-options'));
18995: $secpolicy =~ s/^\s+|\s+$//g;
18996: $xframeop =~ s/^\s+|\s+$//g;
18997: if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329 raeburn 18998: my $remotehost = $remprotocol.'://'.$remhost;
1.1328 raeburn 18999: my ($origin,$protocol,$port);
19000: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
19001: $port = $ENV{'SERVER_PORT'};
19002: } else {
19003: $port = 80;
19004: }
19005: if ($absolute eq '') {
19006: $protocol = 'http:';
19007: if ($port == 443) {
19008: $protocol = 'https:';
19009: }
19010: $origin = $protocol.'//'.lc($hostname);
19011: } else {
19012: $origin = lc($absolute);
19013: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
19014: }
19015: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
19016: my $framepolicy = $1;
19017: $framepolicy =~ s/^\s+|\s+$//g;
19018: my @policies = split(/\s+/,$framepolicy);
19019: if (@policies) {
19020: if (grep(/^\Q'none'\E$/,@policies)) {
19021: $uselink = 1;
19022: } else {
19023: $uselink = 1;
19024: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
19025: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
19026: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
19027: undef($uselink);
19028: }
19029: if ($uselink) {
19030: if (grep(/^\Q'self'\E$/,@policies)) {
19031: if (($origin ne '') && ($remotehost eq $origin)) {
19032: undef($uselink);
19033: }
19034: }
19035: }
19036: if ($uselink) {
19037: my @possok;
19038: if ($ip ne '') {
19039: push(@possok,$ip);
19040: }
19041: my $hoststr = '';
19042: foreach my $part (reverse(split(/\./,$hostname))) {
19043: if ($hoststr eq '') {
19044: $hoststr = $part;
19045: } else {
19046: $hoststr = "$part.$hoststr";
19047: }
19048: if ($hoststr eq $hostname) {
19049: push(@possok,$hostname);
19050: } else {
19051: push(@possok,"*.$hoststr");
19052: }
19053: }
19054: if (@possok) {
19055: foreach my $poss (@possok) {
19056: last if (!$uselink);
19057: foreach my $policy (@policies) {
19058: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
19059: undef($uselink);
19060: last;
19061: }
19062: }
19063: }
19064: }
19065: }
19066: }
19067: }
19068: } elsif ($xframeop ne '') {
19069: $uselink = 1;
19070: my @policies = split(/\s*,\s*/,$xframeop);
19071: if (@policies) {
19072: unless (grep(/^deny$/,@policies)) {
19073: if ($origin ne '') {
19074: if (grep(/^sameorigin$/,@policies)) {
19075: if ($remotehost eq $origin) {
19076: undef($uselink);
19077: }
19078: }
19079: if ($uselink) {
19080: foreach my $policy (@policies) {
19081: if ($policy =~ /^allow-from\s*(.+)$/) {
19082: my $allowfrom = $1;
19083: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
19084: undef($uselink);
19085: last;
19086: }
19087: }
19088: }
19089: }
19090: }
19091: }
19092: }
19093: }
19094: }
19095: }
1.1329 raeburn 19096: if ($nocache) {
19097: if ($cached) {
19098: my $devalidate;
19099: if ($uselink && !$result) {
19100: $devalidate = 1;
19101: } elsif (!$uselink && $result) {
19102: $devalidate = 1;
19103: }
19104: if ($devalidate) {
19105: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
19106: }
19107: }
19108: } else {
19109: if ($uselink) {
19110: $result = 1;
19111: } else {
19112: $result = 0;
19113: }
19114: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
19115: }
1.1328 raeburn 19116: return $uselink;
19117: }
19118:
1.1359 raeburn 19119: sub page_menu {
19120: my ($menucolls,$menunum) = @_;
19121: my %menu;
19122: foreach my $item (split(/;/,$menucolls)) {
19123: my ($num,$value) = split(/\%/,$item);
19124: if ($num eq $menunum) {
19125: my @entries = split(/\&/,$value);
19126: foreach my $entry (@entries) {
19127: my ($name,$fields) = split(/=/,$entry);
1.1368 raeburn 19128: if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
1.1359 raeburn 19129: $menu{$name} = $fields;
19130: } else {
19131: my @shown;
19132: if ($fields =~ /,/) {
19133: @shown = split(/,/,$fields);
19134: } else {
19135: @shown = ($fields);
19136: }
19137: if (@shown) {
19138: foreach my $field (@shown) {
19139: next if ($field eq '');
19140: $menu{$field} = 1;
19141: }
19142: }
19143: }
19144: }
19145: }
19146: }
19147: return %menu;
19148: }
19149:
1.112 bowersj2 19150: 1;
19151: __END__;
1.41 ng 19152:
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