Annotation of loncom/interface/loncommon.pm, revision 1.1379
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1379 ! raeburn 4: # $Id: loncommon.pm,v 1.1378 2022/05/24 16:23:03 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.1379 ! raeburn 1313: if (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self')) {
! 1314: $target = '';
1.1378 raeburn 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.1379 ! raeburn 6233: frameset flag
! 6234: If page header is being requested for use in a frameset, then
! 6235: the second (option) argument -- frameset will be true, and
! 6236: the target attribute set for links should be target="_parent".
1.822 bisitz 6237:
6238: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 6239: To be included on Authoring Space pages
1.822 bisitz 6240:
6241: =cut
6242:
6243: sub CSTR_pageheader {
1.1379 ! raeburn 6244: my ($trailfile,$frameset) = @_;
1.1026 raeburn 6245: if ($trailfile eq '') {
6246: $trailfile = $env{'request.filename'};
6247: }
6248:
6249: # this is for resources; directories have customtitle, and crumbs
6250: # and select recent are created in lonpubdir.pm
6251:
6252: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 6253: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 6254: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 6255: my $formaction = "/priv/$udom/$uname/$thisdisfn";
6256: $formaction =~ s{/+}{/}g;
1.822 bisitz 6257:
6258: my $parentpath = '';
6259: my $lastitem = '';
6260: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
6261: $parentpath = $1;
6262: $lastitem = $2;
6263: } else {
6264: $lastitem = $thisdisfn;
6265: }
1.921 bisitz 6266:
1.1246 raeburn 6267: my ($crsauthor,$title);
6268: if (($env{'request.course.id'}) &&
6269: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 6270: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 6271: $crsauthor = 1;
6272: $title = &mt('Course Authoring Space');
6273: } else {
6274: $title = &mt('Authoring Space');
6275: }
6276:
1.1379 ! raeburn 6277: my ($target,$crumbtarget) = (' target="_top"','_top');
! 6278: if ($frameset) {
! 6279: $target = ' target="_parent"';
! 6280: $crumbtarget = '_parent';
! 6281: } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314 raeburn 6282: $target = '';
6283: $crumbtarget = '';
1.1379 ! raeburn 6284: } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
1.1378 raeburn 6285: $target = ' target="'.$env{'request.deeplink.target'}.'"';
6286: $crumbtarget = $env{'request.deeplink.target'};
6287: }
1.1313 raeburn 6288:
1.921 bisitz 6289: my $output =
1.822 bisitz 6290: '<div>'
6291: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 6292: .'<b>'.$title.'</b> '
1.1314 raeburn 6293: .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
6294: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 6295:
6296: if ($lastitem) {
6297: $output .=
6298: '<span class="LC_filename">'
6299: .$lastitem
6300: .'</span>';
6301: }
1.1245 raeburn 6302:
1.1246 raeburn 6303: if ($crsauthor) {
1.1379 ! raeburn 6304: $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6305: } else {
6306: $output .=
6307: '<br />'
1.1314 raeburn 6308: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246 raeburn 6309: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
6310: .'</form>'
1.1379 ! raeburn 6311: .&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6312: }
6313: $output .= '</div>';
1.921 bisitz 6314:
6315: return $output;
1.822 bisitz 6316: }
6317:
1.60 matthew 6318: ###############################################
6319: ###############################################
6320:
6321: =pod
6322:
1.112 bowersj2 6323: =back
6324:
1.549 albertel 6325: =head1 HTML Helpers
1.112 bowersj2 6326:
6327: =over 4
6328:
6329: =item * &bodytag()
1.60 matthew 6330:
6331: Returns a uniform header for LON-CAPA web pages.
6332:
6333: Inputs:
6334:
1.112 bowersj2 6335: =over 4
6336:
6337: =item * $title, A title to be displayed on the page.
6338:
6339: =item * $function, the current role (can be undef).
6340:
6341: =item * $addentries, extra parameters for the <body> tag.
6342:
6343: =item * $bodyonly, if defined, only return the <body> tag.
6344:
6345: =item * $domain, if defined, force a given domain.
6346:
6347: =item * $forcereg, if page should register as content page (relevant for
1.86 www 6348: text interface only)
1.60 matthew 6349:
1.814 bisitz 6350: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
6351: navigational links
1.317 albertel 6352:
1.338 albertel 6353: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
6354:
1.460 albertel 6355: =item * $args, optional argument valid values are
6356: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 6357: use_absolute -> for external resource or syllabus, this will
6358: contain https://<hostname> if server uses
6359: https (as per hosts.tab), but request is for http
6360: hostname -> hostname, from $r->hostname().
1.460 albertel 6361:
1.1096 raeburn 6362: =item * $advtoolsref, optional argument, ref to an array containing
6363: inlineremote items to be added in "Functions" menu below
6364: breadcrumbs.
6365:
1.1316 raeburn 6366: =item * $ltiscope, optional argument, will be one of: resource, map or
6367: course, if LON-CAPA is in LTI Provider context. Value is
6368: the scope of use, i.e., launch was for access to a single, a map
6369: or the entire course.
6370:
6371: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
6372: context, this will contain the URL for the landing item in
6373: the course, after launch from an LTI Consumer
6374:
1.1318 raeburn 6375: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
6376: context, this will contain a reference to hash of items
6377: to be included in the page header and/or inline menu.
6378:
1.112 bowersj2 6379: =back
6380:
1.60 matthew 6381: Returns: A uniform header for LON-CAPA web pages.
6382: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
6383: If $bodyonly is undef or zero, an html string containing a <body> tag and
6384: other decorations will be returned.
6385:
6386: =cut
6387:
1.54 www 6388: sub bodytag {
1.831 bisitz 6389: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1359 raeburn 6390: $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
6391: $ltimenu,$menucoll,$menuref)=@_;
1.339 albertel 6392:
1.954 raeburn 6393: my $public;
6394: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
6395: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
6396: $public = 1;
6397: }
1.460 albertel 6398: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 6399: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 6400: my $hostname = $args->{'hostname'};
1.339 albertel 6401:
1.183 matthew 6402: $function = &get_users_function() if (!$function);
1.339 albertel 6403: my $img = &designparm($function.'.img',$domain);
6404: my $font = &designparm($function.'.font',$domain);
6405: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
6406:
1.803 bisitz 6407: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 6408: 'bgcolor' => $pgbg,
1.339 albertel 6409: 'text' => $font,
6410: 'alink' => &designparm($function.'.alink',$domain),
6411: 'vlink' => &designparm($function.'.vlink',$domain),
6412: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 6413: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 6414:
1.63 www 6415: # role and realm
1.1178 raeburn 6416: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
6417: if ($realm) {
6418: $realm = '/'.$realm;
6419: }
1.1357 raeburn 6420: if ($role eq 'ca') {
1.479 albertel 6421: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 6422: $realm = &plainname($rname,$rdom);
1.378 raeburn 6423: }
1.55 www 6424: # realm
1.1357 raeburn 6425: my ($cid,$sec);
1.258 albertel 6426: if ($env{'request.course.id'}) {
1.1357 raeburn 6427: $cid = $env{'request.course.id'};
6428: if ($env{'request.course.sec'}) {
6429: $sec = $env{'request.course.sec'};
6430: }
6431: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
6432: if (&Apache::lonnet::is_course($1,$2)) {
6433: $cid = $1.'_'.$2;
6434: $sec = $3;
6435: }
6436: }
6437: if ($cid) {
1.378 raeburn 6438: if ($env{'request.role'} !~ /^cr/) {
6439: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 6440: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 6441: if ($env{'request.role.desc'}) {
6442: $role = $env{'request.role.desc'};
6443: } else {
6444: $role = &mt('Helpdesk[_1]',' '.$2);
6445: }
1.1257 raeburn 6446: } else {
6447: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 6448: }
1.1357 raeburn 6449: if ($sec) {
6450: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 6451: }
1.1357 raeburn 6452: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 6453: } else {
6454: $role = &Apache::lonnet::plaintext($role);
1.54 www 6455: }
1.433 albertel 6456:
1.359 albertel 6457: if (!$realm) { $realm=' '; }
1.330 albertel 6458:
1.438 albertel 6459: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6460:
1.101 www 6461: # construct main body tag
1.359 albertel 6462: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 6463: &Apache::lontexconvert::init_math_support();
1.252 albertel 6464:
1.1131 raeburn 6465: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6466:
1.1130 raeburn 6467: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6468: return $bodytag;
1.1130 raeburn 6469: }
1.359 albertel 6470:
1.954 raeburn 6471: if ($public) {
1.433 albertel 6472: undef($role);
6473: }
1.1318 raeburn 6474:
1.1359 raeburn 6475: my $showcrstitle = 1;
1.1357 raeburn 6476: if (($cid) && ($env{'request.lti.login'})) {
1.1318 raeburn 6477: if (ref($ltimenu) eq 'HASH') {
6478: unless ($ltimenu->{'role'}) {
6479: undef($role);
6480: }
6481: unless ($ltimenu->{'coursetitle'}) {
6482: $realm=' ';
1.1359 raeburn 6483: $showcrstitle = 0;
6484: }
6485: }
6486: } elsif (($cid) && ($menucoll)) {
6487: if (ref($menuref) eq 'HASH') {
6488: unless ($menuref->{'role'}) {
6489: undef($role);
6490: }
6491: unless ($menuref->{'crs'}) {
6492: $realm=' ';
6493: $showcrstitle = 0;
1.1318 raeburn 6494: }
6495: }
6496: }
6497:
1.762 bisitz 6498: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6499: #
6500: # Extra info if you are the DC
6501: my $dc_info = '';
1.1359 raeburn 6502: if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1357 raeburn 6503: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 6504: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6505: $dc_info =~ s/\s+$//;
1.359 albertel 6506: }
6507:
1.1237 raeburn 6508: my $crstype;
1.1357 raeburn 6509: if ($cid) {
6510: $crstype = $env{'course.'.$cid.'.type'};
1.1237 raeburn 6511: } elsif ($args->{'crstype'}) {
6512: $crstype = $args->{'crstype'};
6513: }
6514: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
6515: undef($role);
6516: } else {
1.1242 raeburn 6517: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 6518: }
1.853 droeschl 6519:
1.903 droeschl 6520: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6521:
6522: # if ($env{'request.state'} eq 'construct') {
6523: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6524: # }
6525:
1.1130 raeburn 6526: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 6527: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 6528:
1.1318 raeburn 6529: unless ($args->{'no_primary_menu'}) {
1.1369 raeburn 6530: my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
6531: $args->{'links_disabled'});
1.359 albertel 6532:
1.1318 raeburn 6533: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
6534: if ($dc_info) {
6535: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6536: }
6537: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
6538: <em>$realm</em> $dc_info</div>|;
6539: return $bodytag;
6540: }
1.894 droeschl 6541:
1.1318 raeburn 6542: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
6543: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
6544: }
1.916 droeschl 6545:
1.1318 raeburn 6546: $bodytag .= $right;
1.852 droeschl 6547:
1.1318 raeburn 6548: if ($dc_info) {
6549: $dc_info = &dc_courseid_toggle($dc_info);
6550: }
6551: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 6552: }
1.916 droeschl 6553:
1.1169 raeburn 6554: #if directed to not display the secondary menu, don't.
1.1168 raeburn 6555: if ($args->{'no_secondary_menu'}) {
6556: return $bodytag;
6557: }
1.1169 raeburn 6558: #don't show menus for public users
1.954 raeburn 6559: if (!$public){
1.1318 raeburn 6560: unless ($args->{'no_inline_menu'}) {
6561: $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
1.1359 raeburn 6562: $args->{'no_primary_menu'},
1.1369 raeburn 6563: $menucoll,$menuref,
6564: $args->{'links_disabled'});
1.1318 raeburn 6565: }
1.903 droeschl 6566: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6567: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6568: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6569: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1316 raeburn 6570: $args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
1.1096 raeburn 6571: } elsif ($forcereg) {
6572: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1258 raeburn 6573: $args->{'group'},
1.1274 raeburn 6574: $args->{'hide_buttons'},
1.1316 raeburn 6575: $hostname,$ltiscope,$ltiuri);
1.1096 raeburn 6576: } else {
6577: $bodytag .=
6578: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6579: $forcereg,$args->{'group'},
6580: $args->{'bread_crumbs'},
1.1274 raeburn 6581: $advtoolsref,'',$hostname);
1.920 raeburn 6582: }
1.903 droeschl 6583: }else{
6584: # this is to seperate menu from content when there's no secondary
6585: # menu. Especially needed for public accessible ressources.
6586: $bodytag .= '<hr style="clear:both" />';
6587: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6588: }
1.903 droeschl 6589:
1.235 raeburn 6590: return $bodytag;
1.182 matthew 6591: }
6592:
1.917 raeburn 6593: sub dc_courseid_toggle {
6594: my ($dc_info) = @_;
1.980 raeburn 6595: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6596: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6597: &mt('(More ...)').'</a></span>'.
6598: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6599: }
6600:
1.330 albertel 6601: sub make_attr_string {
6602: my ($register,$attr_ref) = @_;
6603:
6604: if ($attr_ref && !ref($attr_ref)) {
6605: die("addentries Must be a hash ref ".
6606: join(':',caller(1))." ".
6607: join(':',caller(0))." ");
6608: }
6609:
6610: if ($register) {
1.339 albertel 6611: my ($on_load,$on_unload);
6612: foreach my $key (keys(%{$attr_ref})) {
6613: if (lc($key) eq 'onload') {
6614: $on_load.=$attr_ref->{$key}.';';
6615: delete($attr_ref->{$key});
6616:
6617: } elsif (lc($key) eq 'onunload') {
6618: $on_unload.=$attr_ref->{$key}.';';
6619: delete($attr_ref->{$key});
6620: }
6621: }
1.953 droeschl 6622: $attr_ref->{'onload'} = $on_load;
6623: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6624: }
1.339 albertel 6625:
1.330 albertel 6626: my $attr_string;
1.1159 raeburn 6627: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6628: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6629: }
6630: return $attr_string;
6631: }
6632:
6633:
1.182 matthew 6634: ###############################################
1.251 albertel 6635: ###############################################
6636:
6637: =pod
6638:
6639: =item * &endbodytag()
6640:
6641: Returns a uniform footer for LON-CAPA web pages.
6642:
1.635 raeburn 6643: Inputs: 1 - optional reference to an args hash
6644: If in the hash, key for noredirectlink has a value which evaluates to true,
6645: a 'Continue' link is not displayed if the page contains an
6646: internal redirect in the <head></head> section,
6647: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6648:
6649: =cut
6650:
6651: sub endbodytag {
1.635 raeburn 6652: my ($args) = @_;
1.1080 raeburn 6653: my $endbodytag;
6654: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6655: $endbodytag='</body>';
6656: }
1.315 albertel 6657: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6658: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6659: $endbodytag=
6660: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6661: &mt('Continue').'</a>'.
6662: $endbodytag;
6663: }
1.315 albertel 6664: }
1.251 albertel 6665: return $endbodytag;
6666: }
6667:
1.352 albertel 6668: =pod
6669:
6670: =item * &standard_css()
6671:
6672: Returns a style sheet
6673:
6674: Inputs: (all optional)
6675: domain -> force to color decorate a page for a specific
6676: domain
6677: function -> force usage of a specific rolish color scheme
6678: bgcolor -> override the default page bgcolor
6679:
6680: =cut
6681:
1.343 albertel 6682: sub standard_css {
1.345 albertel 6683: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6684: $function = &get_users_function() if (!$function);
6685: my $img = &designparm($function.'.img', $domain);
6686: my $tabbg = &designparm($function.'.tabbg', $domain);
6687: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6688: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6689: #second colour for later usage
1.345 albertel 6690: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6691: my $pgbg_or_bgcolor =
6692: $bgcolor ||
1.352 albertel 6693: &designparm($function.'.pgbg', $domain);
1.382 albertel 6694: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6695: my $alink = &designparm($function.'.alink', $domain);
6696: my $vlink = &designparm($function.'.vlink', $domain);
6697: my $link = &designparm($function.'.link', $domain);
6698:
1.602 albertel 6699: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6700: my $mono = 'monospace';
1.850 bisitz 6701: my $data_table_head = $sidebg;
6702: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6703: my $data_table_dark = '#E0E0E0';
1.470 banghart 6704: my $data_table_darker = '#CCCCCC';
1.349 albertel 6705: my $data_table_highlight = '#FFFF00';
1.352 albertel 6706: my $mail_new = '#FFBB77';
6707: my $mail_new_hover = '#DD9955';
6708: my $mail_read = '#BBBB77';
6709: my $mail_read_hover = '#999944';
6710: my $mail_replied = '#AAAA88';
6711: my $mail_replied_hover = '#888855';
6712: my $mail_other = '#99BBBB';
6713: my $mail_other_hover = '#669999';
1.391 albertel 6714: my $table_header = '#DDDDDD';
1.489 raeburn 6715: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6716: my $lg_border_color = '#C8C8C8';
1.952 onken 6717: my $button_hover = '#BF2317';
1.392 albertel 6718:
1.608 albertel 6719: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6720: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6721: : '0 3px 0 4px';
1.448 albertel 6722:
1.523 albertel 6723:
1.343 albertel 6724: return <<END;
1.947 droeschl 6725:
6726: /* needed for iframe to allow 100% height in FF */
6727: body, html {
6728: margin: 0;
6729: padding: 0 0.5%;
6730: height: 99%; /* to avoid scrollbars */
6731: }
6732:
1.795 www 6733: body {
1.911 bisitz 6734: font-family: $sans;
6735: line-height:130%;
6736: font-size:0.83em;
6737: color:$font;
1.795 www 6738: }
6739:
1.959 onken 6740: a:focus,
6741: a:focus img {
1.795 www 6742: color: red;
6743: }
1.698 harmsja 6744:
1.911 bisitz 6745: form, .inline {
6746: display: inline;
1.795 www 6747: }
1.721 harmsja 6748:
1.795 www 6749: .LC_right {
1.911 bisitz 6750: text-align:right;
1.795 www 6751: }
6752:
6753: .LC_middle {
1.911 bisitz 6754: vertical-align:middle;
1.795 www 6755: }
1.721 harmsja 6756:
1.1130 raeburn 6757: .LC_floatleft {
6758: float: left;
6759: }
6760:
6761: .LC_floatright {
6762: float: right;
6763: }
6764:
1.911 bisitz 6765: .LC_400Box {
6766: width:400px;
6767: }
1.721 harmsja 6768:
1.947 droeschl 6769: .LC_iframecontainer {
6770: width: 98%;
6771: margin: 0;
6772: position: fixed;
6773: top: 8.5em;
6774: bottom: 0;
6775: }
6776:
6777: .LC_iframecontainer iframe{
6778: border: none;
6779: width: 100%;
6780: height: 100%;
6781: }
6782:
1.778 bisitz 6783: .LC_filename {
6784: font-family: $mono;
6785: white-space:pre;
1.921 bisitz 6786: font-size: 120%;
1.778 bisitz 6787: }
6788:
6789: .LC_fileicon {
6790: border: none;
6791: height: 1.3em;
6792: vertical-align: text-bottom;
6793: margin-right: 0.3em;
6794: text-decoration:none;
6795: }
6796:
1.1008 www 6797: .LC_setting {
6798: text-decoration:underline;
6799: }
6800:
1.350 albertel 6801: .LC_error {
6802: color: red;
6803: }
1.795 www 6804:
1.1097 bisitz 6805: .LC_warning {
6806: color: darkorange;
6807: }
6808:
1.457 albertel 6809: .LC_diff_removed {
1.733 bisitz 6810: color: red;
1.394 albertel 6811: }
1.532 albertel 6812:
6813: .LC_info,
1.457 albertel 6814: .LC_success,
6815: .LC_diff_added {
1.350 albertel 6816: color: green;
6817: }
1.795 www 6818:
1.802 bisitz 6819: div.LC_confirm_box {
6820: background-color: #FAFAFA;
6821: border: 1px solid $lg_border_color;
6822: margin-right: 0;
6823: padding: 5px;
6824: }
6825:
6826: div.LC_confirm_box .LC_error img,
6827: div.LC_confirm_box .LC_success img {
6828: vertical-align: middle;
6829: }
6830:
1.1242 raeburn 6831: .LC_maxwidth {
6832: max-width: 100%;
6833: height: auto;
6834: }
6835:
1.1243 raeburn 6836: .LC_textsize_mobile {
6837: \@media only screen and (max-device-width: 480px) {
6838: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6839: }
6840: }
6841:
1.440 albertel 6842: .LC_icon {
1.771 droeschl 6843: border: none;
1.790 droeschl 6844: vertical-align: middle;
1.771 droeschl 6845: }
6846:
1.543 albertel 6847: .LC_docs_spacer {
6848: width: 25px;
6849: height: 1px;
1.771 droeschl 6850: border: none;
1.543 albertel 6851: }
1.346 albertel 6852:
1.532 albertel 6853: .LC_internal_info {
1.735 bisitz 6854: color: #999999;
1.532 albertel 6855: }
6856:
1.794 www 6857: .LC_discussion {
1.1050 www 6858: background: $data_table_dark;
1.911 bisitz 6859: border: 1px solid black;
6860: margin: 2px;
1.794 www 6861: }
6862:
6863: .LC_disc_action_left {
1.1050 www 6864: background: $sidebg;
1.911 bisitz 6865: text-align: left;
1.1050 www 6866: padding: 4px;
6867: margin: 2px;
1.794 www 6868: }
6869:
6870: .LC_disc_action_right {
1.1050 www 6871: background: $sidebg;
1.911 bisitz 6872: text-align: right;
1.1050 www 6873: padding: 4px;
6874: margin: 2px;
1.794 www 6875: }
6876:
6877: .LC_disc_new_item {
1.911 bisitz 6878: background: white;
6879: border: 2px solid red;
1.1050 www 6880: margin: 4px;
6881: padding: 4px;
1.794 www 6882: }
6883:
6884: .LC_disc_old_item {
1.911 bisitz 6885: background: white;
1.1050 www 6886: margin: 4px;
6887: padding: 4px;
1.794 www 6888: }
6889:
1.458 albertel 6890: table.LC_pastsubmission {
6891: border: 1px solid black;
6892: margin: 2px;
6893: }
6894:
1.924 bisitz 6895: table#LC_menubuttons {
1.345 albertel 6896: width: 100%;
6897: background: $pgbg;
1.392 albertel 6898: border: 2px;
1.402 albertel 6899: border-collapse: separate;
1.803 bisitz 6900: padding: 0;
1.345 albertel 6901: }
1.392 albertel 6902:
1.801 tempelho 6903: table#LC_title_bar a {
6904: color: $fontmenu;
6905: }
1.836 bisitz 6906:
1.807 droeschl 6907: table#LC_title_bar {
1.819 tempelho 6908: clear: both;
1.836 bisitz 6909: display: none;
1.807 droeschl 6910: }
6911:
1.795 www 6912: table#LC_title_bar,
1.933 droeschl 6913: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6914: table#LC_title_bar.LC_with_remote {
1.359 albertel 6915: width: 100%;
1.392 albertel 6916: border-color: $pgbg;
6917: border-style: solid;
6918: border-width: $border;
1.379 albertel 6919: background: $pgbg;
1.801 tempelho 6920: color: $fontmenu;
1.392 albertel 6921: border-collapse: collapse;
1.803 bisitz 6922: padding: 0;
1.819 tempelho 6923: margin: 0;
1.359 albertel 6924: }
1.795 www 6925:
1.933 droeschl 6926: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6927: margin: 0;
6928: padding: 0;
1.933 droeschl 6929: position: relative;
6930: list-style: none;
1.913 droeschl 6931: }
1.933 droeschl 6932: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6933: display: inline;
6934: }
1.933 droeschl 6935:
6936: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6937: padding: 0;
1.933 droeschl 6938: margin: 0;
6939: float: left;
1.913 droeschl 6940: }
1.933 droeschl 6941: .LC_breadcrumb_tools_tools {
6942: padding: 0;
6943: margin: 0;
1.913 droeschl 6944: float: right;
6945: }
6946:
1.1240 raeburn 6947: .LC_placement_prog {
6948: padding-right: 20px;
6949: font-weight: bold;
6950: font-size: 90%;
6951: }
6952:
1.359 albertel 6953: table#LC_title_bar td {
6954: background: $tabbg;
6955: }
1.795 www 6956:
1.911 bisitz 6957: table#LC_menubuttons img {
1.803 bisitz 6958: border: none;
1.346 albertel 6959: }
1.795 www 6960:
1.842 droeschl 6961: .LC_breadcrumbs_component {
1.911 bisitz 6962: float: right;
6963: margin: 0 1em;
1.357 albertel 6964: }
1.842 droeschl 6965: .LC_breadcrumbs_component img {
1.911 bisitz 6966: vertical-align: middle;
1.777 tempelho 6967: }
1.795 www 6968:
1.1243 raeburn 6969: .LC_breadcrumbs_hoverable {
6970: background: $sidebg;
6971: }
6972:
1.383 albertel 6973: td.LC_table_cell_checkbox {
6974: text-align: center;
6975: }
1.795 www 6976:
6977: .LC_fontsize_small {
1.911 bisitz 6978: font-size: 70%;
1.705 tempelho 6979: }
6980:
1.844 bisitz 6981: #LC_breadcrumbs {
1.911 bisitz 6982: clear:both;
6983: background: $sidebg;
6984: border-bottom: 1px solid $lg_border_color;
6985: line-height: 2.5em;
1.933 droeschl 6986: overflow: hidden;
1.911 bisitz 6987: margin: 0;
6988: padding: 0;
1.995 raeburn 6989: text-align: left;
1.819 tempelho 6990: }
1.862 bisitz 6991:
1.1098 bisitz 6992: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6993: clear:both;
6994: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6995: border: 1px solid $sidebg;
1.1098 bisitz 6996: margin: 0 0 10px 0;
1.966 bisitz 6997: padding: 3px;
1.995 raeburn 6998: text-align: left;
1.822 bisitz 6999: }
7000:
1.795 www 7001: .LC_fontsize_medium {
1.911 bisitz 7002: font-size: 85%;
1.705 tempelho 7003: }
7004:
1.795 www 7005: .LC_fontsize_large {
1.911 bisitz 7006: font-size: 120%;
1.705 tempelho 7007: }
7008:
1.346 albertel 7009: .LC_menubuttons_inline_text {
7010: color: $font;
1.698 harmsja 7011: font-size: 90%;
1.701 harmsja 7012: padding-left:3px;
1.346 albertel 7013: }
7014:
1.934 droeschl 7015: .LC_menubuttons_inline_text img{
7016: vertical-align: middle;
7017: }
7018:
1.1051 www 7019: li.LC_menubuttons_inline_text img {
1.951 onken 7020: cursor:pointer;
1.1002 droeschl 7021: text-decoration: none;
1.951 onken 7022: }
7023:
1.526 www 7024: .LC_menubuttons_link {
7025: text-decoration: none;
7026: }
1.795 www 7027:
1.522 albertel 7028: .LC_menubuttons_category {
1.521 www 7029: color: $font;
1.526 www 7030: background: $pgbg;
1.521 www 7031: font-size: larger;
7032: font-weight: bold;
7033: }
7034:
1.346 albertel 7035: td.LC_menubuttons_text {
1.911 bisitz 7036: color: $font;
1.346 albertel 7037: }
1.706 harmsja 7038:
1.346 albertel 7039: .LC_current_location {
7040: background: $tabbg;
7041: }
1.795 www 7042:
1.1286 raeburn 7043: td.LC_zero_height {
7044: line-height: 0;
7045: cellpadding: 0;
7046: }
7047:
1.938 bisitz 7048: table.LC_data_table {
1.347 albertel 7049: border: 1px solid #000000;
1.402 albertel 7050: border-collapse: separate;
1.426 albertel 7051: border-spacing: 1px;
1.610 albertel 7052: background: $pgbg;
1.347 albertel 7053: }
1.795 www 7054:
1.422 albertel 7055: .LC_data_table_dense {
7056: font-size: small;
7057: }
1.795 www 7058:
1.507 raeburn 7059: table.LC_nested_outer {
7060: border: 1px solid #000000;
1.589 raeburn 7061: border-collapse: collapse;
1.803 bisitz 7062: border-spacing: 0;
1.507 raeburn 7063: width: 100%;
7064: }
1.795 www 7065:
1.879 raeburn 7066: table.LC_innerpickbox,
1.507 raeburn 7067: table.LC_nested {
1.803 bisitz 7068: border: none;
1.589 raeburn 7069: border-collapse: collapse;
1.803 bisitz 7070: border-spacing: 0;
1.507 raeburn 7071: width: 100%;
7072: }
1.795 www 7073:
1.911 bisitz 7074: table.LC_data_table tr th,
7075: table.LC_calendar tr th,
1.879 raeburn 7076: table.LC_prior_tries tr th,
7077: table.LC_innerpickbox tr th {
1.349 albertel 7078: font-weight: bold;
7079: background-color: $data_table_head;
1.801 tempelho 7080: color:$fontmenu;
1.701 harmsja 7081: font-size:90%;
1.347 albertel 7082: }
1.795 www 7083:
1.879 raeburn 7084: table.LC_innerpickbox tr th,
7085: table.LC_innerpickbox tr td {
7086: vertical-align: top;
7087: }
7088:
1.711 raeburn 7089: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 7090: background-color: #CCCCCC;
1.711 raeburn 7091: font-weight: bold;
7092: text-align: left;
7093: }
1.795 www 7094:
1.912 bisitz 7095: table.LC_data_table tr.LC_odd_row > td {
7096: background-color: $data_table_light;
7097: padding: 2px;
7098: vertical-align: top;
7099: }
7100:
1.809 bisitz 7101: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 7102: background-color: $data_table_light;
1.912 bisitz 7103: vertical-align: top;
7104: }
7105:
7106: table.LC_data_table tr.LC_even_row > td {
7107: background-color: $data_table_dark;
1.425 albertel 7108: padding: 2px;
1.900 bisitz 7109: vertical-align: top;
1.347 albertel 7110: }
1.795 www 7111:
1.809 bisitz 7112: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 7113: background-color: $data_table_dark;
1.900 bisitz 7114: vertical-align: top;
1.347 albertel 7115: }
1.795 www 7116:
1.425 albertel 7117: table.LC_data_table tr.LC_data_table_highlight td {
7118: background-color: $data_table_darker;
7119: }
1.795 www 7120:
1.639 raeburn 7121: table.LC_data_table tr td.LC_leftcol_header {
7122: background-color: $data_table_head;
7123: font-weight: bold;
7124: }
1.795 www 7125:
1.451 albertel 7126: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 7127: table.LC_nested tr.LC_empty_row td {
1.421 albertel 7128: font-weight: bold;
7129: font-style: italic;
7130: text-align: center;
7131: padding: 8px;
1.347 albertel 7132: }
1.795 www 7133:
1.1114 raeburn 7134: table.LC_data_table tr.LC_empty_row td,
7135: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 7136: background-color: $sidebg;
7137: }
7138:
7139: table.LC_nested tr.LC_empty_row td {
7140: background-color: #FFFFFF;
7141: }
7142:
1.890 droeschl 7143: table.LC_caption {
7144: }
7145:
1.507 raeburn 7146: table.LC_nested tr.LC_empty_row td {
1.465 albertel 7147: padding: 4ex
7148: }
1.795 www 7149:
1.507 raeburn 7150: table.LC_nested_outer tr th {
7151: font-weight: bold;
1.801 tempelho 7152: color:$fontmenu;
1.507 raeburn 7153: background-color: $data_table_head;
1.701 harmsja 7154: font-size: small;
1.507 raeburn 7155: border-bottom: 1px solid #000000;
7156: }
1.795 www 7157:
1.507 raeburn 7158: table.LC_nested_outer tr td.LC_subheader {
7159: background-color: $data_table_head;
7160: font-weight: bold;
7161: font-size: small;
7162: border-bottom: 1px solid #000000;
7163: text-align: right;
1.451 albertel 7164: }
1.795 www 7165:
1.507 raeburn 7166: table.LC_nested tr.LC_info_row td {
1.735 bisitz 7167: background-color: #CCCCCC;
1.451 albertel 7168: font-weight: bold;
7169: font-size: small;
1.507 raeburn 7170: text-align: center;
7171: }
1.795 www 7172:
1.589 raeburn 7173: table.LC_nested tr.LC_info_row td.LC_left_item,
7174: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 7175: text-align: left;
1.451 albertel 7176: }
1.795 www 7177:
1.507 raeburn 7178: table.LC_nested td {
1.735 bisitz 7179: background-color: #FFFFFF;
1.451 albertel 7180: font-size: small;
1.507 raeburn 7181: }
1.795 www 7182:
1.507 raeburn 7183: table.LC_nested_outer tr th.LC_right_item,
7184: table.LC_nested tr.LC_info_row td.LC_right_item,
7185: table.LC_nested tr.LC_odd_row td.LC_right_item,
7186: table.LC_nested tr td.LC_right_item {
1.451 albertel 7187: text-align: right;
7188: }
7189:
1.507 raeburn 7190: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 7191: background-color: #EEEEEE;
1.451 albertel 7192: }
7193:
1.473 raeburn 7194: table.LC_createuser {
7195: }
7196:
7197: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 7198: font-size: small;
1.473 raeburn 7199: }
7200:
7201: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 7202: background-color: #CCCCCC;
1.473 raeburn 7203: font-weight: bold;
7204: text-align: center;
7205: }
7206:
1.349 albertel 7207: table.LC_calendar {
7208: border: 1px solid #000000;
7209: border-collapse: collapse;
1.917 raeburn 7210: width: 98%;
1.349 albertel 7211: }
1.795 www 7212:
1.349 albertel 7213: table.LC_calendar_pickdate {
7214: font-size: xx-small;
7215: }
1.795 www 7216:
1.349 albertel 7217: table.LC_calendar tr td {
7218: border: 1px solid #000000;
7219: vertical-align: top;
1.917 raeburn 7220: width: 14%;
1.349 albertel 7221: }
1.795 www 7222:
1.349 albertel 7223: table.LC_calendar tr td.LC_calendar_day_empty {
7224: background-color: $data_table_dark;
7225: }
1.795 www 7226:
1.779 bisitz 7227: table.LC_calendar tr td.LC_calendar_day_current {
7228: background-color: $data_table_highlight;
1.777 tempelho 7229: }
1.795 www 7230:
1.938 bisitz 7231: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 7232: background-color: $mail_new;
7233: }
1.795 www 7234:
1.938 bisitz 7235: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 7236: background-color: $mail_new_hover;
7237: }
1.795 www 7238:
1.938 bisitz 7239: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 7240: background-color: $mail_read;
7241: }
1.795 www 7242:
1.938 bisitz 7243: /*
7244: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 7245: background-color: $mail_read_hover;
7246: }
1.938 bisitz 7247: */
1.795 www 7248:
1.938 bisitz 7249: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 7250: background-color: $mail_replied;
7251: }
1.795 www 7252:
1.938 bisitz 7253: /*
7254: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 7255: background-color: $mail_replied_hover;
7256: }
1.938 bisitz 7257: */
1.795 www 7258:
1.938 bisitz 7259: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 7260: background-color: $mail_other;
7261: }
1.795 www 7262:
1.938 bisitz 7263: /*
7264: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 7265: background-color: $mail_other_hover;
7266: }
1.938 bisitz 7267: */
1.494 raeburn 7268:
1.777 tempelho 7269: table.LC_data_table tr > td.LC_browser_file,
7270: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 7271: background: #AAEE77;
1.389 albertel 7272: }
1.795 www 7273:
1.777 tempelho 7274: table.LC_data_table tr > td.LC_browser_file_locked,
7275: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 7276: background: #FFAA99;
1.387 albertel 7277: }
1.795 www 7278:
1.777 tempelho 7279: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 7280: background: #888888;
1.779 bisitz 7281: }
1.795 www 7282:
1.777 tempelho 7283: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 7284: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 7285: background: #F8F866;
1.777 tempelho 7286: }
1.795 www 7287:
1.696 bisitz 7288: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 7289: background: #E0E8FF;
1.387 albertel 7290: }
1.696 bisitz 7291:
1.707 bisitz 7292: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 7293: /* background: #77FF77; */
1.707 bisitz 7294: }
1.795 www 7295:
1.707 bisitz 7296: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 7297: border-right: 8px solid #FFFF77;
1.707 bisitz 7298: }
1.795 www 7299:
1.707 bisitz 7300: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 7301: border-right: 8px solid #FFAA77;
1.707 bisitz 7302: }
1.795 www 7303:
1.707 bisitz 7304: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 7305: border-right: 8px solid #FF7777;
1.707 bisitz 7306: }
1.795 www 7307:
1.707 bisitz 7308: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 7309: border-right: 8px solid #AAFF77;
1.707 bisitz 7310: }
1.795 www 7311:
1.707 bisitz 7312: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 7313: border-right: 8px solid #11CC55;
1.707 bisitz 7314: }
7315:
1.388 albertel 7316: span.LC_current_location {
1.701 harmsja 7317: font-size:larger;
1.388 albertel 7318: background: $pgbg;
7319: }
1.387 albertel 7320:
1.1029 www 7321: span.LC_current_nav_location {
7322: font-weight:bold;
7323: background: $sidebg;
7324: }
7325:
1.395 albertel 7326: span.LC_parm_menu_item {
7327: font-size: larger;
7328: }
1.795 www 7329:
1.395 albertel 7330: span.LC_parm_scope_all {
7331: color: red;
7332: }
1.795 www 7333:
1.395 albertel 7334: span.LC_parm_scope_folder {
7335: color: green;
7336: }
1.795 www 7337:
1.395 albertel 7338: span.LC_parm_scope_resource {
7339: color: orange;
7340: }
1.795 www 7341:
1.395 albertel 7342: span.LC_parm_part {
7343: color: blue;
7344: }
1.795 www 7345:
1.911 bisitz 7346: span.LC_parm_folder,
7347: span.LC_parm_symb {
1.395 albertel 7348: font-size: x-small;
7349: font-family: $mono;
7350: color: #AAAAAA;
7351: }
7352:
1.977 bisitz 7353: ul.LC_parm_parmlist li {
7354: display: inline-block;
7355: padding: 0.3em 0.8em;
7356: vertical-align: top;
7357: width: 150px;
7358: border-top:1px solid $lg_border_color;
7359: }
7360:
1.795 www 7361: td.LC_parm_overview_level_menu,
7362: td.LC_parm_overview_map_menu,
7363: td.LC_parm_overview_parm_selectors,
7364: td.LC_parm_overview_restrictions {
1.396 albertel 7365: border: 1px solid black;
7366: border-collapse: collapse;
7367: }
1.795 www 7368:
1.1285 raeburn 7369: span.LC_parm_recursive,
7370: td.LC_parm_recursive {
7371: font-weight: bold;
7372: font-size: smaller;
7373: }
7374:
1.396 albertel 7375: table.LC_parm_overview_restrictions td {
7376: border-width: 1px 4px 1px 4px;
7377: border-style: solid;
7378: border-color: $pgbg;
7379: text-align: center;
7380: }
1.795 www 7381:
1.396 albertel 7382: table.LC_parm_overview_restrictions th {
7383: background: $tabbg;
7384: border-width: 1px 4px 1px 4px;
7385: border-style: solid;
7386: border-color: $pgbg;
7387: }
1.795 www 7388:
1.398 albertel 7389: table#LC_helpmenu {
1.803 bisitz 7390: border: none;
1.398 albertel 7391: height: 55px;
1.803 bisitz 7392: border-spacing: 0;
1.398 albertel 7393: }
7394:
7395: table#LC_helpmenu fieldset legend {
7396: font-size: larger;
7397: }
1.795 www 7398:
1.397 albertel 7399: table#LC_helpmenu_links {
7400: width: 100%;
7401: border: 1px solid black;
7402: background: $pgbg;
1.803 bisitz 7403: padding: 0;
1.397 albertel 7404: border-spacing: 1px;
7405: }
1.795 www 7406:
1.397 albertel 7407: table#LC_helpmenu_links tr td {
7408: padding: 1px;
7409: background: $tabbg;
1.399 albertel 7410: text-align: center;
7411: font-weight: bold;
1.397 albertel 7412: }
1.396 albertel 7413:
1.795 www 7414: table#LC_helpmenu_links a:link,
7415: table#LC_helpmenu_links a:visited,
1.397 albertel 7416: table#LC_helpmenu_links a:active {
7417: text-decoration: none;
7418: color: $font;
7419: }
1.795 www 7420:
1.397 albertel 7421: table#LC_helpmenu_links a:hover {
7422: text-decoration: underline;
7423: color: $vlink;
7424: }
1.396 albertel 7425:
1.417 albertel 7426: .LC_chrt_popup_exists {
7427: border: 1px solid #339933;
7428: margin: -1px;
7429: }
1.795 www 7430:
1.417 albertel 7431: .LC_chrt_popup_up {
7432: border: 1px solid yellow;
7433: margin: -1px;
7434: }
1.795 www 7435:
1.417 albertel 7436: .LC_chrt_popup {
7437: border: 1px solid #8888FF;
7438: background: #CCCCFF;
7439: }
1.795 www 7440:
1.421 albertel 7441: table.LC_pick_box {
7442: border-collapse: separate;
7443: background: white;
7444: border: 1px solid black;
7445: border-spacing: 1px;
7446: }
1.795 www 7447:
1.421 albertel 7448: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 7449: background: $sidebg;
1.421 albertel 7450: font-weight: bold;
1.900 bisitz 7451: text-align: left;
1.740 bisitz 7452: vertical-align: top;
1.421 albertel 7453: width: 184px;
7454: padding: 8px;
7455: }
1.795 www 7456:
1.579 raeburn 7457: table.LC_pick_box td.LC_pick_box_value {
7458: text-align: left;
7459: padding: 8px;
7460: }
1.795 www 7461:
1.579 raeburn 7462: table.LC_pick_box td.LC_pick_box_select {
7463: text-align: left;
7464: padding: 8px;
7465: }
1.795 www 7466:
1.424 albertel 7467: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 7468: padding: 0;
1.421 albertel 7469: height: 1px;
7470: background: black;
7471: }
1.795 www 7472:
1.421 albertel 7473: table.LC_pick_box td.LC_pick_box_submit {
7474: text-align: right;
7475: }
1.795 www 7476:
1.579 raeburn 7477: table.LC_pick_box td.LC_evenrow_value {
7478: text-align: left;
7479: padding: 8px;
7480: background-color: $data_table_light;
7481: }
1.795 www 7482:
1.579 raeburn 7483: table.LC_pick_box td.LC_oddrow_value {
7484: text-align: left;
7485: padding: 8px;
7486: background-color: $data_table_light;
7487: }
1.795 www 7488:
1.579 raeburn 7489: span.LC_helpform_receipt_cat {
7490: font-weight: bold;
7491: }
1.795 www 7492:
1.424 albertel 7493: table.LC_group_priv_box {
7494: background: white;
7495: border: 1px solid black;
7496: border-spacing: 1px;
7497: }
1.795 www 7498:
1.424 albertel 7499: table.LC_group_priv_box td.LC_pick_box_title {
7500: background: $tabbg;
7501: font-weight: bold;
7502: text-align: right;
7503: width: 184px;
7504: }
1.795 www 7505:
1.424 albertel 7506: table.LC_group_priv_box td.LC_groups_fixed {
7507: background: $data_table_light;
7508: text-align: center;
7509: }
1.795 www 7510:
1.424 albertel 7511: table.LC_group_priv_box td.LC_groups_optional {
7512: background: $data_table_dark;
7513: text-align: center;
7514: }
1.795 www 7515:
1.424 albertel 7516: table.LC_group_priv_box td.LC_groups_functionality {
7517: background: $data_table_darker;
7518: text-align: center;
7519: font-weight: bold;
7520: }
1.795 www 7521:
1.424 albertel 7522: table.LC_group_priv td {
7523: text-align: left;
1.803 bisitz 7524: padding: 0;
1.424 albertel 7525: }
7526:
7527: .LC_navbuttons {
7528: margin: 2ex 0ex 2ex 0ex;
7529: }
1.795 www 7530:
1.423 albertel 7531: .LC_topic_bar {
7532: font-weight: bold;
7533: background: $tabbg;
1.918 wenzelju 7534: margin: 1em 0em 1em 2em;
1.805 bisitz 7535: padding: 3px;
1.918 wenzelju 7536: font-size: 1.2em;
1.423 albertel 7537: }
1.795 www 7538:
1.423 albertel 7539: .LC_topic_bar span {
1.918 wenzelju 7540: left: 0.5em;
7541: position: absolute;
1.423 albertel 7542: vertical-align: middle;
1.918 wenzelju 7543: font-size: 1.2em;
1.423 albertel 7544: }
1.795 www 7545:
1.423 albertel 7546: table.LC_course_group_status {
7547: margin: 20px;
7548: }
1.795 www 7549:
1.423 albertel 7550: table.LC_status_selector td {
7551: vertical-align: top;
7552: text-align: center;
1.424 albertel 7553: padding: 4px;
7554: }
1.795 www 7555:
1.599 albertel 7556: div.LC_feedback_link {
1.616 albertel 7557: clear: both;
1.829 kalberla 7558: background: $sidebg;
1.779 bisitz 7559: width: 100%;
1.829 kalberla 7560: padding-bottom: 10px;
7561: border: 1px $tabbg solid;
1.833 kalberla 7562: height: 22px;
7563: line-height: 22px;
7564: padding-top: 5px;
7565: }
7566:
7567: div.LC_feedback_link img {
7568: height: 22px;
1.867 kalberla 7569: vertical-align:middle;
1.829 kalberla 7570: }
7571:
1.911 bisitz 7572: div.LC_feedback_link a {
1.829 kalberla 7573: text-decoration: none;
1.489 raeburn 7574: }
1.795 www 7575:
1.867 kalberla 7576: div.LC_comblock {
1.911 bisitz 7577: display:inline;
1.867 kalberla 7578: color:$font;
7579: font-size:90%;
7580: }
7581:
7582: div.LC_feedback_link div.LC_comblock {
7583: padding-left:5px;
7584: }
7585:
7586: div.LC_feedback_link div.LC_comblock a {
7587: color:$font;
7588: }
7589:
1.489 raeburn 7590: span.LC_feedback_link {
1.858 bisitz 7591: /* background: $feedback_link_bg; */
1.599 albertel 7592: font-size: larger;
7593: }
1.795 www 7594:
1.599 albertel 7595: span.LC_message_link {
1.858 bisitz 7596: /* background: $feedback_link_bg; */
1.599 albertel 7597: font-size: larger;
7598: position: absolute;
7599: right: 1em;
1.489 raeburn 7600: }
1.421 albertel 7601:
1.515 albertel 7602: table.LC_prior_tries {
1.524 albertel 7603: border: 1px solid #000000;
7604: border-collapse: separate;
7605: border-spacing: 1px;
1.515 albertel 7606: }
1.523 albertel 7607:
1.515 albertel 7608: table.LC_prior_tries td {
1.524 albertel 7609: padding: 2px;
1.515 albertel 7610: }
1.523 albertel 7611:
7612: .LC_answer_correct {
1.795 www 7613: background: lightgreen;
7614: color: darkgreen;
7615: padding: 6px;
1.523 albertel 7616: }
1.795 www 7617:
1.523 albertel 7618: .LC_answer_charged_try {
1.797 www 7619: background: #FFAAAA;
1.795 www 7620: color: darkred;
7621: padding: 6px;
1.523 albertel 7622: }
1.795 www 7623:
1.779 bisitz 7624: .LC_answer_not_charged_try,
1.523 albertel 7625: .LC_answer_no_grade,
7626: .LC_answer_late {
1.795 www 7627: background: lightyellow;
1.523 albertel 7628: color: black;
1.795 www 7629: padding: 6px;
1.523 albertel 7630: }
1.795 www 7631:
1.523 albertel 7632: .LC_answer_previous {
1.795 www 7633: background: lightblue;
7634: color: darkblue;
7635: padding: 6px;
1.523 albertel 7636: }
1.795 www 7637:
1.779 bisitz 7638: .LC_answer_no_message {
1.777 tempelho 7639: background: #FFFFFF;
7640: color: black;
1.795 www 7641: padding: 6px;
1.779 bisitz 7642: }
1.795 www 7643:
1.1334 raeburn 7644: .LC_answer_unknown,
7645: .LC_answer_warning {
1.779 bisitz 7646: background: orange;
7647: color: black;
1.795 www 7648: padding: 6px;
1.777 tempelho 7649: }
1.795 www 7650:
1.529 albertel 7651: span.LC_prior_numerical,
7652: span.LC_prior_string,
7653: span.LC_prior_custom,
7654: span.LC_prior_reaction,
7655: span.LC_prior_math {
1.925 bisitz 7656: font-family: $mono;
1.523 albertel 7657: white-space: pre;
7658: }
7659:
1.525 albertel 7660: span.LC_prior_string {
1.925 bisitz 7661: font-family: $mono;
1.525 albertel 7662: white-space: pre;
7663: }
7664:
1.523 albertel 7665: table.LC_prior_option {
7666: width: 100%;
7667: border-collapse: collapse;
7668: }
1.795 www 7669:
1.911 bisitz 7670: table.LC_prior_rank,
1.795 www 7671: table.LC_prior_match {
1.528 albertel 7672: border-collapse: collapse;
7673: }
1.795 www 7674:
1.528 albertel 7675: table.LC_prior_option tr td,
7676: table.LC_prior_rank tr td,
7677: table.LC_prior_match tr td {
1.524 albertel 7678: border: 1px solid #000000;
1.515 albertel 7679: }
7680:
1.855 bisitz 7681: .LC_nobreak {
1.544 albertel 7682: white-space: nowrap;
1.519 raeburn 7683: }
7684:
1.576 raeburn 7685: span.LC_cusr_emph {
7686: font-style: italic;
7687: }
7688:
1.633 raeburn 7689: span.LC_cusr_subheading {
7690: font-weight: normal;
7691: font-size: 85%;
7692: }
7693:
1.861 bisitz 7694: div.LC_docs_entry_move {
1.859 bisitz 7695: border: 1px solid #BBBBBB;
1.545 albertel 7696: background: #DDDDDD;
1.861 bisitz 7697: width: 22px;
1.859 bisitz 7698: padding: 1px;
7699: margin: 0;
1.545 albertel 7700: }
7701:
1.861 bisitz 7702: table.LC_data_table tr > td.LC_docs_entry_commands,
7703: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7704: font-size: x-small;
7705: }
1.795 www 7706:
1.861 bisitz 7707: .LC_docs_entry_parameter {
7708: white-space: nowrap;
7709: }
7710:
1.544 albertel 7711: .LC_docs_copy {
1.545 albertel 7712: color: #000099;
1.544 albertel 7713: }
1.795 www 7714:
1.544 albertel 7715: .LC_docs_cut {
1.545 albertel 7716: color: #550044;
1.544 albertel 7717: }
1.795 www 7718:
1.544 albertel 7719: .LC_docs_rename {
1.545 albertel 7720: color: #009900;
1.544 albertel 7721: }
1.795 www 7722:
1.544 albertel 7723: .LC_docs_remove {
1.545 albertel 7724: color: #990000;
7725: }
7726:
1.1284 raeburn 7727: .LC_docs_alias {
7728: color: #440055;
7729: }
7730:
1.1286 raeburn 7731: .LC_domprefs_email,
1.1284 raeburn 7732: .LC_docs_alias_name,
1.547 albertel 7733: .LC_docs_reinit_warn,
7734: .LC_docs_ext_edit {
7735: font-size: x-small;
7736: }
7737:
1.545 albertel 7738: table.LC_docs_adddocs td,
7739: table.LC_docs_adddocs th {
7740: border: 1px solid #BBBBBB;
7741: padding: 4px;
7742: background: #DDDDDD;
1.543 albertel 7743: }
7744:
1.584 albertel 7745: table.LC_sty_begin {
7746: background: #BBFFBB;
7747: }
1.795 www 7748:
1.584 albertel 7749: table.LC_sty_end {
7750: background: #FFBBBB;
7751: }
7752:
1.589 raeburn 7753: table.LC_double_column {
1.803 bisitz 7754: border-width: 0;
1.589 raeburn 7755: border-collapse: collapse;
7756: width: 100%;
7757: padding: 2px;
7758: }
7759:
7760: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7761: top: 2px;
1.589 raeburn 7762: left: 2px;
7763: width: 47%;
7764: vertical-align: top;
7765: }
7766:
7767: table.LC_double_column tr td.LC_right_col {
7768: top: 2px;
1.779 bisitz 7769: right: 2px;
1.589 raeburn 7770: width: 47%;
7771: vertical-align: top;
7772: }
7773:
1.591 raeburn 7774: div.LC_left_float {
7775: float: left;
7776: padding-right: 5%;
1.597 albertel 7777: padding-bottom: 4px;
1.591 raeburn 7778: }
7779:
7780: div.LC_clear_float_header {
1.597 albertel 7781: padding-bottom: 2px;
1.591 raeburn 7782: }
7783:
7784: div.LC_clear_float_footer {
1.597 albertel 7785: padding-top: 10px;
1.591 raeburn 7786: clear: both;
7787: }
7788:
1.597 albertel 7789: div.LC_grade_show_user {
1.941 bisitz 7790: /* border-left: 5px solid $sidebg; */
7791: border-top: 5px solid #000000;
7792: margin: 50px 0 0 0;
1.936 bisitz 7793: padding: 15px 0 5px 10px;
1.597 albertel 7794: }
1.795 www 7795:
1.936 bisitz 7796: div.LC_grade_show_user_odd_row {
1.941 bisitz 7797: /* border-left: 5px solid #000000; */
7798: }
7799:
7800: div.LC_grade_show_user div.LC_Box {
7801: margin-right: 50px;
1.597 albertel 7802: }
7803:
7804: div.LC_grade_submissions,
7805: div.LC_grade_message_center,
1.936 bisitz 7806: div.LC_grade_info_links {
1.597 albertel 7807: margin: 5px;
7808: width: 99%;
7809: background: #FFFFFF;
7810: }
1.795 www 7811:
1.597 albertel 7812: div.LC_grade_submissions_header,
1.936 bisitz 7813: div.LC_grade_message_center_header {
1.705 tempelho 7814: font-weight: bold;
7815: font-size: large;
1.597 albertel 7816: }
1.795 www 7817:
1.597 albertel 7818: div.LC_grade_submissions_body,
1.936 bisitz 7819: div.LC_grade_message_center_body {
1.597 albertel 7820: border: 1px solid black;
7821: width: 99%;
7822: background: #FFFFFF;
7823: }
1.795 www 7824:
1.613 albertel 7825: table.LC_scantron_action {
7826: width: 100%;
7827: }
1.795 www 7828:
1.613 albertel 7829: table.LC_scantron_action tr th {
1.698 harmsja 7830: font-weight:bold;
7831: font-style:normal;
1.613 albertel 7832: }
1.795 www 7833:
1.779 bisitz 7834: .LC_edit_problem_header,
1.614 albertel 7835: div.LC_edit_problem_footer {
1.705 tempelho 7836: font-weight: normal;
7837: font-size: medium;
1.602 albertel 7838: margin: 2px;
1.1060 bisitz 7839: background-color: $sidebg;
1.600 albertel 7840: }
1.795 www 7841:
1.600 albertel 7842: div.LC_edit_problem_header,
1.602 albertel 7843: div.LC_edit_problem_header div,
1.614 albertel 7844: div.LC_edit_problem_footer,
7845: div.LC_edit_problem_footer div,
1.602 albertel 7846: div.LC_edit_problem_editxml_header,
7847: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7848: z-index: 100;
1.600 albertel 7849: }
1.795 www 7850:
1.600 albertel 7851: div.LC_edit_problem_header_title {
1.705 tempelho 7852: font-weight: bold;
7853: font-size: larger;
1.602 albertel 7854: background: $tabbg;
7855: padding: 3px;
1.1060 bisitz 7856: margin: 0 0 5px 0;
1.602 albertel 7857: }
1.795 www 7858:
1.602 albertel 7859: table.LC_edit_problem_header_title {
7860: width: 100%;
1.600 albertel 7861: background: $tabbg;
1.602 albertel 7862: }
7863:
1.1205 golterma 7864: div.LC_edit_actionbar {
7865: background-color: $sidebg;
1.1218 droeschl 7866: margin: 0;
7867: padding: 0;
7868: line-height: 200%;
1.602 albertel 7869: }
1.795 www 7870:
1.1218 droeschl 7871: div.LC_edit_actionbar div{
7872: padding: 0;
7873: margin: 0;
7874: display: inline-block;
1.600 albertel 7875: }
1.795 www 7876:
1.1124 bisitz 7877: .LC_edit_opt {
7878: padding-left: 1em;
7879: white-space: nowrap;
7880: }
7881:
1.1152 golterma 7882: .LC_edit_problem_latexhelper{
7883: text-align: right;
7884: }
7885:
7886: #LC_edit_problem_colorful div{
7887: margin-left: 40px;
7888: }
7889:
1.1205 golterma 7890: #LC_edit_problem_codemirror div{
7891: margin-left: 0px;
7892: }
7893:
1.911 bisitz 7894: img.stift {
1.803 bisitz 7895: border-width: 0;
7896: vertical-align: middle;
1.677 riegler 7897: }
1.680 riegler 7898:
1.923 bisitz 7899: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7900: vertical-align: top;
1.777 tempelho 7901: }
1.795 www 7902:
1.716 raeburn 7903: div.LC_createcourse {
1.911 bisitz 7904: margin: 10px 10px 10px 10px;
1.716 raeburn 7905: }
7906:
1.917 raeburn 7907: .LC_dccid {
1.1130 raeburn 7908: float: right;
1.917 raeburn 7909: margin: 0.2em 0 0 0;
7910: padding: 0;
7911: font-size: 90%;
7912: display:none;
7913: }
7914:
1.897 wenzelju 7915: ol.LC_primary_menu a:hover,
1.721 harmsja 7916: ol#LC_MenuBreadcrumbs a:hover,
7917: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7918: ul#LC_secondary_menu a:hover,
1.721 harmsja 7919: .LC_FormSectionClearButton input:hover
1.795 www 7920: ul.LC_TabContent li:hover a {
1.952 onken 7921: color:$button_hover;
1.911 bisitz 7922: text-decoration:none;
1.693 droeschl 7923: }
7924:
1.779 bisitz 7925: h1 {
1.911 bisitz 7926: padding: 0;
7927: line-height:130%;
1.693 droeschl 7928: }
1.698 harmsja 7929:
1.911 bisitz 7930: h2,
7931: h3,
7932: h4,
7933: h5,
7934: h6 {
7935: margin: 5px 0 5px 0;
7936: padding: 0;
7937: line-height:130%;
1.693 droeschl 7938: }
1.795 www 7939:
7940: .LC_hcell {
1.911 bisitz 7941: padding:3px 15px 3px 15px;
7942: margin: 0;
7943: background-color:$tabbg;
7944: color:$fontmenu;
7945: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7946: }
1.795 www 7947:
1.840 bisitz 7948: .LC_Box > .LC_hcell {
1.911 bisitz 7949: margin: 0 -10px 10px -10px;
1.835 bisitz 7950: }
7951:
1.721 harmsja 7952: .LC_noBorder {
1.911 bisitz 7953: border: 0;
1.698 harmsja 7954: }
1.693 droeschl 7955:
1.721 harmsja 7956: .LC_FormSectionClearButton input {
1.911 bisitz 7957: background-color:transparent;
7958: border: none;
7959: cursor:pointer;
7960: text-decoration:underline;
1.693 droeschl 7961: }
1.763 bisitz 7962:
7963: .LC_help_open_topic {
1.911 bisitz 7964: color: #FFFFFF;
7965: background-color: #EEEEFF;
7966: margin: 1px;
7967: padding: 4px;
7968: border: 1px solid #000033;
7969: white-space: nowrap;
7970: /* vertical-align: middle; */
1.759 neumanie 7971: }
1.693 droeschl 7972:
1.911 bisitz 7973: dl,
7974: ul,
7975: div,
7976: fieldset {
7977: margin: 10px 10px 10px 0;
7978: /* overflow: hidden; */
1.693 droeschl 7979: }
1.795 www 7980:
1.1211 raeburn 7981: article.geogebraweb div {
7982: margin: 0;
7983: }
7984:
1.838 bisitz 7985: fieldset > legend {
1.911 bisitz 7986: font-weight: bold;
7987: padding: 0 5px 0 5px;
1.838 bisitz 7988: }
7989:
1.813 bisitz 7990: #LC_nav_bar {
1.911 bisitz 7991: float: left;
1.995 raeburn 7992: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7993: margin: 0 0 2px 0;
1.807 droeschl 7994: }
7995:
1.916 droeschl 7996: #LC_realm {
7997: margin: 0.2em 0 0 0;
7998: padding: 0;
7999: font-weight: bold;
8000: text-align: center;
1.995 raeburn 8001: background-color: $pgbg_or_bgcolor;
1.916 droeschl 8002: }
8003:
1.911 bisitz 8004: #LC_nav_bar em {
8005: font-weight: bold;
8006: font-style: normal;
1.807 droeschl 8007: }
8008:
1.897 wenzelju 8009: ol.LC_primary_menu {
1.934 droeschl 8010: margin: 0;
1.1076 raeburn 8011: padding: 0;
1.807 droeschl 8012: }
8013:
1.852 droeschl 8014: ol#LC_PathBreadcrumbs {
1.911 bisitz 8015: margin: 0;
1.693 droeschl 8016: }
8017:
1.897 wenzelju 8018: ol.LC_primary_menu li {
1.1076 raeburn 8019: color: RGB(80, 80, 80);
8020: vertical-align: middle;
8021: text-align: left;
8022: list-style: none;
1.1205 golterma 8023: position: relative;
1.1076 raeburn 8024: float: left;
1.1205 golterma 8025: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
8026: line-height: 1.5em;
1.1076 raeburn 8027: }
8028:
1.1205 golterma 8029: ol.LC_primary_menu li a,
8030: ol.LC_primary_menu li p {
1.1076 raeburn 8031: display: block;
8032: margin: 0;
8033: padding: 0 5px 0 10px;
8034: text-decoration: none;
8035: }
8036:
1.1205 golterma 8037: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
8038: display: inline-block;
8039: width: 95%;
8040: text-align: left;
8041: }
8042:
8043: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
8044: display: inline-block;
8045: width: 5%;
8046: float: right;
8047: text-align: right;
8048: font-size: 70%;
8049: }
8050:
8051: ol.LC_primary_menu ul {
1.1076 raeburn 8052: display: none;
1.1205 golterma 8053: width: 15em;
1.1076 raeburn 8054: background-color: $data_table_light;
1.1205 golterma 8055: position: absolute;
8056: top: 100%;
1.1076 raeburn 8057: }
8058:
1.1205 golterma 8059: ol.LC_primary_menu ul ul {
8060: left: 100%;
8061: top: 0;
8062: }
8063:
8064: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 8065: display: block;
8066: position: absolute;
8067: margin: 0;
8068: padding: 0;
1.1078 raeburn 8069: z-index: 2;
1.1076 raeburn 8070: }
8071:
8072: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 8073: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 8074: font-size: 90%;
1.911 bisitz 8075: vertical-align: top;
1.1076 raeburn 8076: float: none;
1.1079 raeburn 8077: border-left: 1px solid black;
8078: border-right: 1px solid black;
1.1205 golterma 8079: /* A dark bottom border to visualize different menu options;
8080: overwritten in the create_submenu routine for the last border-bottom of the menu */
8081: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 8082: }
8083:
1.1205 golterma 8084: ol.LC_primary_menu li li p:hover {
8085: color:$button_hover;
8086: text-decoration:none;
8087: background-color:$data_table_dark;
1.1076 raeburn 8088: }
8089:
8090: ol.LC_primary_menu li li a:hover {
8091: color:$button_hover;
8092: background-color:$data_table_dark;
1.693 droeschl 8093: }
8094:
1.1205 golterma 8095: /* Font-size equal to the size of the predecessors*/
8096: ol.LC_primary_menu li:hover li li {
8097: font-size: 100%;
8098: }
8099:
1.897 wenzelju 8100: ol.LC_primary_menu li img {
1.911 bisitz 8101: vertical-align: bottom;
1.934 droeschl 8102: height: 1.1em;
1.1077 raeburn 8103: margin: 0.2em 0 0 0;
1.693 droeschl 8104: }
8105:
1.897 wenzelju 8106: ol.LC_primary_menu a {
1.911 bisitz 8107: color: RGB(80, 80, 80);
8108: text-decoration: none;
1.693 droeschl 8109: }
1.795 www 8110:
1.949 droeschl 8111: ol.LC_primary_menu a.LC_new_message {
8112: font-weight:bold;
8113: color: darkred;
8114: }
8115:
1.975 raeburn 8116: ol.LC_docs_parameters {
8117: margin-left: 0;
8118: padding: 0;
8119: list-style: none;
8120: }
8121:
8122: ol.LC_docs_parameters li {
8123: margin: 0;
8124: padding-right: 20px;
8125: display: inline;
8126: }
8127:
1.976 raeburn 8128: ol.LC_docs_parameters li:before {
8129: content: "\\002022 \\0020";
8130: }
8131:
8132: li.LC_docs_parameters_title {
8133: font-weight: bold;
8134: }
8135:
8136: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
8137: content: "";
8138: }
8139:
1.897 wenzelju 8140: ul#LC_secondary_menu {
1.1107 raeburn 8141: clear: right;
1.911 bisitz 8142: color: $fontmenu;
8143: background: $tabbg;
8144: list-style: none;
8145: padding: 0;
8146: margin: 0;
8147: width: 100%;
1.995 raeburn 8148: text-align: left;
1.1107 raeburn 8149: float: left;
1.808 droeschl 8150: }
8151:
1.897 wenzelju 8152: ul#LC_secondary_menu li {
1.911 bisitz 8153: font-weight: bold;
8154: line-height: 1.8em;
1.1107 raeburn 8155: border-right: 1px solid black;
8156: float: left;
8157: }
8158:
8159: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
8160: background-color: $data_table_light;
8161: }
8162:
8163: ul#LC_secondary_menu li a {
1.911 bisitz 8164: padding: 0 0.8em;
1.1107 raeburn 8165: }
8166:
8167: ul#LC_secondary_menu li ul {
8168: display: none;
8169: }
8170:
8171: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
8172: display: block;
8173: position: absolute;
8174: margin: 0;
8175: padding: 0;
8176: list-style:none;
8177: float: none;
8178: background-color: $data_table_light;
8179: z-index: 2;
8180: margin-left: -1px;
8181: }
8182:
8183: ul#LC_secondary_menu li ul li {
8184: font-size: 90%;
8185: vertical-align: top;
8186: border-left: 1px solid black;
1.911 bisitz 8187: border-right: 1px solid black;
1.1119 raeburn 8188: background-color: $data_table_light;
1.1107 raeburn 8189: list-style:none;
8190: float: none;
8191: }
8192:
8193: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
8194: background-color: $data_table_dark;
1.807 droeschl 8195: }
8196:
1.847 tempelho 8197: ul.LC_TabContent {
1.911 bisitz 8198: display:block;
8199: background: $sidebg;
8200: border-bottom: solid 1px $lg_border_color;
8201: list-style:none;
1.1020 raeburn 8202: margin: -1px -10px 0 -10px;
1.911 bisitz 8203: padding: 0;
1.693 droeschl 8204: }
8205:
1.795 www 8206: ul.LC_TabContent li,
8207: ul.LC_TabContentBigger li {
1.911 bisitz 8208: float:left;
1.741 harmsja 8209: }
1.795 www 8210:
1.897 wenzelju 8211: ul#LC_secondary_menu li a {
1.911 bisitz 8212: color: $fontmenu;
8213: text-decoration: none;
1.693 droeschl 8214: }
1.795 www 8215:
1.721 harmsja 8216: ul.LC_TabContent {
1.952 onken 8217: min-height:20px;
1.721 harmsja 8218: }
1.795 www 8219:
8220: ul.LC_TabContent li {
1.911 bisitz 8221: vertical-align:middle;
1.959 onken 8222: padding: 0 16px 0 10px;
1.911 bisitz 8223: background-color:$tabbg;
8224: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 8225: border-left: solid 1px $font;
1.721 harmsja 8226: }
1.795 www 8227:
1.847 tempelho 8228: ul.LC_TabContent .right {
1.911 bisitz 8229: float:right;
1.847 tempelho 8230: }
8231:
1.911 bisitz 8232: ul.LC_TabContent li a,
8233: ul.LC_TabContent li {
8234: color:rgb(47,47,47);
8235: text-decoration:none;
8236: font-size:95%;
8237: font-weight:bold;
1.952 onken 8238: min-height:20px;
8239: }
8240:
1.959 onken 8241: ul.LC_TabContent li a:hover,
8242: ul.LC_TabContent li a:focus {
1.952 onken 8243: color: $button_hover;
1.959 onken 8244: background:none;
8245: outline:none;
1.952 onken 8246: }
8247:
8248: ul.LC_TabContent li:hover {
8249: color: $button_hover;
8250: cursor:pointer;
1.721 harmsja 8251: }
1.795 www 8252:
1.911 bisitz 8253: ul.LC_TabContent li.active {
1.952 onken 8254: color: $font;
1.911 bisitz 8255: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 8256: border-bottom:solid 1px #FFFFFF;
8257: cursor: default;
1.744 ehlerst 8258: }
1.795 www 8259:
1.959 onken 8260: ul.LC_TabContent li.active a {
8261: color:$font;
8262: background:#FFFFFF;
8263: outline: none;
8264: }
1.1047 raeburn 8265:
8266: ul.LC_TabContent li.goback {
8267: float: left;
8268: border-left: none;
8269: }
8270:
1.870 tempelho 8271: #maincoursedoc {
1.911 bisitz 8272: clear:both;
1.870 tempelho 8273: }
8274:
8275: ul.LC_TabContentBigger {
1.911 bisitz 8276: display:block;
8277: list-style:none;
8278: padding: 0;
1.870 tempelho 8279: }
8280:
1.795 www 8281: ul.LC_TabContentBigger li {
1.911 bisitz 8282: vertical-align:bottom;
8283: height: 30px;
8284: font-size:110%;
8285: font-weight:bold;
8286: color: #737373;
1.841 tempelho 8287: }
8288:
1.957 onken 8289: ul.LC_TabContentBigger li.active {
8290: position: relative;
8291: top: 1px;
8292: }
8293:
1.870 tempelho 8294: ul.LC_TabContentBigger li a {
1.911 bisitz 8295: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
8296: height: 30px;
8297: line-height: 30px;
8298: text-align: center;
8299: display: block;
8300: text-decoration: none;
1.958 onken 8301: outline: none;
1.741 harmsja 8302: }
1.795 www 8303:
1.870 tempelho 8304: ul.LC_TabContentBigger li.active a {
1.911 bisitz 8305: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
8306: color:$font;
1.744 ehlerst 8307: }
1.795 www 8308:
1.870 tempelho 8309: ul.LC_TabContentBigger li b {
1.911 bisitz 8310: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
8311: display: block;
8312: float: left;
8313: padding: 0 30px;
1.957 onken 8314: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 8315: }
8316:
1.956 onken 8317: ul.LC_TabContentBigger li:hover b {
8318: color:$button_hover;
8319: }
8320:
1.870 tempelho 8321: ul.LC_TabContentBigger li.active b {
1.911 bisitz 8322: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
8323: color:$font;
1.957 onken 8324: border: 0;
1.741 harmsja 8325: }
1.693 droeschl 8326:
1.870 tempelho 8327:
1.862 bisitz 8328: ul.LC_CourseBreadcrumbs {
8329: background: $sidebg;
1.1020 raeburn 8330: height: 2em;
1.862 bisitz 8331: padding-left: 10px;
1.1020 raeburn 8332: margin: 0;
1.862 bisitz 8333: list-style-position: inside;
8334: }
8335:
1.911 bisitz 8336: ol#LC_MenuBreadcrumbs,
1.862 bisitz 8337: ol#LC_PathBreadcrumbs {
1.911 bisitz 8338: padding-left: 10px;
8339: margin: 0;
1.933 droeschl 8340: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 8341: }
8342:
1.911 bisitz 8343: ol#LC_MenuBreadcrumbs li,
8344: ol#LC_PathBreadcrumbs li,
1.862 bisitz 8345: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 8346: display: inline;
1.933 droeschl 8347: white-space: normal;
1.693 droeschl 8348: }
8349:
1.823 bisitz 8350: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 8351: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 8352: text-decoration: none;
8353: font-size:90%;
1.693 droeschl 8354: }
1.795 www 8355:
1.969 droeschl 8356: ol#LC_MenuBreadcrumbs h1 {
8357: display: inline;
8358: font-size: 90%;
8359: line-height: 2.5em;
8360: margin: 0;
8361: padding: 0;
8362: }
8363:
1.795 www 8364: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 8365: text-decoration:none;
8366: font-size:100%;
8367: font-weight:bold;
1.693 droeschl 8368: }
1.795 www 8369:
1.840 bisitz 8370: .LC_Box {
1.911 bisitz 8371: border: solid 1px $lg_border_color;
8372: padding: 0 10px 10px 10px;
1.746 neumanie 8373: }
1.795 www 8374:
1.1020 raeburn 8375: .LC_DocsBox {
8376: border: solid 1px $lg_border_color;
8377: padding: 0 0 10px 10px;
8378: }
8379:
1.795 www 8380: .LC_AboutMe_Image {
1.911 bisitz 8381: float:left;
8382: margin-right:10px;
1.747 neumanie 8383: }
1.795 www 8384:
8385: .LC_Clear_AboutMe_Image {
1.911 bisitz 8386: clear:left;
1.747 neumanie 8387: }
1.795 www 8388:
1.721 harmsja 8389: dl.LC_ListStyleClean dt {
1.911 bisitz 8390: padding-right: 5px;
8391: display: table-header-group;
1.693 droeschl 8392: }
8393:
1.721 harmsja 8394: dl.LC_ListStyleClean dd {
1.911 bisitz 8395: display: table-row;
1.693 droeschl 8396: }
8397:
1.721 harmsja 8398: .LC_ListStyleClean,
8399: .LC_ListStyleSimple,
8400: .LC_ListStyleNormal,
1.795 www 8401: .LC_ListStyleSpecial {
1.911 bisitz 8402: /* display:block; */
8403: list-style-position: inside;
8404: list-style-type: none;
8405: overflow: hidden;
8406: padding: 0;
1.693 droeschl 8407: }
8408:
1.721 harmsja 8409: .LC_ListStyleSimple li,
8410: .LC_ListStyleSimple dd,
8411: .LC_ListStyleNormal li,
8412: .LC_ListStyleNormal dd,
8413: .LC_ListStyleSpecial li,
1.795 www 8414: .LC_ListStyleSpecial dd {
1.911 bisitz 8415: margin: 0;
8416: padding: 5px 5px 5px 10px;
8417: clear: both;
1.693 droeschl 8418: }
8419:
1.721 harmsja 8420: .LC_ListStyleClean li,
8421: .LC_ListStyleClean dd {
1.911 bisitz 8422: padding-top: 0;
8423: padding-bottom: 0;
1.693 droeschl 8424: }
8425:
1.721 harmsja 8426: .LC_ListStyleSimple dd,
1.795 www 8427: .LC_ListStyleSimple li {
1.911 bisitz 8428: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 8429: }
8430:
1.721 harmsja 8431: .LC_ListStyleSpecial li,
8432: .LC_ListStyleSpecial dd {
1.911 bisitz 8433: list-style-type: none;
8434: background-color: RGB(220, 220, 220);
8435: margin-bottom: 4px;
1.693 droeschl 8436: }
8437:
1.721 harmsja 8438: table.LC_SimpleTable {
1.911 bisitz 8439: margin:5px;
8440: border:solid 1px $lg_border_color;
1.795 www 8441: }
1.693 droeschl 8442:
1.721 harmsja 8443: table.LC_SimpleTable tr {
1.911 bisitz 8444: padding: 0;
8445: border:solid 1px $lg_border_color;
1.693 droeschl 8446: }
1.795 www 8447:
8448: table.LC_SimpleTable thead {
1.911 bisitz 8449: background:rgb(220,220,220);
1.693 droeschl 8450: }
8451:
1.721 harmsja 8452: div.LC_columnSection {
1.911 bisitz 8453: display: block;
8454: clear: both;
8455: overflow: hidden;
8456: margin: 0;
1.693 droeschl 8457: }
8458:
1.721 harmsja 8459: div.LC_columnSection>* {
1.911 bisitz 8460: float: left;
8461: margin: 10px 20px 10px 0;
8462: overflow:hidden;
1.693 droeschl 8463: }
1.721 harmsja 8464:
1.795 www 8465: table em {
1.911 bisitz 8466: font-weight: bold;
8467: font-style: normal;
1.748 schulted 8468: }
1.795 www 8469:
1.779 bisitz 8470: table.LC_tableBrowseRes,
1.795 www 8471: table.LC_tableOfContent {
1.911 bisitz 8472: border:none;
8473: border-spacing: 1px;
8474: padding: 3px;
8475: background-color: #FFFFFF;
8476: font-size: 90%;
1.753 droeschl 8477: }
1.789 droeschl 8478:
1.911 bisitz 8479: table.LC_tableOfContent {
8480: border-collapse: collapse;
1.789 droeschl 8481: }
8482:
1.771 droeschl 8483: table.LC_tableBrowseRes a,
1.768 schulted 8484: table.LC_tableOfContent a {
1.911 bisitz 8485: background-color: transparent;
8486: text-decoration: none;
1.753 droeschl 8487: }
8488:
1.795 www 8489: table.LC_tableOfContent img {
1.911 bisitz 8490: border: none;
8491: height: 1.3em;
8492: vertical-align: text-bottom;
8493: margin-right: 0.3em;
1.753 droeschl 8494: }
1.757 schulted 8495:
1.795 www 8496: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8497: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8498: }
8499:
1.795 www 8500: a#LC_content_toolbar_everything {
1.911 bisitz 8501: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8502: }
8503:
1.795 www 8504: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8505: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8506: }
8507:
1.795 www 8508: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8509: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8510: }
8511:
1.795 www 8512: a#LC_content_toolbar_changefolder {
1.911 bisitz 8513: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8514: }
8515:
1.795 www 8516: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8517: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8518: }
8519:
1.1043 raeburn 8520: a#LC_content_toolbar_edittoplevel {
8521: background-image:url(/res/adm/pages/edittoplevel.gif);
8522: }
8523:
1.795 www 8524: ul#LC_toolbar li a:hover {
1.911 bisitz 8525: background-position: bottom center;
1.757 schulted 8526: }
8527:
1.795 www 8528: ul#LC_toolbar {
1.911 bisitz 8529: padding: 0;
8530: margin: 2px;
8531: list-style:none;
8532: position:relative;
8533: background-color:white;
1.1082 raeburn 8534: overflow: auto;
1.757 schulted 8535: }
8536:
1.795 www 8537: ul#LC_toolbar li {
1.911 bisitz 8538: border:1px solid white;
8539: padding: 0;
8540: margin: 0;
8541: float: left;
8542: display:inline;
8543: vertical-align:middle;
1.1082 raeburn 8544: white-space: nowrap;
1.911 bisitz 8545: }
1.757 schulted 8546:
1.783 amueller 8547:
1.795 www 8548: a.LC_toolbarItem {
1.911 bisitz 8549: display:block;
8550: padding: 0;
8551: margin: 0;
8552: height: 32px;
8553: width: 32px;
8554: color:white;
8555: border: none;
8556: background-repeat:no-repeat;
8557: background-color:transparent;
1.757 schulted 8558: }
8559:
1.915 droeschl 8560: ul.LC_funclist {
8561: margin: 0;
8562: padding: 0.5em 1em 0.5em 0;
8563: }
8564:
1.933 droeschl 8565: ul.LC_funclist > li:first-child {
8566: font-weight:bold;
8567: margin-left:0.8em;
8568: }
8569:
1.915 droeschl 8570: ul.LC_funclist + ul.LC_funclist {
8571: /*
8572: left border as a seperator if we have more than
8573: one list
8574: */
8575: border-left: 1px solid $sidebg;
8576: /*
8577: this hides the left border behind the border of the
8578: outer box if element is wrapped to the next 'line'
8579: */
8580: margin-left: -1px;
8581: }
8582:
1.843 bisitz 8583: ul.LC_funclist li {
1.915 droeschl 8584: display: inline;
1.782 bisitz 8585: white-space: nowrap;
1.915 droeschl 8586: margin: 0 0 0 25px;
8587: line-height: 150%;
1.782 bisitz 8588: }
8589:
1.974 wenzelju 8590: .LC_hidden {
8591: display: none;
8592: }
8593:
1.1030 www 8594: .LCmodal-overlay {
8595: position:fixed;
8596: top:0;
8597: right:0;
8598: bottom:0;
8599: left:0;
8600: height:100%;
8601: width:100%;
8602: margin:0;
8603: padding:0;
8604: background:#999;
8605: opacity:.75;
8606: filter: alpha(opacity=75);
8607: -moz-opacity: 0.75;
8608: z-index:101;
8609: }
8610:
8611: * html .LCmodal-overlay {
8612: position: absolute;
8613: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8614: }
8615:
8616: .LCmodal-window {
8617: position:fixed;
8618: top:50%;
8619: left:50%;
8620: margin:0;
8621: padding:0;
8622: z-index:102;
8623: }
8624:
8625: * html .LCmodal-window {
8626: position:absolute;
8627: }
8628:
8629: .LCclose-window {
8630: position:absolute;
8631: width:32px;
8632: height:32px;
8633: right:8px;
8634: top:8px;
8635: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8636: text-indent:-99999px;
8637: overflow:hidden;
8638: cursor:pointer;
8639: }
8640:
1.1369 raeburn 8641: .LCisDisabled {
8642: cursor: not-allowed;
8643: opacity: 0.5;
8644: }
8645:
8646: a[aria-disabled="true"] {
8647: color: currentColor;
8648: display: inline-block; /* For IE11/ MS Edge bug */
8649: pointer-events: none;
8650: text-decoration: none;
8651: }
8652:
1.1335 raeburn 8653: pre.LC_wordwrap {
8654: white-space: pre-wrap;
8655: white-space: -moz-pre-wrap;
8656: white-space: -pre-wrap;
8657: white-space: -o-pre-wrap;
8658: word-wrap: break-word;
8659: }
8660:
1.1100 raeburn 8661: /*
1.1231 damieng 8662: styles used for response display
8663: */
8664: div.LC_radiofoil, div.LC_rankfoil {
8665: margin: .5em 0em .5em 0em;
8666: }
8667: table.LC_itemgroup {
8668: margin-top: 1em;
8669: }
8670:
8671: /*
1.1100 raeburn 8672: styles used by TTH when "Default set of options to pass to tth/m
8673: when converting TeX" in course settings has been set
8674:
8675: option passed: -t
8676:
8677: */
8678:
8679: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8680: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8681: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8682: td div.norm {line-height:normal;}
8683:
8684: /*
8685: option passed -y3
8686: */
8687:
8688: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8689: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8690: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8691:
1.1230 damieng 8692: /*
8693: sections with roles, for content only
8694: */
8695: section[class^="role-"] {
8696: padding-left: 10px;
8697: padding-right: 5px;
8698: margin-top: 8px;
8699: margin-bottom: 8px;
8700: border: 1px solid #2A4;
8701: border-radius: 5px;
8702: box-shadow: 0px 1px 1px #BBB;
8703: }
8704: section[class^="role-"]>h1 {
8705: position: relative;
8706: margin: 0px;
8707: padding-top: 10px;
8708: padding-left: 40px;
8709: }
8710: section[class^="role-"]>h1:before {
8711: position: absolute;
8712: left: -5px;
8713: top: 5px;
8714: }
8715: section.role-activity>h1:before {
8716: content:url('/adm/daxe/images/section_icons/activity.png');
8717: }
8718: section.role-advice>h1:before {
8719: content:url('/adm/daxe/images/section_icons/advice.png');
8720: }
8721: section.role-bibliography>h1:before {
8722: content:url('/adm/daxe/images/section_icons/bibliography.png');
8723: }
8724: section.role-citation>h1:before {
8725: content:url('/adm/daxe/images/section_icons/citation.png');
8726: }
8727: section.role-conclusion>h1:before {
8728: content:url('/adm/daxe/images/section_icons/conclusion.png');
8729: }
8730: section.role-definition>h1:before {
8731: content:url('/adm/daxe/images/section_icons/definition.png');
8732: }
8733: section.role-demonstration>h1:before {
8734: content:url('/adm/daxe/images/section_icons/demonstration.png');
8735: }
8736: section.role-example>h1:before {
8737: content:url('/adm/daxe/images/section_icons/example.png');
8738: }
8739: section.role-explanation>h1:before {
8740: content:url('/adm/daxe/images/section_icons/explanation.png');
8741: }
8742: section.role-introduction>h1:before {
8743: content:url('/adm/daxe/images/section_icons/introduction.png');
8744: }
8745: section.role-method>h1:before {
8746: content:url('/adm/daxe/images/section_icons/method.png');
8747: }
8748: section.role-more_information>h1:before {
8749: content:url('/adm/daxe/images/section_icons/more_information.png');
8750: }
8751: section.role-objectives>h1:before {
8752: content:url('/adm/daxe/images/section_icons/objectives.png');
8753: }
8754: section.role-prerequisites>h1:before {
8755: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8756: }
8757: section.role-remark>h1:before {
8758: content:url('/adm/daxe/images/section_icons/remark.png');
8759: }
8760: section.role-reminder>h1:before {
8761: content:url('/adm/daxe/images/section_icons/reminder.png');
8762: }
8763: section.role-summary>h1:before {
8764: content:url('/adm/daxe/images/section_icons/summary.png');
8765: }
8766: section.role-syntax>h1:before {
8767: content:url('/adm/daxe/images/section_icons/syntax.png');
8768: }
8769: section.role-warning>h1:before {
8770: content:url('/adm/daxe/images/section_icons/warning.png');
8771: }
8772:
1.1269 raeburn 8773: #LC_minitab_header {
8774: float:left;
8775: width:100%;
8776: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8777: font-size:93%;
8778: line-height:normal;
8779: margin: 0.5em 0 0.5em 0;
8780: }
8781: #LC_minitab_header ul {
8782: margin:0;
8783: padding:10px 10px 0;
8784: list-style:none;
8785: }
8786: #LC_minitab_header li {
8787: float:left;
8788: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8789: margin:0;
8790: padding:0 0 0 9px;
8791: }
8792: #LC_minitab_header a {
8793: display:block;
8794: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8795: padding:5px 15px 4px 6px;
8796: }
8797: #LC_minitab_header #LC_current_minitab {
8798: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8799: }
8800: #LC_minitab_header #LC_current_minitab a {
8801: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8802: padding-bottom:5px;
8803: }
8804:
8805:
1.343 albertel 8806: END
8807: }
8808:
1.306 albertel 8809: =pod
8810:
8811: =item * &headtag()
8812:
8813: Returns a uniform footer for LON-CAPA web pages.
8814:
1.307 albertel 8815: Inputs: $title - optional title for the head
8816: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8817: $args - optional arguments
1.319 albertel 8818: force_register - if is true call registerurl so the remote is
8819: informed
1.415 albertel 8820: redirect -> array ref of
8821: 1- seconds before redirect occurs
8822: 2- url to redirect to
8823: 3- whether the side effect should occur
1.315 albertel 8824: (side effect of setting
8825: $env{'internal.head.redirect'} to the url
8826: redirected too)
1.352 albertel 8827: domain -> force to color decorate a page for a specific
8828: domain
8829: function -> force usage of a specific rolish color scheme
8830: bgcolor -> override the default page bgcolor
1.460 albertel 8831: no_auto_mt_title
8832: -> prevent &mt()ing the title arg
1.464 albertel 8833:
1.306 albertel 8834: =cut
8835:
8836: sub headtag {
1.313 albertel 8837: my ($title,$head_extra,$args) = @_;
1.306 albertel 8838:
1.363 albertel 8839: my $function = $args->{'function'} || &get_users_function();
8840: my $domain = $args->{'domain'} || &determinedomain();
8841: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8842: my $httphost = $args->{'use_absolute'};
1.418 albertel 8843: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8844: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8845: #time(),
1.418 albertel 8846: $env{'environment.color.timestamp'},
1.363 albertel 8847: $function,$domain,$bgcolor);
8848:
1.369 www 8849: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8850:
1.308 albertel 8851: my $result =
8852: '<head>'.
1.1160 raeburn 8853: &font_settings($args);
1.319 albertel 8854:
1.1188 raeburn 8855: my $inhibitprint;
8856: if ($args->{'print_suppress'}) {
8857: $inhibitprint = &print_suppression();
8858: }
1.1064 raeburn 8859:
1.461 albertel 8860: if (!$args->{'frameset'}) {
8861: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8862: }
1.962 droeschl 8863: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8864: $result .= Apache::lonxml::display_title();
1.319 albertel 8865: }
1.436 albertel 8866: if (!$args->{'no_nav_bar'}
8867: && !$args->{'only_body'}
8868: && !$args->{'frameset'}) {
1.1154 raeburn 8869: $result .= &help_menu_js($httphost);
1.1032 www 8870: $result.=&modal_window();
1.1038 www 8871: $result.=&togglebox_script();
1.1034 www 8872: $result.=&wishlist_window();
1.1041 www 8873: $result.=&LCprogressbarUpdate_script();
1.1034 www 8874: } else {
8875: if ($args->{'add_modal'}) {
8876: $result.=&modal_window();
8877: }
8878: if ($args->{'add_wishlist'}) {
8879: $result.=&wishlist_window();
8880: }
1.1038 www 8881: if ($args->{'add_togglebox'}) {
8882: $result.=&togglebox_script();
8883: }
1.1041 www 8884: if ($args->{'add_progressbar'}) {
8885: $result.=&LCprogressbarUpdate_script();
8886: }
1.436 albertel 8887: }
1.314 albertel 8888: if (ref($args->{'redirect'})) {
1.414 albertel 8889: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 8890: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 8891: if (!$inhibit_continue) {
8892: $env{'internal.head.redirect'} = $url;
8893: }
1.313 albertel 8894: $result.=<<ADDMETA
8895: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8896: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8897: ADDMETA
1.1210 raeburn 8898: } else {
8899: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8900: my $requrl = $env{'request.uri'};
8901: if ($requrl eq '') {
8902: $requrl = $ENV{'REQUEST_URI'};
8903: $requrl =~ s/\?.+$//;
8904: }
8905: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8906: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8907: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8908: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8909: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8910: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340 raeburn 8911: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1352 raeburn 8912: my ($offload,$offloadoth);
1.1210 raeburn 8913: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8914: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340 raeburn 8915: $offload = 1;
1.1353 raeburn 8916: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8917: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8918: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8919: $offloadoth = 1;
8920: $dom_in_use = $env{'user.domain'};
8921: }
8922: }
1.1340 raeburn 8923: }
8924: }
8925: unless ($offload) {
8926: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
8927: if ($domdefs{'offloadoth'}{$lonhost}) {
8928: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8929: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8930: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8931: $offload = 1;
1.1352 raeburn 8932: $offloadoth = 1;
1.1340 raeburn 8933: $dom_in_use = $env{'user.domain'};
8934: }
1.1210 raeburn 8935: }
1.1340 raeburn 8936: }
8937: }
8938: }
8939: if ($offload) {
1.1358 raeburn 8940: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1352 raeburn 8941: if (($newserver eq '') && ($offloadoth)) {
8942: my @domains = &Apache::lonnet::current_machine_domains();
8943: if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
8944: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
8945: }
8946: }
1.1340 raeburn 8947: if (($newserver) && ($newserver ne $lonhost)) {
8948: my $numsec = 5;
8949: my $timeout = $numsec * 1000;
8950: my ($newurl,$locknum,%locks,$msg);
8951: if ($env{'request.role.adv'}) {
8952: ($locknum,%locks) = &Apache::lonnet::get_locks();
8953: }
8954: my $disable_submit = 0;
8955: if ($requrl =~ /$LONCAPA::assess_re/) {
8956: $disable_submit = 1;
8957: }
8958: if ($locknum) {
8959: my @lockinfo = sort(values(%locks));
1.1354 raeburn 8960: $msg = &mt('Once the following tasks are complete:')." \n".
1.1340 raeburn 8961: join(", ",sort(values(%locks)))."\n";
8962: if (&show_course()) {
8963: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
8964: } else {
8965: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210 raeburn 8966: }
1.1340 raeburn 8967: } else {
8968: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8969: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
8970: }
8971: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8972: $newurl = '/adm/switchserver?otherserver='.$newserver;
8973: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8974: $newurl .= '&role='.$env{'request.role'};
8975: }
8976: if ($env{'request.symb'}) {
8977: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
8978: if ($shownsymb =~ m{^/enc/}) {
8979: my $reqdmajor = 2;
8980: my $reqdminor = 11;
8981: my $reqdsubminor = 3;
8982: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
8983: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
8984: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
8985: if (($major eq '' && $minor eq '') ||
8986: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
8987: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
8988: ($reqdsubminor > $subminor))))) {
8989: undef($shownsymb);
8990: }
1.1210 raeburn 8991: }
1.1340 raeburn 8992: if ($shownsymb) {
8993: &js_escape(\$shownsymb);
8994: $newurl .= '&symb='.$shownsymb;
1.1210 raeburn 8995: }
1.1340 raeburn 8996: } else {
8997: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
8998: &js_escape(\$shownurl);
8999: $newurl .= '&origurl='.$shownurl;
1.1210 raeburn 9000: }
1.1340 raeburn 9001: }
9002: &js_escape(\$msg);
9003: $result.=<<OFFLOAD
1.1210 raeburn 9004: <meta http-equiv="pragma" content="no-cache" />
9005: <script type="text/javascript">
1.1215 raeburn 9006: // <![CDATA[
1.1210 raeburn 9007: function LC_Offload_Now() {
9008: var dest = "$newurl";
9009: if (dest != '') {
9010: window.location.href="$newurl";
9011: }
9012: }
1.1214 raeburn 9013: \$(document).ready(function () {
9014: window.alert('$msg');
9015: if ($disable_submit) {
1.1210 raeburn 9016: \$(".LC_hwk_submit").prop("disabled", true);
9017: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 9018: }
9019: setTimeout('LC_Offload_Now()', $timeout);
9020: });
1.1215 raeburn 9021: // ]]>
1.1210 raeburn 9022: </script>
9023: OFFLOAD
9024: }
9025: }
9026: }
9027: }
9028: }
1.313 albertel 9029: }
1.306 albertel 9030: if (!defined($title)) {
9031: $title = 'The LearningOnline Network with CAPA';
9032: }
1.460 albertel 9033: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
9034: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 9035: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
9036: if (!$args->{'frameset'}) {
9037: $result .= ' /';
9038: }
9039: $result .= '>'
1.1064 raeburn 9040: .$inhibitprint
1.414 albertel 9041: .$head_extra;
1.1242 raeburn 9042: my $clientmobile;
9043: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
9044: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
9045: } else {
9046: $clientmobile = $env{'browser.mobile'};
9047: }
9048: if ($clientmobile) {
1.1137 raeburn 9049: $result .= '
9050: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
9051: <meta name="apple-mobile-web-app-capable" content="yes" />';
9052: }
1.1278 raeburn 9053: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 9054: return $result.'</head>';
1.306 albertel 9055: }
9056:
9057: =pod
9058:
1.340 albertel 9059: =item * &font_settings()
9060:
9061: Returns neccessary <meta> to set the proper encoding
9062:
1.1160 raeburn 9063: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 9064:
9065: =cut
9066:
9067: sub font_settings {
1.1160 raeburn 9068: my ($args) = @_;
1.340 albertel 9069: my $headerstring='';
1.1160 raeburn 9070: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
9071: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 9072: $headerstring.=
9073: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
9074: if (!$args->{'frameset'}) {
9075: $headerstring.= ' /';
9076: }
9077: $headerstring .= '>'."\n";
1.340 albertel 9078: }
9079: return $headerstring;
9080: }
9081:
1.341 albertel 9082: =pod
9083:
1.1064 raeburn 9084: =item * &print_suppression()
9085:
9086: In course context returns css which causes the body to be blank when media="print",
9087: if printout generation is unavailable for the current resource.
9088:
9089: This could be because:
9090:
9091: (a) printstartdate is in the future
9092:
9093: (b) printenddate is in the past
9094:
9095: (c) there is an active exam block with "printout"
9096: functionality blocked
9097:
9098: Users with pav, pfo or evb privileges are exempt.
9099:
9100: Inputs: none
9101:
9102: =cut
9103:
9104:
9105: sub print_suppression {
9106: my $noprint;
9107: if ($env{'request.course.id'}) {
9108: my $scope = $env{'request.course.id'};
9109: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9110: (&Apache::lonnet::allowed('pfo',$scope))) {
9111: return;
9112: }
9113: if ($env{'request.course.sec'} ne '') {
9114: $scope .= "/$env{'request.course.sec'}";
9115: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9116: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 9117: return;
1.1064 raeburn 9118: }
9119: }
9120: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9121: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 9122: my $clientip = &Apache::lonnet::get_requestor_ip();
9123: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 9124: if ($blocked) {
9125: my $checkrole = "cm./$cdom/$cnum";
9126: if ($env{'request.course.sec'} ne '') {
9127: $checkrole .= "/$env{'request.course.sec'}";
9128: }
9129: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
9130: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
9131: $noprint = 1;
9132: }
9133: }
9134: unless ($noprint) {
9135: my $symb = &Apache::lonnet::symbread();
9136: if ($symb ne '') {
9137: my $navmap = Apache::lonnavmaps::navmap->new();
9138: if (ref($navmap)) {
9139: my $res = $navmap->getBySymb($symb);
9140: if (ref($res)) {
9141: if (!$res->resprintable()) {
9142: $noprint = 1;
9143: }
9144: }
9145: }
9146: }
9147: }
9148: if ($noprint) {
9149: return <<"ENDSTYLE";
9150: <style type="text/css" media="print">
9151: body { display:none }
9152: </style>
9153: ENDSTYLE
9154: }
9155: }
9156: return;
9157: }
9158:
9159: =pod
9160:
1.341 albertel 9161: =item * &xml_begin()
9162:
9163: Returns the needed doctype and <html>
9164:
9165: Inputs: none
9166:
9167: =cut
9168:
9169: sub xml_begin {
1.1168 raeburn 9170: my ($is_frameset) = @_;
1.341 albertel 9171: my $output='';
9172:
9173: if ($env{'browser.mathml'}) {
9174: $output='<?xml version="1.0"?>'
9175: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
9176: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
9177:
9178: # .'<!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">] >'
9179: .'<!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">'
9180: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
9181: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 9182: } elsif ($is_frameset) {
9183: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
9184: '<html>'."\n";
1.341 albertel 9185: } else {
1.1168 raeburn 9186: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
9187: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 9188: }
9189: return $output;
9190: }
1.340 albertel 9191:
9192: =pod
9193:
1.306 albertel 9194: =item * &start_page()
9195:
9196: Returns a complete <html> .. <body> section for LON-CAPA web pages.
9197:
1.648 raeburn 9198: Inputs:
9199:
9200: =over 4
9201:
9202: $title - optional title for the page
9203:
9204: $head_extra - optional extra HTML to incude inside the <head>
9205:
9206: $args - additional optional args supported are:
9207:
9208: =over 8
9209:
9210: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 9211: arg on
1.814 bisitz 9212: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 9213: add_entries -> additional attributes to add to the <body>
9214: domain -> force to color decorate a page for a
1.317 albertel 9215: specific domain
1.648 raeburn 9216: function -> force usage of a specific rolish color
1.317 albertel 9217: scheme
1.648 raeburn 9218: redirect -> see &headtag()
9219: bgcolor -> override the default page bg color
9220: js_ready -> return a string ready for being used in
1.317 albertel 9221: a javascript writeln
1.648 raeburn 9222: html_encode -> return a string ready for being used in
1.320 albertel 9223: a html attribute
1.648 raeburn 9224: force_register -> if is true will turn on the &bodytag()
1.317 albertel 9225: $forcereg arg
1.648 raeburn 9226: frameset -> if true will start with a <frameset>
1.330 albertel 9227: rather than <body>
1.648 raeburn 9228: skip_phases -> hash ref of
1.338 albertel 9229: head -> skip the <html><head> generation
9230: body -> skip all <body> generation
1.648 raeburn 9231: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 9232: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 9233: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 9234: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
9235: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 9236: group -> includes the current group, if page is for a
1.1274 raeburn 9237: specific group
9238: use_absolute -> for request for external resource or syllabus, this
9239: will contain https://<hostname> if server uses
9240: https (as per hosts.tab), but request is for http
9241: hostname -> hostname, originally from $r->hostname(), (optional).
1.1369 raeburn 9242: links_disabled -> Links in primary and secondary menus are disabled
9243: (Can enable them once page has loaded - see lonroles.pm
9244: for an example).
1.361 albertel 9245:
1.648 raeburn 9246: =back
1.460 albertel 9247:
1.648 raeburn 9248: =back
1.562 albertel 9249:
1.306 albertel 9250: =cut
9251:
9252: sub start_page {
1.309 albertel 9253: my ($title,$head_extra,$args) = @_;
1.318 albertel 9254: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 9255:
1.315 albertel 9256: $env{'internal.start_page'}++;
1.1359 raeburn 9257: my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964 droeschl 9258:
1.338 albertel 9259: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 9260: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 9261: }
1.1316 raeburn 9262:
9263: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318 raeburn 9264: if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
9265: unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
9266: $args->{'no_primary_menu'} = 1;
9267: }
9268: unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
9269: $args->{'no_inline_menu'} = 1;
9270: }
9271: if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
9272: map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
9273: }
9274: } else {
9275: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9276: my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
9277: if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
9278: unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
9279: $args->{'no_primary_menu'} = 1;
9280: }
9281: unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
9282: $args->{'no_inline_menu'} = 1;
9283: }
9284: if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
9285: map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
9286: }
9287: }
9288: }
1.1316 raeburn 9289: ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
9290: $env{'course.'.$env{'request.course.id'}.'.domain'},
9291: $env{'course.'.$env{'request.course.id'}.'.num'});
1.1359 raeburn 9292: } elsif ($env{'request.course.id'}) {
9293: my $expiretime=600;
9294: if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
9295: &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
9296: }
9297: my ($deeplinkmenu,$menuref);
9298: ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
9299: if ($menucoll) {
9300: if (ref($menuref) eq 'HASH') {
9301: %menu = %{$menuref};
9302: }
9303: if ($menu{'top'} eq 'n') {
9304: $args->{'no_primary_menu'} = 1;
9305: }
9306: if ($menu{'inline'} eq 'n') {
9307: unless (&Apache::lonnet::allowed('opa')) {
9308: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9309: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9310: my $crstype = &course_type();
9311: my $now = time;
9312: my $ccrole;
9313: if ($crstype eq 'Community') {
9314: $ccrole = 'co';
9315: } else {
9316: $ccrole = 'cc';
9317: }
9318: if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
9319: my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
9320: if ((($start) && ($start<0)) ||
9321: (($end) && ($end<$now)) ||
9322: (($start) && ($now<$start))) {
9323: $args->{'no_inline_menu'} = 1;
9324: }
9325: } else {
9326: $args->{'no_inline_menu'} = 1;
9327: }
9328: }
9329: }
9330: }
1.1316 raeburn 9331: }
1.1359 raeburn 9332:
1.338 albertel 9333: if (! exists($args->{'skip_phases'}{'body'}) ) {
9334: if ($args->{'frameset'}) {
9335: my $attr_string = &make_attr_string($args->{'force_register'},
9336: $args->{'add_entries'});
9337: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 9338: } else {
9339: $result .=
9340: &bodytag($title,
9341: $args->{'function'}, $args->{'add_entries'},
9342: $args->{'only_body'}, $args->{'domain'},
9343: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 9344: $args->{'bgcolor'}, $args,
1.1359 raeburn 9345: \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu);
1.831 bisitz 9346: }
1.330 albertel 9347: }
1.338 albertel 9348:
1.315 albertel 9349: if ($args->{'js_ready'}) {
1.713 kaisler 9350: $result = &js_ready($result);
1.315 albertel 9351: }
1.320 albertel 9352: if ($args->{'html_encode'}) {
1.713 kaisler 9353: $result = &html_encode($result);
9354: }
9355:
1.813 bisitz 9356: # Preparation for new and consistent functionlist at top of screen
9357: # if ($args->{'functionlist'}) {
9358: # $result .= &build_functionlist();
9359: #}
9360:
1.964 droeschl 9361: # Don't add anything more if only_body wanted or in const space
9362: return $result if $args->{'only_body'}
9363: || $env{'request.state'} eq 'construct';
1.813 bisitz 9364:
9365: #Breadcrumbs
1.758 kaisler 9366: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
9367: &Apache::lonhtmlcommon::clear_breadcrumbs();
9368: #if any br links exists, add them to the breadcrumbs
9369: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
9370: foreach my $crumb (@{$args->{'bread_crumbs'}}){
9371: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
9372: }
9373: }
1.1096 raeburn 9374: # if @advtools array contains items add then to the breadcrumbs
9375: if (@advtools > 0) {
9376: &Apache::lonmenu::advtools_crumbs(@advtools);
9377: }
1.1272 raeburn 9378: my $menulink;
9379: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
9380: if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312 raeburn 9381: ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272 raeburn 9382: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
9383: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
9384: (!$env{'request.role.adv'}))) {
9385: $menulink = 0;
9386: } else {
9387: undef($menulink);
9388: }
1.758 kaisler 9389: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
9390: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 9391: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 9392: } else {
1.1272 raeburn 9393: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 9394: }
1.320 albertel 9395: }
1.315 albertel 9396: return $result;
1.306 albertel 9397: }
9398:
9399: sub end_page {
1.315 albertel 9400: my ($args) = @_;
9401: $env{'internal.end_page'}++;
1.330 albertel 9402: my $result;
1.335 albertel 9403: if ($args->{'discussion'}) {
9404: my ($target,$parser);
9405: if (ref($args->{'discussion'})) {
9406: ($target,$parser) =($args->{'discussion'}{'target'},
9407: $args->{'discussion'}{'parser'});
9408: }
9409: $result .= &Apache::lonxml::xmlend($target,$parser);
9410: }
1.330 albertel 9411: if ($args->{'frameset'}) {
9412: $result .= '</frameset>';
9413: } else {
1.635 raeburn 9414: $result .= &endbodytag($args);
1.330 albertel 9415: }
1.1080 raeburn 9416: unless ($args->{'notbody'}) {
9417: $result .= "\n</html>";
9418: }
1.330 albertel 9419:
1.315 albertel 9420: if ($args->{'js_ready'}) {
1.317 albertel 9421: $result = &js_ready($result);
1.315 albertel 9422: }
1.335 albertel 9423:
1.320 albertel 9424: if ($args->{'html_encode'}) {
9425: $result = &html_encode($result);
9426: }
1.335 albertel 9427:
1.315 albertel 9428: return $result;
9429: }
9430:
1.1359 raeburn 9431: sub menucoll_in_effect {
9432: my ($menucoll,$deeplinkmenu,%menu);
9433: if ($env{'request.course.id'}) {
9434: $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
1.1362 raeburn 9435: if ($env{'request.deeplink.login'}) {
1.1370 raeburn 9436: my ($deeplink_symb,$deeplink,$check_login_symb);
1.1362 raeburn 9437: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9438: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9439: if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
9440: if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
9441: my $navmap = Apache::lonnavmaps::navmap->new();
9442: if (ref($navmap)) {
9443: $deeplink = $navmap->get_mapparam(undef,
9444: &Apache::lonnet::declutter($env{'request.noversionuri'}),
9445: '0.deeplink');
1.1370 raeburn 9446: } else {
9447: $check_login_symb = 1;
1.1362 raeburn 9448: }
9449: } else {
1.1370 raeburn 9450: my $symb = &Apache::lonnet::symbread();
9451: if ($symb) {
9452: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
9453: } else {
9454: $check_login_symb = 1;
9455: }
1.1362 raeburn 9456: }
9457: } else {
1.1370 raeburn 9458: $check_login_symb = 1;
9459: }
9460: if ($check_login_symb) {
1.1362 raeburn 9461: $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
9462: if ($deeplink_symb =~ /\.(page|sequence)$/) {
9463: my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
9464: my $navmap = Apache::lonnavmaps::navmap->new();
9465: if (ref($navmap)) {
9466: $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
9467: }
9468: } else {
9469: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
9470: }
9471: }
1.1359 raeburn 9472: if ($deeplink ne '') {
1.1378 raeburn 9473: my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
1.1359 raeburn 9474: if ($display =~ /^\d+$/) {
9475: $deeplinkmenu = 1;
9476: $menucoll = $display;
9477: }
9478: }
9479: }
9480: if ($menucoll) {
9481: %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
9482: }
9483: }
9484: return ($menucoll,$deeplinkmenu,\%menu);
9485: }
9486:
1.1362 raeburn 9487: sub deeplink_login_symb {
9488: my ($cnum,$cdom) = @_;
9489: my $login_symb;
9490: if ($env{'request.deeplink.login'}) {
1.1364 raeburn 9491: $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
9492: }
9493: return $login_symb;
9494: }
9495:
9496: sub symb_from_tinyurl {
9497: my ($url,$cnum,$cdom) = @_;
9498: if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
9499: my $key = $1;
9500: my ($tinyurl,$login);
9501: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
9502: if (defined($cached)) {
9503: $tinyurl = $result;
9504: } else {
9505: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
9506: my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
9507: if ($currtiny{$key} ne '') {
9508: $tinyurl = $currtiny{$key};
9509: &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
1.1362 raeburn 9510: }
1.1364 raeburn 9511: }
9512: if ($tinyurl ne '') {
9513: my ($cnumreq,$symb) = split(/\&/,$tinyurl);
9514: if (wantarray) {
9515: return ($cnumreq,$symb);
9516: } elsif ($cnumreq eq $cnum) {
9517: return $symb;
1.1362 raeburn 9518: }
9519: }
9520: }
1.1364 raeburn 9521: if (wantarray) {
9522: return ();
9523: } else {
9524: return;
9525: }
1.1362 raeburn 9526: }
9527:
1.1034 www 9528: sub wishlist_window {
9529: return(<<'ENDWISHLIST');
1.1046 raeburn 9530: <script type="text/javascript">
1.1034 www 9531: // <![CDATA[
9532: // <!-- BEGIN LON-CAPA Internal
9533: function set_wishlistlink(title, path) {
9534: if (!title) {
9535: title = document.title;
9536: title = title.replace(/^LON-CAPA /,'');
9537: }
1.1175 raeburn 9538: title = encodeURIComponent(title);
1.1203 raeburn 9539: title = title.replace("'","\\\'");
1.1034 www 9540: if (!path) {
9541: path = location.pathname;
9542: }
1.1175 raeburn 9543: path = encodeURIComponent(path);
1.1203 raeburn 9544: path = path.replace("'","\\\'");
1.1034 www 9545: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
9546: 'wishlistNewLink','width=560,height=350,scrollbars=0');
9547: }
9548: // END LON-CAPA Internal -->
9549: // ]]>
9550: </script>
9551: ENDWISHLIST
9552: }
9553:
1.1030 www 9554: sub modal_window {
9555: return(<<'ENDMODAL');
1.1046 raeburn 9556: <script type="text/javascript">
1.1030 www 9557: // <![CDATA[
9558: // <!-- BEGIN LON-CAPA Internal
9559: var modalWindow = {
9560: parent:"body",
9561: windowId:null,
9562: content:null,
9563: width:null,
9564: height:null,
9565: close:function()
9566: {
9567: $(".LCmodal-window").remove();
9568: $(".LCmodal-overlay").remove();
9569: },
9570: open:function()
9571: {
9572: var modal = "";
9573: modal += "<div class=\"LCmodal-overlay\"></div>";
9574: 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;\">";
9575: modal += this.content;
9576: modal += "</div>";
9577:
9578: $(this.parent).append(modal);
9579:
9580: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
9581: $(".LCclose-window").click(function(){modalWindow.close();});
9582: $(".LCmodal-overlay").click(function(){modalWindow.close();});
9583: }
9584: };
1.1140 raeburn 9585: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 9586: {
1.1266 raeburn 9587: source = source.replace(/'/g,"'");
1.1030 www 9588: modalWindow.windowId = "myModal";
9589: modalWindow.width = width;
9590: modalWindow.height = height;
1.1196 raeburn 9591: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 9592: modalWindow.open();
1.1208 raeburn 9593: };
1.1030 www 9594: // END LON-CAPA Internal -->
9595: // ]]>
9596: </script>
9597: ENDMODAL
9598: }
9599:
9600: sub modal_link {
1.1140 raeburn 9601: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 9602: unless ($width) { $width=480; }
9603: unless ($height) { $height=400; }
1.1031 www 9604: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 9605: unless ($transparency) { $transparency='true'; }
9606:
1.1074 raeburn 9607: my $target_attr;
9608: if (defined($target)) {
9609: $target_attr = 'target="'.$target.'"';
9610: }
9611: return <<"ENDLINK";
1.1336 raeburn 9612: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 9613: ENDLINK
1.1030 www 9614: }
9615:
1.1032 www 9616: sub modal_adhoc_script {
1.1365 raeburn 9617: my ($funcname,$width,$height,$content,$possmathjax)=@_;
9618: my $mathjax;
9619: if ($possmathjax) {
9620: $mathjax = <<'ENDJAX';
9621: if (typeof MathJax == 'object') {
9622: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
9623: }
9624: ENDJAX
9625: }
1.1032 www 9626: return (<<ENDADHOC);
1.1046 raeburn 9627: <script type="text/javascript">
1.1032 www 9628: // <![CDATA[
9629: var $funcname = function()
9630: {
9631: modalWindow.windowId = "myModal";
9632: modalWindow.width = $width;
9633: modalWindow.height = $height;
9634: modalWindow.content = '$content';
9635: modalWindow.open();
1.1365 raeburn 9636: $mathjax
1.1032 www 9637: };
9638: // ]]>
9639: </script>
9640: ENDADHOC
9641: }
9642:
1.1041 www 9643: sub modal_adhoc_inner {
1.1365 raeburn 9644: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 9645: my $innerwidth=$width-20;
9646: $content=&js_ready(
1.1140 raeburn 9647: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
9648: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
9649: $content.
1.1041 www 9650: &end_scrollbox().
1.1140 raeburn 9651: &end_page()
1.1041 www 9652: );
1.1365 raeburn 9653: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 9654: }
9655:
9656: sub modal_adhoc_window {
1.1365 raeburn 9657: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
9658: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 9659: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
9660: }
9661:
9662: sub modal_adhoc_launch {
9663: my ($funcname,$width,$height,$content)=@_;
9664: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
9665: <script type="text/javascript">
9666: // <![CDATA[
9667: $funcname();
9668: // ]]>
9669: </script>
9670: ENDLAUNCH
9671: }
9672:
9673: sub modal_adhoc_close {
9674: return (<<ENDCLOSE);
9675: <script type="text/javascript">
9676: // <![CDATA[
9677: modalWindow.close();
9678: // ]]>
9679: </script>
9680: ENDCLOSE
9681: }
9682:
1.1038 www 9683: sub togglebox_script {
9684: return(<<ENDTOGGLE);
9685: <script type="text/javascript">
9686: // <![CDATA[
9687: function LCtoggleDisplay(id,hidetext,showtext) {
9688: link = document.getElementById(id + "link").childNodes[0];
9689: with (document.getElementById(id).style) {
9690: if (display == "none" ) {
9691: display = "inline";
9692: link.nodeValue = hidetext;
9693: } else {
9694: display = "none";
9695: link.nodeValue = showtext;
9696: }
9697: }
9698: }
9699: // ]]>
9700: </script>
9701: ENDTOGGLE
9702: }
9703:
1.1039 www 9704: sub start_togglebox {
9705: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
9706: unless ($heading) { $heading=''; } else { $heading.=' '; }
9707: unless ($showtext) { $showtext=&mt('show'); }
9708: unless ($hidetext) { $hidetext=&mt('hide'); }
9709: unless ($headerbg) { $headerbg='#FFFFFF'; }
9710: return &start_data_table().
9711: &start_data_table_header_row().
9712: '<td bgcolor="'.$headerbg.'">'.$heading.
9713: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
9714: $showtext.'\')">'.$showtext.'</a>]</td>'.
9715: &end_data_table_header_row().
9716: '<tr id="'.$id.'" style="display:none""><td>';
9717: }
9718:
9719: sub end_togglebox {
9720: return '</td></tr>'.&end_data_table();
9721: }
9722:
1.1041 www 9723: sub LCprogressbar_script {
1.1302 raeburn 9724: my ($id,$number_to_do)=@_;
9725: if ($number_to_do) {
9726: return(<<ENDPROGRESS);
1.1041 www 9727: <script type="text/javascript">
9728: // <![CDATA[
1.1045 www 9729: \$('#progressbar$id').progressbar({
1.1041 www 9730: value: 0,
9731: change: function(event, ui) {
9732: var newVal = \$(this).progressbar('option', 'value');
9733: \$('.pblabel', this).text(LCprogressTxt);
9734: }
9735: });
9736: // ]]>
9737: </script>
9738: ENDPROGRESS
1.1302 raeburn 9739: } else {
9740: return(<<ENDPROGRESS);
9741: <script type="text/javascript">
9742: // <![CDATA[
9743: \$('#progressbar$id').progressbar({
9744: value: false,
9745: create: function(event, ui) {
9746: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
9747: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
9748: }
9749: });
9750: // ]]>
9751: </script>
9752: ENDPROGRESS
9753: }
1.1041 www 9754: }
9755:
9756: sub LCprogressbarUpdate_script {
9757: return(<<ENDPROGRESSUPDATE);
9758: <style type="text/css">
9759: .ui-progressbar { position:relative; }
1.1302 raeburn 9760: .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 9761: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
9762: </style>
9763: <script type="text/javascript">
9764: // <![CDATA[
1.1045 www 9765: var LCprogressTxt='---';
9766:
1.1302 raeburn 9767: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 9768: LCprogressTxt=progresstext;
1.1302 raeburn 9769: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
9770: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
9771: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 9772: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
9773: } else {
9774: \$('#progressbar'+id).progressbar('value',percent);
9775: }
1.1041 www 9776: }
9777: // ]]>
9778: </script>
9779: ENDPROGRESSUPDATE
9780: }
9781:
1.1042 www 9782: my $LClastpercent;
1.1045 www 9783: my $LCidcnt;
9784: my $LCcurrentid;
1.1042 www 9785:
1.1041 www 9786: sub LCprogressbar {
1.1302 raeburn 9787: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 9788: $LClastpercent=0;
1.1045 www 9789: $LCidcnt++;
9790: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 9791: my ($starting,$content);
9792: if ($number_to_do) {
9793: $starting=&mt('Starting');
9794: $content=(<<ENDPROGBAR);
9795: $preamble
1.1045 www 9796: <div id="progressbar$LCcurrentid">
1.1041 www 9797: <span class="pblabel">$starting</span>
9798: </div>
9799: ENDPROGBAR
1.1302 raeburn 9800: } else {
9801: $starting=&mt('Loading...');
9802: $LClastpercent='false';
9803: $content=(<<ENDPROGBAR);
9804: $preamble
9805: <div id="progressbar$LCcurrentid">
9806: <div class="progress-label">$starting</div>
9807: </div>
9808: ENDPROGBAR
9809: }
9810: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 9811: }
9812:
9813: sub LCprogressbarUpdate {
1.1302 raeburn 9814: my ($r,$val,$text,$number_to_do)=@_;
9815: if ($number_to_do) {
9816: unless ($val) {
9817: if ($LClastpercent) {
9818: $val=$LClastpercent;
9819: } else {
9820: $val=0;
9821: }
9822: }
9823: if ($val<0) { $val=0; }
9824: if ($val>100) { $val=0; }
9825: $LClastpercent=$val;
9826: unless ($text) { $text=$val.'%'; }
9827: } else {
9828: $val = 'false';
1.1042 www 9829: }
1.1041 www 9830: $text=&js_ready($text);
1.1044 www 9831: &r_print($r,<<ENDUPDATE);
1.1041 www 9832: <script type="text/javascript">
9833: // <![CDATA[
1.1302 raeburn 9834: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 9835: // ]]>
9836: </script>
9837: ENDUPDATE
1.1035 www 9838: }
9839:
1.1042 www 9840: sub LCprogressbarClose {
9841: my ($r)=@_;
9842: $LClastpercent=0;
1.1044 www 9843: &r_print($r,<<ENDCLOSE);
1.1042 www 9844: <script type="text/javascript">
9845: // <![CDATA[
1.1045 www 9846: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 9847: // ]]>
9848: </script>
9849: ENDCLOSE
1.1044 www 9850: }
9851:
9852: sub r_print {
9853: my ($r,$to_print)=@_;
9854: if ($r) {
9855: $r->print($to_print);
9856: $r->rflush();
9857: } else {
9858: print($to_print);
9859: }
1.1042 www 9860: }
9861:
1.320 albertel 9862: sub html_encode {
9863: my ($result) = @_;
9864:
1.322 albertel 9865: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 9866:
9867: return $result;
9868: }
1.1044 www 9869:
1.317 albertel 9870: sub js_ready {
9871: my ($result) = @_;
9872:
1.323 albertel 9873: $result =~ s/[\n\r]/ /xmsg;
9874: $result =~ s/\\/\\\\/xmsg;
9875: $result =~ s/'/\\'/xmsg;
1.372 albertel 9876: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 9877:
9878: return $result;
9879: }
9880:
1.315 albertel 9881: sub validate_page {
9882: if ( exists($env{'internal.start_page'})
1.316 albertel 9883: && $env{'internal.start_page'} > 1) {
9884: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 9885: $env{'internal.start_page'}.' '.
1.316 albertel 9886: $ENV{'request.filename'});
1.315 albertel 9887: }
9888: if ( exists($env{'internal.end_page'})
1.316 albertel 9889: && $env{'internal.end_page'} > 1) {
9890: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 9891: $env{'internal.end_page'}.' '.
1.316 albertel 9892: $env{'request.filename'});
1.315 albertel 9893: }
9894: if ( exists($env{'internal.start_page'})
9895: && ! exists($env{'internal.end_page'})) {
1.316 albertel 9896: &Apache::lonnet::logthis('start_page called without end_page '.
9897: $env{'request.filename'});
1.315 albertel 9898: }
9899: if ( ! exists($env{'internal.start_page'})
9900: && exists($env{'internal.end_page'})) {
1.316 albertel 9901: &Apache::lonnet::logthis('end_page called without start_page'.
9902: $env{'request.filename'});
1.315 albertel 9903: }
1.306 albertel 9904: }
1.315 albertel 9905:
1.996 www 9906:
9907: sub start_scrollbox {
1.1140 raeburn 9908: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 9909: unless ($outerwidth) { $outerwidth='520px'; }
9910: unless ($width) { $width='500px'; }
9911: unless ($height) { $height='200px'; }
1.1075 raeburn 9912: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 9913: if ($id ne '') {
1.1140 raeburn 9914: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 9915: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 9916: }
1.1075 raeburn 9917: if ($bgcolor ne '') {
9918: $tdcol = "background-color: $bgcolor;";
9919: }
1.1137 raeburn 9920: my $nicescroll_js;
9921: if ($env{'browser.mobile'}) {
1.1140 raeburn 9922: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
9923: }
9924: return <<"END";
9925: $nicescroll_js
9926:
9927: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
9928: <div style="overflow:auto; width:$width; height:$height;"$div_id>
9929: END
9930: }
9931:
9932: sub end_scrollbox {
9933: return '</div></td></tr></table>';
9934: }
9935:
9936: sub nicescroll_javascript {
9937: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
9938: my %options;
9939: if (ref($cursor) eq 'HASH') {
9940: %options = %{$cursor};
9941: }
9942: unless ($options{'railalign'} =~ /^left|right$/) {
9943: $options{'railalign'} = 'left';
9944: }
9945: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9946: my $function = &get_users_function();
9947: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 9948: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 9949: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 9950: }
1.1140 raeburn 9951: }
9952: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
9953: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 9954: $options{'cursoropacity'}='1.0';
9955: }
1.1140 raeburn 9956: } else {
9957: $options{'cursoropacity'}='1.0';
9958: }
9959: if ($options{'cursorfixedheight'} eq 'none') {
9960: delete($options{'cursorfixedheight'});
9961: } else {
9962: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
9963: }
9964: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
9965: delete($options{'railoffset'});
9966: }
9967: my @niceoptions;
9968: while (my($key,$value) = each(%options)) {
9969: if ($value =~ /^\{.+\}$/) {
9970: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 9971: } else {
1.1140 raeburn 9972: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 9973: }
1.1140 raeburn 9974: }
9975: my $nicescroll_js = '
1.1137 raeburn 9976: $(document).ready(
1.1140 raeburn 9977: function() {
9978: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
9979: }
1.1137 raeburn 9980: );
9981: ';
1.1140 raeburn 9982: if ($framecheck) {
9983: $nicescroll_js .= '
9984: function expand_div(caller) {
9985: if (top === self) {
9986: document.getElementById("'.$id.'").style.width = "auto";
9987: document.getElementById("'.$id.'").style.height = "auto";
9988: } else {
9989: try {
9990: if (parent.frames) {
9991: if (parent.frames.length > 1) {
9992: var framesrc = parent.frames[1].location.href;
9993: var currsrc = framesrc.replace(/\#.*$/,"");
9994: if ((caller == "search") || (currsrc == "'.$location.'")) {
9995: document.getElementById("'.$id.'").style.width = "auto";
9996: document.getElementById("'.$id.'").style.height = "auto";
9997: }
9998: }
9999: }
10000: } catch (e) {
10001: return;
10002: }
1.1137 raeburn 10003: }
1.1140 raeburn 10004: return;
1.996 www 10005: }
1.1140 raeburn 10006: ';
10007: }
10008: if ($needjsready) {
10009: $nicescroll_js = '
10010: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
10011: } else {
10012: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
10013: }
10014: return $nicescroll_js;
1.996 www 10015: }
10016:
1.318 albertel 10017: sub simple_error_page {
1.1150 bisitz 10018: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 10019: my %displayargs;
1.1151 raeburn 10020: if (ref($args) eq 'HASH') {
10021: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 10022: if ($args->{'only_body'}) {
10023: $displayargs{'only_body'} = 1;
10024: }
10025: if ($args->{'no_nav_bar'}) {
10026: $displayargs{'no_nav_bar'} = 1;
10027: }
1.1151 raeburn 10028: } else {
10029: $msg = &mt($msg);
10030: }
1.1150 bisitz 10031:
1.318 albertel 10032: my $page =
1.1304 raeburn 10033: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 10034: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 10035: &Apache::loncommon::end_page();
10036: if (ref($r)) {
10037: $r->print($page);
1.327 albertel 10038: return;
1.318 albertel 10039: }
10040: return $page;
10041: }
1.347 albertel 10042:
10043: {
1.610 albertel 10044: my @row_count;
1.961 onken 10045:
10046: sub start_data_table_count {
10047: unshift(@row_count, 0);
10048: return;
10049: }
10050:
10051: sub end_data_table_count {
10052: shift(@row_count);
10053: return;
10054: }
10055:
1.347 albertel 10056: sub start_data_table {
1.1018 raeburn 10057: my ($add_class,$id) = @_;
1.422 albertel 10058: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 10059: my $table_id;
10060: if (defined($id)) {
10061: $table_id = ' id="'.$id.'"';
10062: }
1.961 onken 10063: &start_data_table_count();
1.1018 raeburn 10064: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 10065: }
10066:
10067: sub end_data_table {
1.961 onken 10068: &end_data_table_count();
1.389 albertel 10069: return '</table>'."\n";;
1.347 albertel 10070: }
10071:
10072: sub start_data_table_row {
1.974 wenzelju 10073: my ($add_class, $id) = @_;
1.610 albertel 10074: $row_count[0]++;
10075: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 10076: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 10077: $id = (' id="'.$id.'"') unless ($id eq '');
10078: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 10079: }
1.471 banghart 10080:
10081: sub continue_data_table_row {
1.974 wenzelju 10082: my ($add_class, $id) = @_;
1.610 albertel 10083: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 10084: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
10085: $id = (' id="'.$id.'"') unless ($id eq '');
10086: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 10087: }
1.347 albertel 10088:
10089: sub end_data_table_row {
1.389 albertel 10090: return '</tr>'."\n";;
1.347 albertel 10091: }
1.367 www 10092:
1.421 albertel 10093: sub start_data_table_empty_row {
1.707 bisitz 10094: # $row_count[0]++;
1.421 albertel 10095: return '<tr class="LC_empty_row" >'."\n";;
10096: }
10097:
10098: sub end_data_table_empty_row {
10099: return '</tr>'."\n";;
10100: }
10101:
1.367 www 10102: sub start_data_table_header_row {
1.389 albertel 10103: return '<tr class="LC_header_row">'."\n";;
1.367 www 10104: }
10105:
10106: sub end_data_table_header_row {
1.389 albertel 10107: return '</tr>'."\n";;
1.367 www 10108: }
1.890 droeschl 10109:
10110: sub data_table_caption {
10111: my $caption = shift;
10112: return "<caption class=\"LC_caption\">$caption</caption>";
10113: }
1.347 albertel 10114: }
10115:
1.548 albertel 10116: =pod
10117:
10118: =item * &inhibit_menu_check($arg)
10119:
10120: Checks for a inhibitmenu state and generates output to preserve it
10121:
10122: Inputs: $arg - can be any of
10123: - undef - in which case the return value is a string
10124: to add into arguments list of a uri
10125: - 'input' - in which case the return value is a HTML
10126: <form> <input> field of type hidden to
10127: preserve the value
10128: - a url - in which case the return value is the url with
10129: the neccesary cgi args added to preserve the
10130: inhibitmenu state
10131: - a ref to a url - no return value, but the string is
10132: updated to include the neccessary cgi
10133: args to preserve the inhibitmenu state
10134:
10135: =cut
10136:
10137: sub inhibit_menu_check {
10138: my ($arg) = @_;
10139: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
10140: if ($arg eq 'input') {
10141: if ($env{'form.inhibitmenu'}) {
10142: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
10143: } else {
10144: return
10145: }
10146: }
10147: if ($env{'form.inhibitmenu'}) {
10148: if (ref($arg)) {
10149: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10150: } elsif ($arg eq '') {
10151: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
10152: } else {
10153: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10154: }
10155: }
10156: if (!ref($arg)) {
10157: return $arg;
10158: }
10159: }
10160:
1.251 albertel 10161: ###############################################
1.182 matthew 10162:
10163: =pod
10164:
1.549 albertel 10165: =back
10166:
10167: =head1 User Information Routines
10168:
10169: =over 4
10170:
1.405 albertel 10171: =item * &get_users_function()
1.182 matthew 10172:
10173: Used by &bodytag to determine the current users primary role.
10174: Returns either 'student','coordinator','admin', or 'author'.
10175:
10176: =cut
10177:
10178: ###############################################
10179: sub get_users_function {
1.815 tempelho 10180: my $function = 'norole';
1.818 tempelho 10181: if ($env{'request.role'}=~/^(st)/) {
10182: $function='student';
10183: }
1.907 raeburn 10184: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 10185: $function='coordinator';
10186: }
1.258 albertel 10187: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 10188: $function='admin';
10189: }
1.826 bisitz 10190: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 10191: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 10192: $function='author';
10193: }
10194: return $function;
1.54 www 10195: }
1.99 www 10196:
10197: ###############################################
10198:
1.233 raeburn 10199: =pod
10200:
1.821 raeburn 10201: =item * &show_course()
10202:
10203: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
10204: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
10205:
10206: Inputs:
10207: None
10208:
10209: Outputs:
10210: Scalar: 1 if 'Course' to be used, 0 otherwise.
10211:
10212: =cut
10213:
10214: ###############################################
10215: sub show_course {
10216: my $course = !$env{'user.adv'};
10217: if (!$env{'user.adv'}) {
10218: foreach my $env (keys(%env)) {
10219: next if ($env !~ m/^user\.priv\./);
10220: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
10221: $course = 0;
10222: last;
10223: }
10224: }
10225: }
10226: return $course;
10227: }
10228:
10229: ###############################################
10230:
10231: =pod
10232:
1.542 raeburn 10233: =item * &check_user_status()
1.274 raeburn 10234:
10235: Determines current status of supplied role for a
10236: specific user. Roles can be active, previous or future.
10237:
10238: Inputs:
10239: user's domain, user's username, course's domain,
1.375 raeburn 10240: course's number, optional section ID.
1.274 raeburn 10241:
10242: Outputs:
10243: role status: active, previous or future.
10244:
10245: =cut
10246:
10247: sub check_user_status {
1.412 raeburn 10248: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 10249: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 10250: my @uroles = keys(%userinfo);
1.274 raeburn 10251: my $srchstr;
10252: my $active_chk = 'none';
1.412 raeburn 10253: my $now = time;
1.274 raeburn 10254: if (@uroles > 0) {
1.908 raeburn 10255: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 10256: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
10257: } else {
1.412 raeburn 10258: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
10259: }
10260: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 10261: my $role_end = 0;
10262: my $role_start = 0;
10263: $active_chk = 'active';
1.412 raeburn 10264: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
10265: $role_end = $1;
10266: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
10267: $role_start = $1;
1.274 raeburn 10268: }
10269: }
10270: if ($role_start > 0) {
1.412 raeburn 10271: if ($now < $role_start) {
1.274 raeburn 10272: $active_chk = 'future';
10273: }
10274: }
10275: if ($role_end > 0) {
1.412 raeburn 10276: if ($now > $role_end) {
1.274 raeburn 10277: $active_chk = 'previous';
10278: }
10279: }
10280: }
10281: }
10282: return $active_chk;
10283: }
10284:
10285: ###############################################
10286:
10287: =pod
10288:
1.405 albertel 10289: =item * &get_sections()
1.233 raeburn 10290:
10291: Determines all the sections for a course including
10292: sections with students and sections containing other roles.
1.419 raeburn 10293: Incoming parameters:
10294:
10295: 1. domain
10296: 2. course number
10297: 3. reference to array containing roles for which sections should
10298: be gathered (optional).
10299: 4. reference to array containing status types for which sections
10300: should be gathered (optional).
10301:
10302: If the third argument is undefined, sections are gathered for any role.
10303: If the fourth argument is undefined, sections are gathered for any status.
10304: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 10305:
1.374 raeburn 10306: Returns section hash (keys are section IDs, values are
10307: number of users in each section), subject to the
1.419 raeburn 10308: optional roles filter, optional status filter
1.233 raeburn 10309:
10310: =cut
10311:
10312: ###############################################
10313: sub get_sections {
1.419 raeburn 10314: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 10315: if (!defined($cdom) || !defined($cnum)) {
10316: my $cid = $env{'request.course.id'};
10317:
10318: return if (!defined($cid));
10319:
10320: $cdom = $env{'course.'.$cid.'.domain'};
10321: $cnum = $env{'course.'.$cid.'.num'};
10322: }
10323:
10324: my %sectioncount;
1.419 raeburn 10325: my $now = time;
1.240 albertel 10326:
1.1118 raeburn 10327: my $check_students = 1;
10328: my $only_students = 0;
10329: if (ref($possible_roles) eq 'ARRAY') {
10330: if (grep(/^st$/,@{$possible_roles})) {
10331: if (@{$possible_roles} == 1) {
10332: $only_students = 1;
10333: }
10334: } else {
10335: $check_students = 0;
10336: }
10337: }
10338:
10339: if ($check_students) {
1.276 albertel 10340: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 10341: my $sec_index = &Apache::loncoursedata::CL_SECTION();
10342: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 10343: my $start_index = &Apache::loncoursedata::CL_START();
10344: my $end_index = &Apache::loncoursedata::CL_END();
10345: my $status;
1.366 albertel 10346: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 10347: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
10348: $data->[$status_index],
10349: $data->[$start_index],
10350: $data->[$end_index]);
10351: if ($stu_status eq 'Active') {
10352: $status = 'active';
10353: } elsif ($end < $now) {
10354: $status = 'previous';
10355: } elsif ($start > $now) {
10356: $status = 'future';
10357: }
10358: if ($section ne '-1' && $section !~ /^\s*$/) {
10359: if ((!defined($possible_status)) || (($status ne '') &&
10360: (grep/^\Q$status\E$/,@{$possible_status}))) {
10361: $sectioncount{$section}++;
10362: }
1.240 albertel 10363: }
10364: }
10365: }
1.1118 raeburn 10366: if ($only_students) {
10367: return %sectioncount;
10368: }
1.240 albertel 10369: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10370: foreach my $user (sort(keys(%courseroles))) {
10371: if ($user !~ /^(\w{2})/) { next; }
10372: my ($role) = ($user =~ /^(\w{2})/);
10373: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 10374: my ($section,$status);
1.240 albertel 10375: if ($role eq 'cr' &&
10376: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
10377: $section=$1;
10378: }
10379: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
10380: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 10381: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
10382: if ($end == -1 && $start == -1) {
10383: next; #deleted role
10384: }
10385: if (!defined($possible_status)) {
10386: $sectioncount{$section}++;
10387: } else {
10388: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
10389: $status = 'active';
10390: } elsif ($end < $now) {
10391: $status = 'future';
10392: } elsif ($start > $now) {
10393: $status = 'previous';
10394: }
10395: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
10396: $sectioncount{$section}++;
10397: }
10398: }
1.233 raeburn 10399: }
1.366 albertel 10400: return %sectioncount;
1.233 raeburn 10401: }
10402:
1.274 raeburn 10403: ###############################################
1.294 raeburn 10404:
10405: =pod
1.405 albertel 10406:
10407: =item * &get_course_users()
10408:
1.275 raeburn 10409: Retrieves usernames:domains for users in the specified course
10410: with specific role(s), and access status.
10411:
10412: Incoming parameters:
1.277 albertel 10413: 1. course domain
10414: 2. course number
10415: 3. access status: users must have - either active,
1.275 raeburn 10416: previous, future, or all.
1.277 albertel 10417: 4. reference to array of permissible roles
1.288 raeburn 10418: 5. reference to array of section restrictions (optional)
10419: 6. reference to results object (hash of hashes).
10420: 7. reference to optional userdata hash
1.609 raeburn 10421: 8. reference to optional statushash
1.630 raeburn 10422: 9. flag if privileged users (except those set to unhide in
10423: course settings) should be excluded
1.609 raeburn 10424: Keys of top level results hash are roles.
1.275 raeburn 10425: Keys of inner hashes are username:domain, with
10426: values set to access type.
1.288 raeburn 10427: Optional userdata hash returns an array with arguments in the
10428: same order as loncoursedata::get_classlist() for student data.
10429:
1.609 raeburn 10430: Optional statushash returns
10431:
1.288 raeburn 10432: Entries for end, start, section and status are blank because
10433: of the possibility of multiple values for non-student roles.
10434:
1.275 raeburn 10435: =cut
1.405 albertel 10436:
1.275 raeburn 10437: ###############################################
1.405 albertel 10438:
1.275 raeburn 10439: sub get_course_users {
1.630 raeburn 10440: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 10441: my %idx = ();
1.419 raeburn 10442: my %seclists;
1.288 raeburn 10443:
10444: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
10445: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
10446: $idx{end} = &Apache::loncoursedata::CL_END();
10447: $idx{start} = &Apache::loncoursedata::CL_START();
10448: $idx{id} = &Apache::loncoursedata::CL_ID();
10449: $idx{section} = &Apache::loncoursedata::CL_SECTION();
10450: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
10451: $idx{status} = &Apache::loncoursedata::CL_STATUS();
10452:
1.290 albertel 10453: if (grep(/^st$/,@{$roles})) {
1.276 albertel 10454: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 10455: my $now = time;
1.277 albertel 10456: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 10457: my $match = 0;
1.412 raeburn 10458: my $secmatch = 0;
1.419 raeburn 10459: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 10460: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 10461: if ($section eq '') {
10462: $section = 'none';
10463: }
1.291 albertel 10464: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10465: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10466: $secmatch = 1;
10467: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 10468: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10469: $secmatch = 1;
10470: }
10471: } else {
1.419 raeburn 10472: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 10473: $secmatch = 1;
10474: }
1.290 albertel 10475: }
1.412 raeburn 10476: if (!$secmatch) {
10477: next;
10478: }
1.419 raeburn 10479: }
1.275 raeburn 10480: if (defined($$types{'active'})) {
1.288 raeburn 10481: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 10482: push(@{$$users{st}{$student}},'active');
1.288 raeburn 10483: $match = 1;
1.275 raeburn 10484: }
10485: }
10486: if (defined($$types{'previous'})) {
1.609 raeburn 10487: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 10488: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 10489: $match = 1;
1.275 raeburn 10490: }
10491: }
10492: if (defined($$types{'future'})) {
1.609 raeburn 10493: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 10494: push(@{$$users{st}{$student}},'future');
1.288 raeburn 10495: $match = 1;
1.275 raeburn 10496: }
10497: }
1.609 raeburn 10498: if ($match) {
10499: push(@{$seclists{$student}},$section);
10500: if (ref($userdata) eq 'HASH') {
10501: $$userdata{$student} = $$classlist{$student};
10502: }
10503: if (ref($statushash) eq 'HASH') {
10504: $statushash->{$student}{'st'}{$section} = $status;
10505: }
1.288 raeburn 10506: }
1.275 raeburn 10507: }
10508: }
1.412 raeburn 10509: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 10510: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10511: my $now = time;
1.609 raeburn 10512: my %displaystatus = ( previous => 'Expired',
10513: active => 'Active',
10514: future => 'Future',
10515: );
1.1121 raeburn 10516: my (%nothide,@possdoms);
1.630 raeburn 10517: if ($hidepriv) {
10518: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
10519: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
10520: if ($user !~ /:/) {
10521: $nothide{join(':',split(/[\@]/,$user))}=1;
10522: } else {
10523: $nothide{$user} = 1;
10524: }
10525: }
1.1121 raeburn 10526: my @possdoms = ($cdom);
10527: if ($coursehash{'checkforpriv'}) {
10528: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
10529: }
1.630 raeburn 10530: }
1.439 raeburn 10531: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 10532: my $match = 0;
1.412 raeburn 10533: my $secmatch = 0;
1.439 raeburn 10534: my $status;
1.412 raeburn 10535: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 10536: $user =~ s/:$//;
1.439 raeburn 10537: my ($end,$start) = split(/:/,$coursepersonnel{$person});
10538: if ($end == -1 || $start == -1) {
10539: next;
10540: }
10541: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
10542: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 10543: my ($uname,$udom) = split(/:/,$user);
10544: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10545: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10546: $secmatch = 1;
10547: } elsif ($usec eq '') {
1.420 albertel 10548: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10549: $secmatch = 1;
10550: }
10551: } else {
10552: if (grep(/^\Q$usec\E$/,@{$sections})) {
10553: $secmatch = 1;
10554: }
10555: }
10556: if (!$secmatch) {
10557: next;
10558: }
1.288 raeburn 10559: }
1.419 raeburn 10560: if ($usec eq '') {
10561: $usec = 'none';
10562: }
1.275 raeburn 10563: if ($uname ne '' && $udom ne '') {
1.630 raeburn 10564: if ($hidepriv) {
1.1121 raeburn 10565: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 10566: (!$nothide{$uname.':'.$udom})) {
10567: next;
10568: }
10569: }
1.503 raeburn 10570: if ($end > 0 && $end < $now) {
1.439 raeburn 10571: $status = 'previous';
10572: } elsif ($start > $now) {
10573: $status = 'future';
10574: } else {
10575: $status = 'active';
10576: }
1.277 albertel 10577: foreach my $type (keys(%{$types})) {
1.275 raeburn 10578: if ($status eq $type) {
1.420 albertel 10579: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 10580: push(@{$$users{$role}{$user}},$type);
10581: }
1.288 raeburn 10582: $match = 1;
10583: }
10584: }
1.419 raeburn 10585: if (($match) && (ref($userdata) eq 'HASH')) {
10586: if (!exists($$userdata{$uname.':'.$udom})) {
10587: &get_user_info($udom,$uname,\%idx,$userdata);
10588: }
1.420 albertel 10589: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 10590: push(@{$seclists{$uname.':'.$udom}},$usec);
10591: }
1.609 raeburn 10592: if (ref($statushash) eq 'HASH') {
10593: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
10594: }
1.275 raeburn 10595: }
10596: }
10597: }
10598: }
1.290 albertel 10599: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 10600: if ((defined($cdom)) && (defined($cnum))) {
10601: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
10602: if ( defined($csettings{'internal.courseowner'}) ) {
10603: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 10604: next if ($owner eq '');
10605: my ($ownername,$ownerdom);
10606: if ($owner =~ /^([^:]+):([^:]+)$/) {
10607: $ownername = $1;
10608: $ownerdom = $2;
10609: } else {
10610: $ownername = $owner;
10611: $ownerdom = $cdom;
10612: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 10613: }
10614: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 10615: if (defined($userdata) &&
1.609 raeburn 10616: !exists($$userdata{$owner})) {
10617: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
10618: if (!grep(/^none$/,@{$seclists{$owner}})) {
10619: push(@{$seclists{$owner}},'none');
10620: }
10621: if (ref($statushash) eq 'HASH') {
10622: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 10623: }
1.290 albertel 10624: }
1.279 raeburn 10625: }
10626: }
10627: }
1.419 raeburn 10628: foreach my $user (keys(%seclists)) {
10629: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
10630: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
10631: }
1.275 raeburn 10632: }
10633: return;
10634: }
10635:
1.288 raeburn 10636: sub get_user_info {
10637: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 10638: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
10639: &plainname($uname,$udom,'lastname');
1.291 albertel 10640: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 10641: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 10642: my %idhash = &Apache::lonnet::idrget($udom,($uname));
10643: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 10644: return;
10645: }
1.275 raeburn 10646:
1.472 raeburn 10647: ###############################################
10648:
10649: =pod
10650:
10651: =item * &get_user_quota()
10652:
1.1134 raeburn 10653: Retrieves quota assigned for storage of user files.
10654: Default is to report quota for portfolio files.
1.472 raeburn 10655:
10656: Incoming parameters:
10657: 1. user's username
10658: 2. user's domain
1.1134 raeburn 10659: 3. quota name - portfolio, author, or course
1.1136 raeburn 10660: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 10661: 4. crstype - official, unofficial, textbook, placement or community,
10662: if quota name is course
1.472 raeburn 10663:
10664: Returns:
1.1163 raeburn 10665: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 10666: 2. (Optional) Type of setting: custom or default
10667: (individually assigned or default for user's
10668: institutional status).
10669: 3. (Optional) - User's institutional status (e.g., faculty, staff
10670: or student - types as defined in localenroll::inst_usertypes
10671: for user's domain, which determines default quota for user.
10672: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 10673:
10674: If a value has been stored in the user's environment,
1.536 raeburn 10675: it will return that, otherwise it returns the maximal default
1.1134 raeburn 10676: defined for the user's institutional status(es) in the domain.
1.472 raeburn 10677:
10678: =cut
10679:
10680: ###############################################
10681:
10682:
10683: sub get_user_quota {
1.1136 raeburn 10684: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 10685: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 10686: if (!defined($udom)) {
10687: $udom = $env{'user.domain'};
10688: }
10689: if (!defined($uname)) {
10690: $uname = $env{'user.name'};
10691: }
10692: if (($udom eq '' || $uname eq '') ||
10693: ($udom eq 'public') && ($uname eq 'public')) {
10694: $quota = 0;
1.536 raeburn 10695: $quotatype = 'default';
10696: $defquota = 0;
1.472 raeburn 10697: } else {
1.536 raeburn 10698: my $inststatus;
1.1134 raeburn 10699: if ($quotaname eq 'course') {
10700: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
10701: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
10702: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
10703: } else {
10704: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
10705: $quota = $cenv{'internal.uploadquota'};
10706: }
1.536 raeburn 10707: } else {
1.1134 raeburn 10708: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
10709: if ($quotaname eq 'author') {
10710: $quota = $env{'environment.authorquota'};
10711: } else {
10712: $quota = $env{'environment.portfolioquota'};
10713: }
10714: $inststatus = $env{'environment.inststatus'};
10715: } else {
10716: my %userenv =
10717: &Apache::lonnet::get('environment',['portfolioquota',
10718: 'authorquota','inststatus'],$udom,$uname);
10719: my ($tmp) = keys(%userenv);
10720: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
10721: if ($quotaname eq 'author') {
10722: $quota = $userenv{'authorquota'};
10723: } else {
10724: $quota = $userenv{'portfolioquota'};
10725: }
10726: $inststatus = $userenv{'inststatus'};
10727: } else {
10728: undef(%userenv);
10729: }
10730: }
10731: }
10732: if ($quota eq '' || wantarray) {
10733: if ($quotaname eq 'course') {
10734: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 10735: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 10736: ($crstype eq 'community') || ($crstype eq 'textbook') ||
10737: ($crstype eq 'placement')) {
1.1136 raeburn 10738: $defquota = $domdefs{$crstype.'quota'};
10739: }
10740: if ($defquota eq '') {
10741: $defquota = 500;
10742: }
1.1134 raeburn 10743: } else {
10744: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
10745: }
10746: if ($quota eq '') {
10747: $quota = $defquota;
10748: $quotatype = 'default';
10749: } else {
10750: $quotatype = 'custom';
10751: }
1.472 raeburn 10752: }
10753: }
1.536 raeburn 10754: if (wantarray) {
10755: return ($quota,$quotatype,$settingstatus,$defquota);
10756: } else {
10757: return $quota;
10758: }
1.472 raeburn 10759: }
10760:
10761: ###############################################
10762:
10763: =pod
10764:
10765: =item * &default_quota()
10766:
1.536 raeburn 10767: Retrieves default quota assigned for storage of user portfolio files,
10768: given an (optional) user's institutional status.
1.472 raeburn 10769:
10770: Incoming parameters:
1.1142 raeburn 10771:
1.472 raeburn 10772: 1. domain
1.536 raeburn 10773: 2. (Optional) institutional status(es). This is a : separated list of
10774: status types (e.g., faculty, staff, student etc.)
10775: which apply to the user for whom the default is being retrieved.
10776: If the institutional status string in undefined, the domain
1.1134 raeburn 10777: default quota will be returned.
10778: 3. quota name - portfolio, author, or course
10779: (if no quota name provided, defaults to portfolio).
1.472 raeburn 10780:
10781: Returns:
1.1142 raeburn 10782:
1.1163 raeburn 10783: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 10784: 2. (Optional) institutional type which determined the value of the
10785: default quota.
1.472 raeburn 10786:
10787: If a value has been stored in the domain's configuration db,
10788: it will return that, otherwise it returns 20 (for backwards
10789: compatibility with domains which have not set up a configuration
1.1163 raeburn 10790: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 10791:
1.536 raeburn 10792: If the user's status includes multiple types (e.g., staff and student),
10793: the largest default quota which applies to the user determines the
10794: default quota returned.
10795:
1.472 raeburn 10796: =cut
10797:
10798: ###############################################
10799:
10800:
10801: sub default_quota {
1.1134 raeburn 10802: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 10803: my ($defquota,$settingstatus);
10804: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 10805: ['quotas'],$udom);
1.1134 raeburn 10806: my $key = 'defaultquota';
10807: if ($quotaname eq 'author') {
10808: $key = 'authorquota';
10809: }
1.622 raeburn 10810: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 10811: if ($inststatus ne '') {
1.765 raeburn 10812: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 10813: foreach my $item (@statuses) {
1.1134 raeburn 10814: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10815: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 10816: if ($defquota eq '') {
1.1134 raeburn 10817: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10818: $settingstatus = $item;
1.1134 raeburn 10819: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
10820: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10821: $settingstatus = $item;
10822: }
10823: }
1.1134 raeburn 10824: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10825: if ($quotahash{'quotas'}{$item} ne '') {
10826: if ($defquota eq '') {
10827: $defquota = $quotahash{'quotas'}{$item};
10828: $settingstatus = $item;
10829: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
10830: $defquota = $quotahash{'quotas'}{$item};
10831: $settingstatus = $item;
10832: }
1.536 raeburn 10833: }
10834: }
10835: }
10836: }
10837: if ($defquota eq '') {
1.1134 raeburn 10838: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10839: $defquota = $quotahash{'quotas'}{$key}{'default'};
10840: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10841: $defquota = $quotahash{'quotas'}{'default'};
10842: }
1.536 raeburn 10843: $settingstatus = 'default';
1.1139 raeburn 10844: if ($defquota eq '') {
10845: if ($quotaname eq 'author') {
10846: $defquota = 500;
10847: }
10848: }
1.536 raeburn 10849: }
10850: } else {
10851: $settingstatus = 'default';
1.1134 raeburn 10852: if ($quotaname eq 'author') {
10853: $defquota = 500;
10854: } else {
10855: $defquota = 20;
10856: }
1.536 raeburn 10857: }
10858: if (wantarray) {
10859: return ($defquota,$settingstatus);
1.472 raeburn 10860: } else {
1.536 raeburn 10861: return $defquota;
1.472 raeburn 10862: }
10863: }
10864:
1.1135 raeburn 10865: ###############################################
10866:
10867: =pod
10868:
1.1136 raeburn 10869: =item * &excess_filesize_warning()
1.1135 raeburn 10870:
10871: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 10872: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 10873: space to be exceeded.
1.1136 raeburn 10874:
10875: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 10876: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 10877:
1.1165 raeburn 10878: Inputs: 7
1.1136 raeburn 10879: 1. username or coursenum
1.1135 raeburn 10880: 2. domain
1.1136 raeburn 10881: 3. context ('author' or 'course')
1.1135 raeburn 10882: 4. filename of file for which action is being requested
10883: 5. filesize (kB) of file
10884: 6. action being taken: copy or upload.
1.1237 raeburn 10885: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 10886:
10887: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 10888: otherwise return null.
10889:
10890: =back
1.1135 raeburn 10891:
10892: =cut
10893:
1.1136 raeburn 10894: sub excess_filesize_warning {
1.1165 raeburn 10895: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 10896: my $current_disk_usage = 0;
1.1165 raeburn 10897: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 10898: if ($context eq 'author') {
10899: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
10900: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
10901: } else {
10902: foreach my $subdir ('docs','supplemental') {
10903: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
10904: }
10905: }
1.1135 raeburn 10906: $disk_quota = int($disk_quota * 1000);
10907: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 10908: return '<p class="LC_warning">'.
1.1135 raeburn 10909: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 10910: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
10911: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 10912: $disk_quota,$current_disk_usage).
10913: '</p>';
10914: }
10915: return;
10916: }
10917:
10918: ###############################################
10919:
10920:
1.1136 raeburn 10921:
10922:
1.384 raeburn 10923: sub get_secgrprole_info {
10924: my ($cdom,$cnum,$needroles,$type) = @_;
10925: my %sections_count = &get_sections($cdom,$cnum);
10926: my @sections = (sort {$a <=> $b} keys(%sections_count));
10927: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
10928: my @groups = sort(keys(%curr_groups));
10929: my $allroles = [];
10930: my $rolehash;
10931: my $accesshash = {
10932: active => 'Currently has access',
10933: future => 'Will have future access',
10934: previous => 'Previously had access',
10935: };
10936: if ($needroles) {
10937: $rolehash = {'all' => 'all'};
1.385 albertel 10938: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10939: if (&Apache::lonnet::error(%user_roles)) {
10940: undef(%user_roles);
10941: }
10942: foreach my $item (keys(%user_roles)) {
1.384 raeburn 10943: my ($role)=split(/\:/,$item,2);
10944: if ($role eq 'cr') { next; }
10945: if ($role =~ /^cr/) {
10946: $$rolehash{$role} = (split('/',$role))[3];
10947: } else {
10948: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
10949: }
10950: }
10951: foreach my $key (sort(keys(%{$rolehash}))) {
10952: push(@{$allroles},$key);
10953: }
10954: push (@{$allroles},'st');
10955: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
10956: }
10957: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
10958: }
10959:
1.555 raeburn 10960: sub user_picker {
1.1279 raeburn 10961: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 10962: my $currdom = $dom;
1.1253 raeburn 10963: my @alldoms = &Apache::lonnet::all_domains();
10964: if (@alldoms == 1) {
10965: my %domsrch = &Apache::lonnet::get_dom('configuration',
10966: ['directorysrch'],$alldoms[0]);
10967: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
10968: my $showdom = $domdesc;
10969: if ($showdom eq '') {
10970: $showdom = $dom;
10971: }
10972: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
10973: if ((!$domsrch{'directorysrch'}{'available'}) &&
10974: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
10975: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
10976: }
10977: }
10978: }
1.555 raeburn 10979: my %curr_selected = (
10980: srchin => 'dom',
1.580 raeburn 10981: srchby => 'lastname',
1.555 raeburn 10982: );
10983: my $srchterm;
1.625 raeburn 10984: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 10985: if ($srch->{'srchby'} ne '') {
10986: $curr_selected{'srchby'} = $srch->{'srchby'};
10987: }
10988: if ($srch->{'srchin'} ne '') {
10989: $curr_selected{'srchin'} = $srch->{'srchin'};
10990: }
10991: if ($srch->{'srchtype'} ne '') {
10992: $curr_selected{'srchtype'} = $srch->{'srchtype'};
10993: }
10994: if ($srch->{'srchdomain'} ne '') {
10995: $currdom = $srch->{'srchdomain'};
10996: }
10997: $srchterm = $srch->{'srchterm'};
10998: }
1.1222 damieng 10999: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 11000: 'usr' => 'Search criteria',
1.563 raeburn 11001: 'doma' => 'Domain/institution to search',
1.558 albertel 11002: 'uname' => 'username',
11003: 'lastname' => 'last name',
1.555 raeburn 11004: 'lastfirst' => 'last name, first name',
1.558 albertel 11005: 'crs' => 'in this course',
1.576 raeburn 11006: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 11007: 'alc' => 'all LON-CAPA',
1.573 raeburn 11008: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 11009: 'exact' => 'is',
11010: 'contains' => 'contains',
1.569 raeburn 11011: 'begins' => 'begins with',
1.1222 damieng 11012: );
11013: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 11014: 'youm' => "You must include some text to search for.",
11015: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
11016: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
11017: 'yomc' => "You must choose a domain when using an institutional directory search.",
11018: 'ymcd' => "You must choose a domain when using a domain search.",
11019: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
11020: 'whse' => "When searching by last,first you must include at least one character in the first name.",
11021: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 11022: );
1.1222 damieng 11023: &html_escape(\%html_lt);
11024: &js_escape(\%js_lt);
1.1255 raeburn 11025: my $domform;
1.1277 raeburn 11026: my $allow_blank = 1;
1.1255 raeburn 11027: if ($fixeddom) {
1.1277 raeburn 11028: $allow_blank = 0;
11029: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 11030: } else {
1.1287 raeburn 11031: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 11032: my ($trusted,$untrusted);
1.1287 raeburn 11033: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 11034: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 11035: } elsif ($context eq 'author') {
1.1288 raeburn 11036: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 11037: } elsif ($context eq 'domain') {
1.1288 raeburn 11038: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 11039: }
1.1288 raeburn 11040: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 11041: }
1.563 raeburn 11042: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 11043:
11044: my @srchins = ('crs','dom','alc','instd');
11045:
11046: foreach my $option (@srchins) {
11047: # FIXME 'alc' option unavailable until
11048: # loncreateuser::print_user_query_page()
11049: # has been completed.
11050: next if ($option eq 'alc');
1.880 raeburn 11051: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 11052: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 11053: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 11054: if ($curr_selected{'srchin'} eq $option) {
11055: $srchinsel .= '
1.1222 damieng 11056: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 11057: } else {
11058: $srchinsel .= '
1.1222 damieng 11059: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 11060: }
1.555 raeburn 11061: }
1.563 raeburn 11062: $srchinsel .= "\n </select>\n";
1.555 raeburn 11063:
11064: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 11065: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 11066: if ($curr_selected{'srchby'} eq $option) {
11067: $srchbysel .= '
1.1222 damieng 11068: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11069: } else {
11070: $srchbysel .= '
1.1222 damieng 11071: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11072: }
11073: }
11074: $srchbysel .= "\n </select>\n";
11075:
11076: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 11077: foreach my $option ('begins','contains','exact') {
1.555 raeburn 11078: if ($curr_selected{'srchtype'} eq $option) {
11079: $srchtypesel .= '
1.1222 damieng 11080: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11081: } else {
11082: $srchtypesel .= '
1.1222 damieng 11083: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11084: }
11085: }
11086: $srchtypesel .= "\n </select>\n";
11087:
1.558 albertel 11088: my ($newuserscript,$new_user_create);
1.994 raeburn 11089: my $context_dom = $env{'request.role.domain'};
11090: if ($context eq 'requestcrs') {
11091: if ($env{'form.coursedom'} ne '') {
11092: $context_dom = $env{'form.coursedom'};
11093: }
11094: }
1.556 raeburn 11095: if ($forcenewuser) {
1.576 raeburn 11096: if (ref($srch) eq 'HASH') {
1.994 raeburn 11097: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 11098: if ($cancreate) {
11099: $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>';
11100: } else {
1.799 bisitz 11101: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 11102: my %usertypetext = (
11103: official => 'institutional',
11104: unofficial => 'non-institutional',
11105: );
1.799 bisitz 11106: $new_user_create = '<p class="LC_warning">'
11107: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
11108: .' '
11109: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
11110: ,'<a href="'.$helplink.'">','</a>')
11111: .'</p><br />';
1.627 raeburn 11112: }
1.576 raeburn 11113: }
11114: }
11115:
1.556 raeburn 11116: $newuserscript = <<"ENDSCRIPT";
11117:
1.570 raeburn 11118: function setSearch(createnew,callingForm) {
1.556 raeburn 11119: if (createnew == 1) {
1.570 raeburn 11120: for (var i=0; i<callingForm.srchby.length; i++) {
11121: if (callingForm.srchby.options[i].value == 'uname') {
11122: callingForm.srchby.selectedIndex = i;
1.556 raeburn 11123: }
11124: }
1.570 raeburn 11125: for (var i=0; i<callingForm.srchin.length; i++) {
11126: if ( callingForm.srchin.options[i].value == 'dom') {
11127: callingForm.srchin.selectedIndex = i;
1.556 raeburn 11128: }
11129: }
1.570 raeburn 11130: for (var i=0; i<callingForm.srchtype.length; i++) {
11131: if (callingForm.srchtype.options[i].value == 'exact') {
11132: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 11133: }
11134: }
1.570 raeburn 11135: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 11136: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 11137: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 11138: }
11139: }
11140: }
11141: }
11142: ENDSCRIPT
1.558 albertel 11143:
1.556 raeburn 11144: }
11145:
1.555 raeburn 11146: my $output = <<"END_BLOCK";
1.556 raeburn 11147: <script type="text/javascript">
1.824 bisitz 11148: // <![CDATA[
1.570 raeburn 11149: function validateEntry(callingForm) {
1.558 albertel 11150:
1.556 raeburn 11151: var checkok = 1;
1.558 albertel 11152: var srchin;
1.570 raeburn 11153: for (var i=0; i<callingForm.srchin.length; i++) {
11154: if ( callingForm.srchin[i].checked ) {
11155: srchin = callingForm.srchin[i].value;
1.558 albertel 11156: }
11157: }
11158:
1.570 raeburn 11159: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
11160: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
11161: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
11162: var srchterm = callingForm.srchterm.value;
11163: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 11164: var msg = "";
11165:
11166: if (srchterm == "") {
11167: checkok = 0;
1.1222 damieng 11168: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 11169: }
11170:
1.569 raeburn 11171: if (srchtype== 'begins') {
11172: if (srchterm.length < 2) {
11173: checkok = 0;
1.1222 damieng 11174: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 11175: }
11176: }
11177:
1.556 raeburn 11178: if (srchtype== 'contains') {
11179: if (srchterm.length < 3) {
11180: checkok = 0;
1.1222 damieng 11181: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 11182: }
11183: }
11184: if (srchin == 'instd') {
11185: if (srchdomain == '') {
11186: checkok = 0;
1.1222 damieng 11187: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 11188: }
11189: }
11190: if (srchin == 'dom') {
11191: if (srchdomain == '') {
11192: checkok = 0;
1.1222 damieng 11193: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 11194: }
11195: }
11196: if (srchby == 'lastfirst') {
11197: if (srchterm.indexOf(",") == -1) {
11198: checkok = 0;
1.1222 damieng 11199: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 11200: }
11201: if (srchterm.indexOf(",") == srchterm.length -1) {
11202: checkok = 0;
1.1222 damieng 11203: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 11204: }
11205: }
11206: if (checkok == 0) {
1.1222 damieng 11207: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 11208: return;
11209: }
11210: if (checkok == 1) {
1.570 raeburn 11211: callingForm.submit();
1.556 raeburn 11212: }
11213: }
11214:
11215: $newuserscript
11216:
1.824 bisitz 11217: // ]]>
1.556 raeburn 11218: </script>
1.558 albertel 11219:
11220: $new_user_create
11221:
1.555 raeburn 11222: END_BLOCK
1.558 albertel 11223:
1.876 raeburn 11224: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 11225: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 11226: $domform.
11227: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 11228: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 11229: $srchbysel.
11230: $srchtypesel.
11231: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
11232: $srchinsel.
11233: &Apache::lonhtmlcommon::row_closure(1).
11234: &Apache::lonhtmlcommon::end_pick_box().
11235: '<br />';
1.1253 raeburn 11236: return ($output,1);
1.555 raeburn 11237: }
11238:
1.612 raeburn 11239: sub user_rule_check {
1.615 raeburn 11240: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 11241: my ($response,%inst_response);
1.612 raeburn 11242: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 11243: if (keys(%{$usershash}) > 1) {
11244: my (%by_username,%by_id,%userdoms);
11245: my $checkid;
11246: if (ref($checks) eq 'HASH') {
11247: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
11248: $checkid = 1;
11249: }
11250: }
11251: foreach my $user (keys(%{$usershash})) {
11252: my ($uname,$udom) = split(/:/,$user);
11253: if ($checkid) {
11254: if (ref($usershash->{$user}) eq 'HASH') {
11255: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 11256: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 11257: $userdoms{$udom} = 1;
1.1227 raeburn 11258: if (ref($inst_results) eq 'HASH') {
11259: $inst_results->{$uname.':'.$udom} = {};
11260: }
1.1226 raeburn 11261: }
11262: }
11263: } else {
11264: $by_username{$udom}{$uname} = 1;
11265: $userdoms{$udom} = 1;
1.1227 raeburn 11266: if (ref($inst_results) eq 'HASH') {
11267: $inst_results->{$uname.':'.$udom} = {};
11268: }
1.1226 raeburn 11269: }
11270: }
11271: foreach my $udom (keys(%userdoms)) {
11272: if (!$got_rules->{$udom}) {
11273: my %domconfig = &Apache::lonnet::get_dom('configuration',
11274: ['usercreation'],$udom);
11275: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11276: foreach my $item ('username','id') {
11277: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 11278: $$curr_rules{$udom}{$item} =
11279: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 11280: }
11281: }
11282: }
11283: $got_rules->{$udom} = 1;
11284: }
1.612 raeburn 11285: }
1.1226 raeburn 11286: if ($checkid) {
11287: foreach my $udom (keys(%by_id)) {
11288: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
11289: if ($outcome eq 'ok') {
1.1227 raeburn 11290: foreach my $id (keys(%{$by_id{$udom}})) {
11291: my $uname = $by_id{$udom}{$id};
11292: $inst_response{$uname.':'.$udom} = $outcome;
11293: }
1.1226 raeburn 11294: if (ref($results) eq 'HASH') {
11295: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 11296: if (exists($inst_response{$uname.':'.$udom})) {
11297: $inst_response{$uname.':'.$udom} = $outcome;
11298: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11299: }
1.1226 raeburn 11300: }
11301: }
11302: }
1.612 raeburn 11303: }
1.615 raeburn 11304: } else {
1.1226 raeburn 11305: foreach my $udom (keys(%by_username)) {
11306: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
11307: if ($outcome eq 'ok') {
1.1227 raeburn 11308: foreach my $uname (keys(%{$by_username{$udom}})) {
11309: $inst_response{$uname.':'.$udom} = $outcome;
11310: }
1.1226 raeburn 11311: if (ref($results) eq 'HASH') {
11312: foreach my $uname (keys(%{$results})) {
11313: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11314: }
11315: }
11316: }
11317: }
1.612 raeburn 11318: }
1.1226 raeburn 11319: } elsif (keys(%{$usershash}) == 1) {
11320: my $user = (keys(%{$usershash}))[0];
11321: my ($uname,$udom) = split(/:/,$user);
11322: if (($udom ne '') && ($uname ne '')) {
11323: if (ref($usershash->{$user}) eq 'HASH') {
11324: if (ref($checks) eq 'HASH') {
11325: if (defined($checks->{'username'})) {
11326: ($inst_response{$user},%{$inst_results->{$user}}) =
11327: &Apache::lonnet::get_instuser($udom,$uname);
11328: } elsif (defined($checks->{'id'})) {
11329: if ($usershash->{$user}->{'id'} ne '') {
11330: ($inst_response{$user},%{$inst_results->{$user}}) =
11331: &Apache::lonnet::get_instuser($udom,undef,
11332: $usershash->{$user}->{'id'});
11333: } else {
11334: ($inst_response{$user},%{$inst_results->{$user}}) =
11335: &Apache::lonnet::get_instuser($udom,$uname);
11336: }
1.585 raeburn 11337: }
1.1226 raeburn 11338: } else {
11339: ($inst_response{$user},%{$inst_results->{$user}}) =
11340: &Apache::lonnet::get_instuser($udom,$uname);
11341: return;
11342: }
11343: if (!$got_rules->{$udom}) {
11344: my %domconfig = &Apache::lonnet::get_dom('configuration',
11345: ['usercreation'],$udom);
11346: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11347: foreach my $item ('username','id') {
11348: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
11349: $$curr_rules{$udom}{$item} =
11350: $domconfig{'usercreation'}{$item.'_rule'};
11351: }
11352: }
11353: }
11354: $got_rules->{$udom} = 1;
1.585 raeburn 11355: }
11356: }
1.1226 raeburn 11357: } else {
11358: return;
11359: }
11360: } else {
11361: return;
11362: }
11363: foreach my $user (keys(%{$usershash})) {
11364: my ($uname,$udom) = split(/:/,$user);
11365: next if (($udom eq '') || ($uname eq ''));
11366: my $id;
1.1227 raeburn 11367: if (ref($inst_results) eq 'HASH') {
11368: if (ref($inst_results->{$user}) eq 'HASH') {
11369: $id = $inst_results->{$user}->{'id'};
11370: }
11371: }
11372: if ($id eq '') {
11373: if (ref($usershash->{$user})) {
11374: $id = $usershash->{$user}->{'id'};
11375: }
1.585 raeburn 11376: }
1.612 raeburn 11377: foreach my $item (keys(%{$checks})) {
11378: if (ref($$curr_rules{$udom}) eq 'HASH') {
11379: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
11380: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 11381: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
11382: $$curr_rules{$udom}{$item});
1.612 raeburn 11383: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
11384: if ($rule_check{$rule}) {
11385: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 11386: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 11387: if (ref($inst_results) eq 'HASH') {
11388: if (ref($inst_results->{$user}) eq 'HASH') {
11389: if (keys(%{$inst_results->{$user}}) == 0) {
11390: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 11391: } elsif ($item eq 'id') {
11392: if ($inst_results->{$user}->{'id'} eq '') {
11393: $$alerts{$item}{$udom}{$uname} = 1;
11394: }
1.615 raeburn 11395: }
1.612 raeburn 11396: }
11397: }
1.615 raeburn 11398: }
11399: last;
1.585 raeburn 11400: }
11401: }
11402: }
11403: }
11404: }
11405: }
11406: }
11407: }
1.612 raeburn 11408: return;
11409: }
11410:
11411: sub user_rule_formats {
11412: my ($domain,$domdesc,$curr_rules,$check) = @_;
11413: my %text = (
11414: 'username' => 'Usernames',
11415: 'id' => 'IDs',
11416: );
11417: my $output;
11418: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
11419: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
11420: if (@{$ruleorder} > 0) {
1.1102 raeburn 11421: $output = '<br />'.
11422: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
11423: '<span class="LC_cusr_emph">','</span>',$domdesc).
11424: ' <ul>';
1.612 raeburn 11425: foreach my $rule (@{$ruleorder}) {
11426: if (ref($curr_rules) eq 'ARRAY') {
11427: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
11428: if (ref($rules->{$rule}) eq 'HASH') {
11429: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
11430: $rules->{$rule}{'desc'}.'</li>';
11431: }
11432: }
11433: }
11434: }
11435: $output .= '</ul>';
11436: }
11437: }
11438: return $output;
11439: }
11440:
11441: sub instrule_disallow_msg {
1.615 raeburn 11442: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 11443: my $response;
11444: my %text = (
11445: item => 'username',
11446: items => 'usernames',
11447: match => 'matches',
11448: do => 'does',
11449: action => 'a username',
11450: one => 'one',
11451: );
11452: if ($count > 1) {
11453: $text{'item'} = 'usernames';
11454: $text{'match'} ='match';
11455: $text{'do'} = 'do';
11456: $text{'action'} = 'usernames',
11457: $text{'one'} = 'ones';
11458: }
11459: if ($checkitem eq 'id') {
11460: $text{'items'} = 'IDs';
11461: $text{'item'} = 'ID';
11462: $text{'action'} = 'an ID';
1.615 raeburn 11463: if ($count > 1) {
11464: $text{'item'} = 'IDs';
11465: $text{'action'} = 'IDs';
11466: }
1.612 raeburn 11467: }
1.674 bisitz 11468: $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 11469: if ($mode eq 'upload') {
11470: if ($checkitem eq 'username') {
11471: $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'}.");
11472: } elsif ($checkitem eq 'id') {
1.674 bisitz 11473: $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 11474: }
1.669 raeburn 11475: } elsif ($mode eq 'selfcreate') {
11476: if ($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.615 raeburn 11479: } else {
11480: if ($checkitem eq 'username') {
11481: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
11482: } elsif ($checkitem eq 'id') {
11483: $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.");
11484: }
1.612 raeburn 11485: }
11486: return $response;
1.585 raeburn 11487: }
11488:
1.624 raeburn 11489: sub personal_data_fieldtitles {
11490: my %fieldtitles = &Apache::lonlocal::texthash (
11491: id => 'Student/Employee ID',
11492: permanentemail => 'E-mail address',
11493: lastname => 'Last Name',
11494: firstname => 'First Name',
11495: middlename => 'Middle Name',
11496: generation => 'Generation',
11497: gen => 'Generation',
1.765 raeburn 11498: inststatus => 'Affiliation',
1.624 raeburn 11499: );
11500: return %fieldtitles;
11501: }
11502:
1.642 raeburn 11503: sub sorted_inst_types {
11504: my ($dom) = @_;
1.1185 raeburn 11505: my ($usertypes,$order);
11506: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
11507: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
11508: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
11509: $order = $domdefaults{'inststatus'}{'inststatusorder'};
11510: } else {
11511: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
11512: }
1.642 raeburn 11513: my $othertitle = &mt('All users');
11514: if ($env{'request.course.id'}) {
1.668 raeburn 11515: $othertitle = &mt('Any users');
1.642 raeburn 11516: }
11517: my @types;
11518: if (ref($order) eq 'ARRAY') {
11519: @types = @{$order};
11520: }
11521: if (@types == 0) {
11522: if (ref($usertypes) eq 'HASH') {
11523: @types = sort(keys(%{$usertypes}));
11524: }
11525: }
11526: if (keys(%{$usertypes}) > 0) {
11527: $othertitle = &mt('Other users');
11528: }
11529: return ($othertitle,$usertypes,\@types);
11530: }
11531:
1.645 raeburn 11532: sub get_institutional_codes {
1.1361 raeburn 11533: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 11534: # Get complete list of course sections to update
11535: my @currsections = ();
11536: my @currxlists = ();
1.1361 raeburn 11537: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 11538: my $coursecode = $$settings{'internal.coursecode'};
1.1361 raeburn 11539: my $crskey = $crs.':'.$coursecode;
11540: @{$unclutteredsec{$crskey}} = ();
11541: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 11542:
11543: if ($$settings{'internal.sectionnums'} ne '') {
11544: @currsections = split(/,/,$$settings{'internal.sectionnums'});
11545: }
11546:
11547: if ($$settings{'internal.crosslistings'} ne '') {
11548: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
11549: }
11550:
11551: if (@currxlists > 0) {
1.1361 raeburn 11552: foreach my $xl (@currxlists) {
11553: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 11554: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 11555: push(@{$allcourses},$1);
1.645 raeburn 11556: $$LC_code{$1} = $2;
11557: }
11558: }
11559: }
11560: }
1.1361 raeburn 11561:
1.645 raeburn 11562: if (@currsections > 0) {
1.1361 raeburn 11563: foreach my $sec (@currsections) {
11564: if ($sec =~ m/^(\w+):(\w*)$/ ) {
11565: my $instsec = $1;
1.645 raeburn 11566: my $lc_sec = $2;
1.1361 raeburn 11567: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
11568: push(@{$unclutteredsec{$crskey}},$instsec);
11569: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
11570: }
11571: }
11572: }
11573: }
11574:
11575: if (@{$unclutteredsec{$crskey}} > 0) {
11576: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
11577: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
11578: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
11579: my $sec = $coursecode.$formattedsec{$crskey}[$i];
11580: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1263 raeburn 11581: push(@{$allcourses},$sec);
1.1361 raeburn 11582: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 11583: }
11584: }
11585: }
11586: }
11587: return;
11588: }
11589:
1.971 raeburn 11590: sub get_standard_codeitems {
11591: return ('Year','Semester','Department','Number','Section');
11592: }
11593:
1.112 bowersj2 11594: =pod
11595:
1.780 raeburn 11596: =head1 Slot Helpers
11597:
11598: =over 4
11599:
11600: =item * sorted_slots()
11601:
1.1040 raeburn 11602: Sorts an array of slot names in order of an optional sort key,
11603: default sort is by slot start time (earliest first).
1.780 raeburn 11604:
11605: Inputs:
11606:
11607: =over 4
11608:
11609: slotsarr - Reference to array of unsorted slot names.
11610:
11611: slots - Reference to hash of hash, where outer hash keys are slot names.
11612:
1.1040 raeburn 11613: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
11614:
1.549 albertel 11615: =back
11616:
1.780 raeburn 11617: Returns:
11618:
11619: =over 4
11620:
1.1040 raeburn 11621: sorted - An array of slot names sorted by a specified sort key
11622: (default sort key is start time of the slot).
1.780 raeburn 11623:
11624: =back
11625:
11626: =cut
11627:
11628:
11629: sub sorted_slots {
1.1040 raeburn 11630: my ($slotsarr,$slots,$sortkey) = @_;
11631: if ($sortkey eq '') {
11632: $sortkey = 'starttime';
11633: }
1.780 raeburn 11634: my @sorted;
11635: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
11636: @sorted =
11637: sort {
11638: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 11639: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 11640: }
11641: if (ref($slots->{$a})) { return -1;}
11642: if (ref($slots->{$b})) { return 1;}
11643: return 0;
11644: } @{$slotsarr};
11645: }
11646: return @sorted;
11647: }
11648:
1.1040 raeburn 11649: =pod
11650:
11651: =item * get_future_slots()
11652:
11653: Inputs:
11654:
11655: =over 4
11656:
11657: cnum - course number
11658:
11659: cdom - course domain
11660:
11661: now - current UNIX time
11662:
11663: symb - optional symb
11664:
11665: =back
11666:
11667: Returns:
11668:
11669: =over 4
11670:
11671: sorted_reservable - ref to array of student_schedulable slots currently
11672: reservable, ordered by end date of reservation period.
11673:
11674: reservable_now - ref to hash of student_schedulable slots currently
11675: reservable.
11676:
11677: Keys in inner hash are:
11678: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 11679: (b) endreserve: end date of reservation period.
11680: (c) uniqueperiod: start,end dates when slot is to be uniquely
11681: selected.
1.1040 raeburn 11682:
11683: sorted_future - ref to array of student_schedulable slots reservable in
11684: the future, ordered by start date of reservation period.
11685:
11686: future_reservable - ref to hash of student_schedulable slots reservable
11687: in the future.
11688:
11689: Keys in inner hash are:
11690: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 11691: (b) startreserve: start date of reservation period.
11692: (c) uniqueperiod: start,end dates when slot is to be uniquely
11693: selected.
1.1040 raeburn 11694:
11695: =back
11696:
11697: =cut
11698:
11699: sub get_future_slots {
11700: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 11701: my $map;
11702: if ($symb) {
11703: ($map) = &Apache::lonnet::decode_symb($symb);
11704: }
1.1040 raeburn 11705: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
11706: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
11707: foreach my $slot (keys(%slots)) {
11708: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
11709: if ($symb) {
1.1229 raeburn 11710: if ($slots{$slot}->{'symb'} ne '') {
11711: my $canuse;
11712: my %oksymbs;
11713: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
11714: map { $oksymbs{$_} = 1; } @slotsymbs;
11715: if ($oksymbs{$symb}) {
11716: $canuse = 1;
11717: } else {
11718: foreach my $item (@slotsymbs) {
11719: if ($item =~ /\.(page|sequence)$/) {
11720: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
11721: if (($map ne '') && ($map eq $sloturl)) {
11722: $canuse = 1;
11723: last;
11724: }
11725: }
11726: }
11727: }
11728: next unless ($canuse);
11729: }
1.1040 raeburn 11730: }
11731: if (($slots{$slot}->{'starttime'} > $now) &&
11732: ($slots{$slot}->{'endtime'} > $now)) {
11733: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
11734: my $userallowed = 0;
11735: if ($slots{$slot}->{'allowedsections'}) {
11736: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
11737: if (!defined($env{'request.role.sec'})
11738: && grep(/^No section assigned$/,@allowed_sec)) {
11739: $userallowed=1;
11740: } else {
11741: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
11742: $userallowed=1;
11743: }
11744: }
11745: unless ($userallowed) {
11746: if (defined($env{'request.course.groups'})) {
11747: my @groups = split(/:/,$env{'request.course.groups'});
11748: foreach my $group (@groups) {
11749: if (grep(/^\Q$group\E$/,@allowed_sec)) {
11750: $userallowed=1;
11751: last;
11752: }
11753: }
11754: }
11755: }
11756: }
11757: if ($slots{$slot}->{'allowedusers'}) {
11758: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
11759: my $user = $env{'user.name'}.':'.$env{'user.domain'};
11760: if (grep(/^\Q$user\E$/,@allowed_users)) {
11761: $userallowed = 1;
11762: }
11763: }
11764: next unless($userallowed);
11765: }
11766: my $startreserve = $slots{$slot}->{'startreserve'};
11767: my $endreserve = $slots{$slot}->{'endreserve'};
11768: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 11769: my $uniqueperiod;
11770: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
11771: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
11772: }
1.1040 raeburn 11773: if (($startreserve < $now) &&
11774: (!$endreserve || $endreserve > $now)) {
11775: my $lastres = $endreserve;
11776: if (!$lastres) {
11777: $lastres = $slots{$slot}->{'starttime'};
11778: }
11779: $reservable_now{$slot} = {
11780: symb => $symb,
1.1250 raeburn 11781: endreserve => $lastres,
11782: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11783: };
11784: } elsif (($startreserve > $now) &&
11785: (!$endreserve || $endreserve > $startreserve)) {
11786: $future_reservable{$slot} = {
11787: symb => $symb,
1.1250 raeburn 11788: startreserve => $startreserve,
11789: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11790: };
11791: }
11792: }
11793: }
11794: my @unsorted_reservable = keys(%reservable_now);
11795: if (@unsorted_reservable > 0) {
11796: @sorted_reservable =
11797: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
11798: }
11799: my @unsorted_future = keys(%future_reservable);
11800: if (@unsorted_future > 0) {
11801: @sorted_future =
11802: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
11803: }
11804: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
11805: }
1.780 raeburn 11806:
11807: =pod
11808:
1.1057 foxr 11809: =back
11810:
1.549 albertel 11811: =head1 HTTP Helpers
11812:
11813: =over 4
11814:
1.648 raeburn 11815: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 11816:
1.258 albertel 11817: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 11818: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 11819: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 11820:
11821: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
11822: $possible_names is an ref to an array of form element names. As an example:
11823: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 11824: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 11825:
11826: =cut
1.1 albertel 11827:
1.6 albertel 11828: sub get_unprocessed_cgi {
1.25 albertel 11829: my ($query,$possible_names)= @_;
1.26 matthew 11830: # $Apache::lonxml::debug=1;
1.356 albertel 11831: foreach my $pair (split(/&/,$query)) {
11832: my ($name, $value) = split(/=/,$pair);
1.369 www 11833: $name = &unescape($name);
1.25 albertel 11834: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
11835: $value =~ tr/+/ /;
11836: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 11837: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 11838: }
1.16 harris41 11839: }
1.6 albertel 11840: }
11841:
1.112 bowersj2 11842: =pod
11843:
1.648 raeburn 11844: =item * &cacheheader()
1.112 bowersj2 11845:
11846: returns cache-controlling header code
11847:
11848: =cut
11849:
1.7 albertel 11850: sub cacheheader {
1.258 albertel 11851: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 11852: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
11853: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 11854: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
11855: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 11856: return $output;
1.7 albertel 11857: }
11858:
1.112 bowersj2 11859: =pod
11860:
1.648 raeburn 11861: =item * &no_cache($r)
1.112 bowersj2 11862:
11863: specifies header code to not have cache
11864:
11865: =cut
11866:
1.9 albertel 11867: sub no_cache {
1.216 albertel 11868: my ($r) = @_;
11869: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 11870: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 11871: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
11872: $r->no_cache(1);
11873: $r->header_out("Expires" => $date);
11874: $r->header_out("Pragma" => "no-cache");
1.123 www 11875: }
11876:
11877: sub content_type {
1.181 albertel 11878: my ($r,$type,$charset) = @_;
1.299 foxr 11879: if ($r) {
11880: # Note that printout.pl calls this with undef for $r.
11881: &no_cache($r);
11882: }
1.258 albertel 11883: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 11884: unless ($charset) {
11885: $charset=&Apache::lonlocal::current_encoding;
11886: }
11887: if ($charset) { $type.='; charset='.$charset; }
11888: if ($r) {
11889: $r->content_type($type);
11890: } else {
11891: print("Content-type: $type\n\n");
11892: }
1.9 albertel 11893: }
1.25 albertel 11894:
1.112 bowersj2 11895: =pod
11896:
1.648 raeburn 11897: =item * &add_to_env($name,$value)
1.112 bowersj2 11898:
1.258 albertel 11899: adds $name to the %env hash with value
1.112 bowersj2 11900: $value, if $name already exists, the entry is converted to an array
11901: reference and $value is added to the array.
11902:
11903: =cut
11904:
1.25 albertel 11905: sub add_to_env {
11906: my ($name,$value)=@_;
1.258 albertel 11907: if (defined($env{$name})) {
11908: if (ref($env{$name})) {
1.25 albertel 11909: #already have multiple values
1.258 albertel 11910: push(@{ $env{$name} },$value);
1.25 albertel 11911: } else {
11912: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 11913: my $first=$env{$name};
11914: undef($env{$name});
11915: push(@{ $env{$name} },$first,$value);
1.25 albertel 11916: }
11917: } else {
1.258 albertel 11918: $env{$name}=$value;
1.25 albertel 11919: }
1.31 albertel 11920: }
1.149 albertel 11921:
11922: =pod
11923:
1.648 raeburn 11924: =item * &get_env_multiple($name)
1.149 albertel 11925:
1.258 albertel 11926: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 11927: values may be defined and end up as an array ref.
11928:
11929: returns an array of values
11930:
11931: =cut
11932:
11933: sub get_env_multiple {
11934: my ($name) = @_;
11935: my @values;
1.258 albertel 11936: if (defined($env{$name})) {
1.149 albertel 11937: # exists is it an array
1.258 albertel 11938: if (ref($env{$name})) {
11939: @values=@{ $env{$name} };
1.149 albertel 11940: } else {
1.258 albertel 11941: $values[0]=$env{$name};
1.149 albertel 11942: }
11943: }
11944: return(@values);
11945: }
11946:
1.1249 damieng 11947: # Looks at given dependencies, and returns something depending on the context.
11948: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
11949: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
11950: # For all other contexts, returns ($output, $counter, $numpathchg).
11951: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
11952: # $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.
11953: # $numpathchg: integer with the number of cleaned up dependency paths.
11954: # \%existing: hash reference clean path -> 1 only for existing dependencies.
11955: # \%mapping: hash reference clean path -> original path for all dependencies.
11956: # @param {string} actionurl - The path to the handler, indicative of the context.
11957: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
11958: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
11959: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
11960: # @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)
11961: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 11962: sub ask_for_embedded_content {
1.1249 damieng 11963: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 11964: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 11965: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 11966: %currsubfile,%unused,$rem);
1.1071 raeburn 11967: my $counter = 0;
11968: my $numnew = 0;
1.987 raeburn 11969: my $numremref = 0;
11970: my $numinvalid = 0;
11971: my $numpathchg = 0;
11972: my $numexisting = 0;
1.1071 raeburn 11973: my $numunused = 0;
11974: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 11975: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 11976: my $heading = &mt('Upload embedded files');
11977: my $buttontext = &mt('Upload');
11978:
1.1249 damieng 11979: # fills these variables based on the context:
11980: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
11981: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 11982: if ($env{'request.course.id'}) {
1.1123 raeburn 11983: if ($actionurl eq '/adm/dependencies') {
11984: $navmap = Apache::lonnavmaps::navmap->new();
11985: }
11986: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
11987: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 11988: }
1.1123 raeburn 11989: if (($actionurl eq '/adm/portfolio') ||
11990: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 11991: my $current_path='/';
11992: if ($env{'form.currentpath'}) {
11993: $current_path = $env{'form.currentpath'};
11994: }
11995: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 11996: $udom = $cdom;
11997: $uname = $cnum;
1.984 raeburn 11998: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
11999: } else {
12000: $udom = $env{'user.domain'};
12001: $uname = $env{'user.name'};
12002: $url = '/userfiles/portfolio';
12003: }
1.987 raeburn 12004: $toplevel = $url.'/';
1.984 raeburn 12005: $url .= $current_path;
12006: $getpropath = 1;
1.987 raeburn 12007: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12008: ($actionurl eq '/adm/imsimport')) {
1.1022 www 12009: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 12010: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 12011: $toplevel = $url;
1.984 raeburn 12012: if ($rest ne '') {
1.987 raeburn 12013: $url .= $rest;
12014: }
12015: } elsif ($actionurl eq '/adm/coursedocs') {
12016: if (ref($args) eq 'HASH') {
1.1071 raeburn 12017: $url = $args->{'docs_url'};
12018: $toplevel = $url;
1.1084 raeburn 12019: if ($args->{'context'} eq 'paste') {
12020: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
12021: ($path) =
12022: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12023: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12024: $fileloc =~ s{^/}{};
12025: }
1.1071 raeburn 12026: }
1.1084 raeburn 12027: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 12028: if ($env{'request.course.id'} ne '') {
12029: if (ref($args) eq 'HASH') {
12030: $url = $args->{'docs_url'};
12031: $title = $args->{'docs_title'};
1.1126 raeburn 12032: $toplevel = $url;
12033: unless ($toplevel =~ m{^/}) {
12034: $toplevel = "/$url";
12035: }
1.1085 raeburn 12036: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 12037: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
12038: $path = $1;
12039: } else {
12040: ($path) =
12041: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12042: }
1.1195 raeburn 12043: if ($toplevel=~/^\/*(uploaded|editupload)/) {
12044: $fileloc = $toplevel;
12045: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
12046: my ($udom,$uname,$fname) =
12047: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
12048: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
12049: } else {
12050: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12051: }
1.1071 raeburn 12052: $fileloc =~ s{^/}{};
12053: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
12054: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
12055: }
1.987 raeburn 12056: }
1.1123 raeburn 12057: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12058: $udom = $cdom;
12059: $uname = $cnum;
12060: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
12061: $toplevel = $url;
12062: $path = $url;
12063: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
12064: $fileloc =~ s{^/}{};
1.987 raeburn 12065: }
1.1249 damieng 12066:
12067: # parses the dependency paths to get some info
12068: # fills $newfiles, $mapping, $subdependencies, $dependencies
12069: # $newfiles: hash URL -> 1 for new files or external URLs
12070: # (will be completed later)
12071: # $mapping:
12072: # for external URLs: external URL -> external URL
12073: # for relative paths: clean path -> original path
12074: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
12075: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 12076: foreach my $file (keys(%{$allfiles})) {
12077: my $embed_file;
12078: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
12079: $embed_file = $1;
12080: } else {
12081: $embed_file = $file;
12082: }
1.1158 raeburn 12083: my ($absolutepath,$cleaned_file);
12084: if ($embed_file =~ m{^\w+://}) {
12085: $cleaned_file = $embed_file;
1.1147 raeburn 12086: $newfiles{$cleaned_file} = 1;
12087: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12088: } else {
1.1158 raeburn 12089: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 12090: if ($embed_file =~ m{^/}) {
12091: $absolutepath = $embed_file;
12092: }
1.1147 raeburn 12093: if ($cleaned_file =~ m{/}) {
12094: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 12095: $path = &check_for_traversal($path,$url,$toplevel);
12096: my $item = $fname;
12097: if ($path ne '') {
12098: $item = $path.'/'.$fname;
12099: $subdependencies{$path}{$fname} = 1;
12100: } else {
12101: $dependencies{$item} = 1;
12102: }
12103: if ($absolutepath) {
12104: $mapping{$item} = $absolutepath;
12105: } else {
12106: $mapping{$item} = $embed_file;
12107: }
12108: } else {
12109: $dependencies{$embed_file} = 1;
12110: if ($absolutepath) {
1.1147 raeburn 12111: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 12112: } else {
1.1147 raeburn 12113: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12114: }
12115: }
1.984 raeburn 12116: }
12117: }
1.1249 damieng 12118:
12119: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
12120: # and lists
12121: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
12122: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
12123: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
12124: # the path had to be cleaned up
12125: # $existing: hash clean path -> 1 if the file exists
12126: # $numexisting: number of keys in $existing
12127: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
12128: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
12129: # dependency subdirectories that are
12130: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 12131: my $dirptr = 16384;
1.984 raeburn 12132: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 12133: $currsubfile{$path} = {};
1.1123 raeburn 12134: if (($actionurl eq '/adm/portfolio') ||
12135: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12136: my ($sublistref,$listerror) =
12137: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
12138: if (ref($sublistref) eq 'ARRAY') {
12139: foreach my $line (@{$sublistref}) {
12140: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 12141: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 12142: }
1.984 raeburn 12143: }
1.987 raeburn 12144: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12145: if (opendir(my $dir,$url.'/'.$path)) {
12146: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 12147: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
12148: }
1.1084 raeburn 12149: } elsif (($actionurl eq '/adm/dependencies') ||
12150: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12151: ($args->{'context'} eq 'paste')) ||
12152: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12153: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 12154: my $dir;
12155: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12156: $dir = $fileloc;
12157: } else {
12158: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12159: }
1.1071 raeburn 12160: if ($dir ne '') {
12161: my ($sublistref,$listerror) =
12162: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
12163: if (ref($sublistref) eq 'ARRAY') {
12164: foreach my $line (@{$sublistref}) {
12165: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
12166: undef,$mtime)=split(/\&/,$line,12);
12167: unless (($testdir&$dirptr) ||
12168: ($file_name =~ /^\.\.?$/)) {
12169: $currsubfile{$path}{$file_name} = [$size,$mtime];
12170: }
12171: }
12172: }
12173: }
1.984 raeburn 12174: }
12175: }
12176: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 12177: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 12178: my $item = $path.'/'.$file;
12179: unless ($mapping{$item} eq $item) {
12180: $pathchanges{$item} = 1;
12181: }
12182: $existing{$item} = 1;
12183: $numexisting ++;
12184: } else {
12185: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 12186: }
12187: }
1.1071 raeburn 12188: if ($actionurl eq '/adm/dependencies') {
12189: foreach my $path (keys(%currsubfile)) {
12190: if (ref($currsubfile{$path}) eq 'HASH') {
12191: foreach my $file (keys(%{$currsubfile{$path}})) {
12192: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 12193: next if (($rem ne '') &&
12194: (($env{"httpref.$rem"."$path/$file"} ne '') ||
12195: (ref($navmap) &&
12196: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
12197: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12198: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 12199: $unused{$path.'/'.$file} = 1;
12200: }
12201: }
12202: }
12203: }
12204: }
1.984 raeburn 12205: }
1.1249 damieng 12206:
12207: # fills $currfile, hash file name -> 1 or [$size,$mtime]
12208: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 12209: my %currfile;
1.1123 raeburn 12210: if (($actionurl eq '/adm/portfolio') ||
12211: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12212: my ($dirlistref,$listerror) =
12213: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
12214: if (ref($dirlistref) eq 'ARRAY') {
12215: foreach my $line (@{$dirlistref}) {
12216: my ($file_name,$rest) = split(/\&/,$line,2);
12217: $currfile{$file_name} = 1;
12218: }
1.984 raeburn 12219: }
1.987 raeburn 12220: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12221: if (opendir(my $dir,$url)) {
1.987 raeburn 12222: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 12223: map {$currfile{$_} = 1;} @dir_list;
12224: }
1.1084 raeburn 12225: } elsif (($actionurl eq '/adm/dependencies') ||
12226: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12227: ($args->{'context'} eq 'paste')) ||
12228: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12229: if ($env{'request.course.id'} ne '') {
12230: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12231: if ($dir ne '') {
12232: my ($dirlistref,$listerror) =
12233: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
12234: if (ref($dirlistref) eq 'ARRAY') {
12235: foreach my $line (@{$dirlistref}) {
12236: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
12237: $size,undef,$mtime)=split(/\&/,$line,12);
12238: unless (($testdir&$dirptr) ||
12239: ($file_name =~ /^\.\.?$/)) {
12240: $currfile{$file_name} = [$size,$mtime];
12241: }
12242: }
12243: }
12244: }
12245: }
1.984 raeburn 12246: }
1.1249 damieng 12247: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
12248: # are not in subdirectories, using $currfile
1.984 raeburn 12249: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 12250: if (exists($currfile{$file})) {
1.987 raeburn 12251: unless ($mapping{$file} eq $file) {
12252: $pathchanges{$file} = 1;
12253: }
12254: $existing{$file} = 1;
12255: $numexisting ++;
12256: } else {
1.984 raeburn 12257: $newfiles{$file} = 1;
12258: }
12259: }
1.1071 raeburn 12260: foreach my $file (keys(%currfile)) {
12261: unless (($file eq $filename) ||
12262: ($file eq $filename.'.bak') ||
12263: ($dependencies{$file})) {
1.1085 raeburn 12264: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 12265: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
12266: next if (($rem ne '') &&
12267: (($env{"httpref.$rem".$file} ne '') ||
12268: (ref($navmap) &&
12269: (($navmap->getResourceByUrl($rem.$file) ne '') ||
12270: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12271: ($navmap->getResourceByUrl($rem.$1)))))));
12272: }
1.1085 raeburn 12273: }
1.1071 raeburn 12274: $unused{$file} = 1;
12275: }
12276: }
1.1249 damieng 12277:
12278: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 12279: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
12280: ($args->{'context'} eq 'paste')) {
12281: $counter = scalar(keys(%existing));
12282: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 12283: return ($output,$counter,$numpathchg,\%existing);
12284: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
12285: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
12286: $counter = scalar(keys(%existing));
12287: $numpathchg = scalar(keys(%pathchanges));
12288: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 12289: }
1.1249 damieng 12290:
12291: # returns HTML otherwise, with dependency results and to ask for more uploads
12292:
12293: # $upload_output: missing dependencies (with upload form)
12294: # $modify_output: uploaded dependencies (in use)
12295: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 12296: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 12297: if ($actionurl eq '/adm/dependencies') {
12298: next if ($embed_file =~ m{^\w+://});
12299: }
1.660 raeburn 12300: $upload_output .= &start_data_table_row().
1.1123 raeburn 12301: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 12302: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 12303: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 12304: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
12305: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 12306: }
1.1123 raeburn 12307: $upload_output .= '</td>';
1.1071 raeburn 12308: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 12309: $upload_output.='<td align="right">'.
12310: '<span class="LC_info LC_fontsize_medium">'.
12311: &mt("URL points to web address").'</span>';
1.987 raeburn 12312: $numremref++;
1.660 raeburn 12313: } elsif ($args->{'error_on_invalid_names'}
12314: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 12315: $upload_output.='<td align="right"><span class="LC_warning">'.
12316: &mt('Invalid characters').'</span>';
1.987 raeburn 12317: $numinvalid++;
1.660 raeburn 12318: } else {
1.1123 raeburn 12319: $upload_output .= '<td>'.
12320: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 12321: $embed_file,\%mapping,
1.1071 raeburn 12322: $allfiles,$codebase,'upload');
12323: $counter ++;
12324: $numnew ++;
1.987 raeburn 12325: }
12326: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
12327: }
12328: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 12329: if ($actionurl eq '/adm/dependencies') {
12330: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
12331: $modify_output .= &start_data_table_row().
12332: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
12333: '<img src="'.&icon($embed_file).'" border="0" />'.
12334: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
12335: '<td>'.$size.'</td>'.
12336: '<td>'.$mtime.'</td>'.
12337: '<td><label><input type="checkbox" name="mod_upload_dep" '.
12338: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
12339: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
12340: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
12341: &embedded_file_element('upload_embedded',$counter,
12342: $embed_file,\%mapping,
12343: $allfiles,$codebase,'modify').
12344: '</div></td>'.
12345: &end_data_table_row()."\n";
12346: $counter ++;
12347: } else {
12348: $upload_output .= &start_data_table_row().
1.1123 raeburn 12349: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
12350: '<span class="LC_filename">'.$embed_file.'</span></td>'.
12351: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 12352: &Apache::loncommon::end_data_table_row()."\n";
12353: }
12354: }
12355: my $delidx = $counter;
12356: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
12357: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
12358: $delete_output .= &start_data_table_row().
12359: '<td><img src="'.&icon($oldfile).'" />'.
12360: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
12361: '<td>'.$size.'</td>'.
12362: '<td>'.$mtime.'</td>'.
12363: '<td><label><input type="checkbox" name="del_upload_dep" '.
12364: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
12365: &embedded_file_element('upload_embedded',$delidx,
12366: $oldfile,\%mapping,$allfiles,
12367: $codebase,'delete').'</td>'.
12368: &end_data_table_row()."\n";
12369: $numunused ++;
12370: $delidx ++;
1.987 raeburn 12371: }
12372: if ($upload_output) {
12373: $upload_output = &start_data_table().
12374: $upload_output.
12375: &end_data_table()."\n";
12376: }
1.1071 raeburn 12377: if ($modify_output) {
12378: $modify_output = &start_data_table().
12379: &start_data_table_header_row().
12380: '<th>'.&mt('File').'</th>'.
12381: '<th>'.&mt('Size (KB)').'</th>'.
12382: '<th>'.&mt('Modified').'</th>'.
12383: '<th>'.&mt('Upload replacement?').'</th>'.
12384: &end_data_table_header_row().
12385: $modify_output.
12386: &end_data_table()."\n";
12387: }
12388: if ($delete_output) {
12389: $delete_output = &start_data_table().
12390: &start_data_table_header_row().
12391: '<th>'.&mt('File').'</th>'.
12392: '<th>'.&mt('Size (KB)').'</th>'.
12393: '<th>'.&mt('Modified').'</th>'.
12394: '<th>'.&mt('Delete?').'</th>'.
12395: &end_data_table_header_row().
12396: $delete_output.
12397: &end_data_table()."\n";
12398: }
1.987 raeburn 12399: my $applies = 0;
12400: if ($numremref) {
12401: $applies ++;
12402: }
12403: if ($numinvalid) {
12404: $applies ++;
12405: }
12406: if ($numexisting) {
12407: $applies ++;
12408: }
1.1071 raeburn 12409: if ($counter || $numunused) {
1.987 raeburn 12410: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
12411: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 12412: $state.'<h3>'.$heading.'</h3>';
12413: if ($actionurl eq '/adm/dependencies') {
12414: if ($numnew) {
12415: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
12416: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
12417: $upload_output.'<br />'."\n";
12418: }
12419: if ($numexisting) {
12420: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
12421: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
12422: $modify_output.'<br />'."\n";
12423: $buttontext = &mt('Save changes');
12424: }
12425: if ($numunused) {
12426: $output .= '<h4>'.&mt('Unused files').'</h4>'.
12427: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
12428: $delete_output.'<br />'."\n";
12429: $buttontext = &mt('Save changes');
12430: }
12431: } else {
12432: $output .= $upload_output.'<br />'."\n";
12433: }
12434: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
12435: $counter.'" />'."\n";
12436: if ($actionurl eq '/adm/dependencies') {
12437: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
12438: $numnew.'" />'."\n";
12439: } elsif ($actionurl eq '') {
1.987 raeburn 12440: $output .= '<input type="hidden" name="phase" value="three" />';
12441: }
12442: } elsif ($applies) {
12443: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
12444: if ($applies > 1) {
12445: $output .=
1.1123 raeburn 12446: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 12447: if ($numremref) {
12448: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
12449: }
12450: if ($numinvalid) {
12451: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
12452: }
12453: if ($numexisting) {
12454: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
12455: }
12456: $output .= '</ul><br />';
12457: } elsif ($numremref) {
12458: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
12459: } elsif ($numinvalid) {
12460: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
12461: } elsif ($numexisting) {
12462: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
12463: }
12464: $output .= $upload_output.'<br />';
12465: }
12466: my ($pathchange_output,$chgcount);
1.1071 raeburn 12467: $chgcount = $counter;
1.987 raeburn 12468: if (keys(%pathchanges) > 0) {
12469: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 12470: if ($counter) {
1.987 raeburn 12471: $output .= &embedded_file_element('pathchange',$chgcount,
12472: $embed_file,\%mapping,
1.1071 raeburn 12473: $allfiles,$codebase,'change');
1.987 raeburn 12474: } else {
12475: $pathchange_output .=
12476: &start_data_table_row().
12477: '<td><input type ="checkbox" name="namechange" value="'.
12478: $chgcount.'" checked="checked" /></td>'.
12479: '<td>'.$mapping{$embed_file}.'</td>'.
12480: '<td>'.$embed_file.
12481: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 12482: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 12483: '</td>'.&end_data_table_row();
1.660 raeburn 12484: }
1.987 raeburn 12485: $numpathchg ++;
12486: $chgcount ++;
1.660 raeburn 12487: }
12488: }
1.1127 raeburn 12489: if (($counter) || ($numunused)) {
1.987 raeburn 12490: if ($numpathchg) {
12491: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
12492: $numpathchg.'" />'."\n";
12493: }
12494: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12495: ($actionurl eq '/adm/imsimport')) {
12496: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
12497: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
12498: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 12499: } elsif ($actionurl eq '/adm/dependencies') {
12500: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 12501: }
1.1123 raeburn 12502: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 12503: } elsif ($numpathchg) {
12504: my %pathchange = ();
12505: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
12506: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12507: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 12508: }
1.987 raeburn 12509: }
1.1071 raeburn 12510: return ($output,$counter,$numpathchg);
1.987 raeburn 12511: }
12512:
1.1147 raeburn 12513: =pod
12514:
12515: =item * clean_path($name)
12516:
12517: Performs clean-up of directories, subdirectories and filename in an
12518: embedded object, referenced in an HTML file which is being uploaded
12519: to a course or portfolio, where
12520: "Upload embedded images/multimedia files if HTML file" checkbox was
12521: checked.
12522:
12523: Clean-up is similar to replacements in lonnet::clean_filename()
12524: except each / between sub-directory and next level is preserved.
12525:
12526: =cut
12527:
12528: sub clean_path {
12529: my ($embed_file) = @_;
12530: $embed_file =~s{^/+}{};
12531: my @contents;
12532: if ($embed_file =~ m{/}) {
12533: @contents = split(/\//,$embed_file);
12534: } else {
12535: @contents = ($embed_file);
12536: }
12537: my $lastidx = scalar(@contents)-1;
12538: for (my $i=0; $i<=$lastidx; $i++) {
12539: $contents[$i]=~s{\\}{/}g;
12540: $contents[$i]=~s/\s+/\_/g;
12541: $contents[$i]=~s{[^/\w\.\-]}{}g;
12542: if ($i == $lastidx) {
12543: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
12544: }
12545: }
12546: if ($lastidx > 0) {
12547: return join('/',@contents);
12548: } else {
12549: return $contents[0];
12550: }
12551: }
12552:
1.987 raeburn 12553: sub embedded_file_element {
1.1071 raeburn 12554: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 12555: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
12556: (ref($codebase) eq 'HASH'));
12557: my $output;
1.1071 raeburn 12558: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 12559: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
12560: }
12561: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
12562: &escape($embed_file).'" />';
12563: unless (($context eq 'upload_embedded') &&
12564: ($mapping->{$embed_file} eq $embed_file)) {
12565: $output .='
12566: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
12567: }
12568: my $attrib;
12569: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
12570: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
12571: }
12572: $output .=
12573: "\n\t\t".
12574: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
12575: $attrib.'" />';
12576: if (exists($codebase->{$mapping->{$embed_file}})) {
12577: $output .=
12578: "\n\t\t".
12579: '<input name="codebase_'.$num.'" type="hidden" value="'.
12580: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 12581: }
1.987 raeburn 12582: return $output;
1.660 raeburn 12583: }
12584:
1.1071 raeburn 12585: sub get_dependency_details {
12586: my ($currfile,$currsubfile,$embed_file) = @_;
12587: my ($size,$mtime,$showsize,$showmtime);
12588: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
12589: if ($embed_file =~ m{/}) {
12590: my ($path,$fname) = split(/\//,$embed_file);
12591: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
12592: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
12593: }
12594: } else {
12595: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
12596: ($size,$mtime) = @{$currfile->{$embed_file}};
12597: }
12598: }
12599: $showsize = $size/1024.0;
12600: $showsize = sprintf("%.1f",$showsize);
12601: if ($mtime > 0) {
12602: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
12603: }
12604: }
12605: return ($showsize,$showmtime);
12606: }
12607:
12608: sub ask_embedded_js {
12609: return <<"END";
12610: <script type="text/javascript"">
12611: // <![CDATA[
12612: function toggleBrowse(counter) {
12613: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
12614: var fileid = document.getElementById('embedded_item_'+counter);
12615: var uploaddivid = document.getElementById('moduploaddep_'+counter);
12616: if (chkboxid.checked == true) {
12617: uploaddivid.style.display='block';
12618: } else {
12619: uploaddivid.style.display='none';
12620: fileid.value = '';
12621: }
12622: }
12623: // ]]>
12624: </script>
12625:
12626: END
12627: }
12628:
1.661 raeburn 12629: sub upload_embedded {
12630: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 12631: $current_disk_usage,$hiddenstate,$actionurl) = @_;
12632: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 12633: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
12634: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
12635: my $orig_uploaded_filename =
12636: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 12637: foreach my $type ('orig','ref','attrib','codebase') {
12638: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
12639: $env{'form.embedded_'.$type.'_'.$i} =
12640: &unescape($env{'form.embedded_'.$type.'_'.$i});
12641: }
12642: }
1.661 raeburn 12643: my ($path,$fname) =
12644: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
12645: # no path, whole string is fname
12646: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
12647: $fname = &Apache::lonnet::clean_filename($fname);
12648: # See if there is anything left
12649: next if ($fname eq '');
12650:
12651: # Check if file already exists as a file or directory.
12652: my ($state,$msg);
12653: if ($context eq 'portfolio') {
12654: my $port_path = $dirpath;
12655: if ($group ne '') {
12656: $port_path = "groups/$group/$port_path";
12657: }
1.987 raeburn 12658: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
12659: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 12660: $dir_root,$port_path,$disk_quota,
12661: $current_disk_usage,$uname,$udom);
12662: if ($state eq 'will_exceed_quota'
1.984 raeburn 12663: || $state eq 'file_locked') {
1.661 raeburn 12664: $output .= $msg;
12665: next;
12666: }
12667: } elsif (($context eq 'author') || ($context eq 'testbank')) {
12668: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
12669: if ($state eq 'exists') {
12670: $output .= $msg;
12671: next;
12672: }
12673: }
12674: # Check if extension is valid
12675: if (($fname =~ /\.(\w+)$/) &&
12676: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 12677: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
12678: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 12679: next;
12680: } elsif (($fname =~ /\.(\w+)$/) &&
12681: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 12682: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 12683: next;
12684: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 12685: $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 12686: next;
12687: }
12688: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 12689: my $subdir = $path;
12690: $subdir =~ s{/+$}{};
1.661 raeburn 12691: if ($context eq 'portfolio') {
1.984 raeburn 12692: my $result;
12693: if ($state eq 'existingfile') {
12694: $result=
12695: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 12696: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 12697: } else {
1.984 raeburn 12698: $result=
12699: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 12700: $dirpath.
1.1123 raeburn 12701: $env{'form.currentpath'}.$subdir);
1.984 raeburn 12702: if ($result !~ m|^/uploaded/|) {
12703: $output .= '<span class="LC_error">'
12704: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12705: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12706: .'</span><br />';
12707: next;
12708: } else {
1.987 raeburn 12709: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12710: $path.$fname.'</span>').'<br />';
1.984 raeburn 12711: }
1.661 raeburn 12712: }
1.1123 raeburn 12713: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 12714: my $extendedsubdir = $dirpath.'/'.$subdir;
12715: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 12716: my $result =
1.1126 raeburn 12717: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 12718: if ($result !~ m|^/uploaded/|) {
12719: $output .= '<span class="LC_error">'
12720: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12721: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12722: .'</span><br />';
12723: next;
12724: } else {
12725: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12726: $path.$fname.'</span>').'<br />';
1.1125 raeburn 12727: if ($context eq 'syllabus') {
12728: &Apache::lonnet::make_public_indefinitely($result);
12729: }
1.987 raeburn 12730: }
1.661 raeburn 12731: } else {
12732: # Save the file
12733: my $target = $env{'form.embedded_item_'.$i};
12734: my $fullpath = $dir_root.$dirpath.'/'.$path;
12735: my $dest = $fullpath.$fname;
12736: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 12737: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 12738: my $count;
12739: my $filepath = $dir_root;
1.1027 raeburn 12740: foreach my $subdir (@parts) {
12741: $filepath .= "/$subdir";
12742: if (!-e $filepath) {
1.661 raeburn 12743: mkdir($filepath,0770);
12744: }
12745: }
12746: my $fh;
12747: if (!open($fh,'>'.$dest)) {
12748: &Apache::lonnet::logthis('Failed to create '.$dest);
12749: $output .= '<span class="LC_error">'.
1.1071 raeburn 12750: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
12751: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12752: '</span><br />';
12753: } else {
12754: if (!print $fh $env{'form.embedded_item_'.$i}) {
12755: &Apache::lonnet::logthis('Failed to write to '.$dest);
12756: $output .= '<span class="LC_error">'.
1.1071 raeburn 12757: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
12758: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12759: '</span><br />';
12760: } else {
1.987 raeburn 12761: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12762: $url.'</span>').'<br />';
12763: unless ($context eq 'testbank') {
12764: $footer .= &mt('View embedded file: [_1]',
12765: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
12766: }
12767: }
12768: close($fh);
12769: }
12770: }
12771: if ($env{'form.embedded_ref_'.$i}) {
12772: $pathchange{$i} = 1;
12773: }
12774: }
12775: if ($output) {
12776: $output = '<p>'.$output.'</p>';
12777: }
12778: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
12779: $returnflag = 'ok';
1.1071 raeburn 12780: my $numpathchgs = scalar(keys(%pathchange));
12781: if ($numpathchgs > 0) {
1.987 raeburn 12782: if ($context eq 'portfolio') {
12783: $output .= '<p>'.&mt('or').'</p>';
12784: } elsif ($context eq 'testbank') {
1.1071 raeburn 12785: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
12786: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 12787: $returnflag = 'modify_orightml';
12788: }
12789: }
1.1071 raeburn 12790: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 12791: }
12792:
12793: sub modify_html_form {
12794: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
12795: my $end = 0;
12796: my $modifyform;
12797: if ($context eq 'upload_embedded') {
12798: return unless (ref($pathchange) eq 'HASH');
12799: if ($env{'form.number_embedded_items'}) {
12800: $end += $env{'form.number_embedded_items'};
12801: }
12802: if ($env{'form.number_pathchange_items'}) {
12803: $end += $env{'form.number_pathchange_items'};
12804: }
12805: if ($end) {
12806: for (my $i=0; $i<$end; $i++) {
12807: if ($i < $env{'form.number_embedded_items'}) {
12808: next unless($pathchange->{$i});
12809: }
12810: $modifyform .=
12811: &start_data_table_row().
12812: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
12813: 'checked="checked" /></td>'.
12814: '<td>'.$env{'form.embedded_ref_'.$i}.
12815: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
12816: &escape($env{'form.embedded_ref_'.$i}).'" />'.
12817: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
12818: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
12819: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
12820: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
12821: '<td>'.$env{'form.embedded_orig_'.$i}.
12822: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
12823: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
12824: &end_data_table_row();
1.1071 raeburn 12825: }
1.987 raeburn 12826: }
12827: } else {
12828: $modifyform = $pathchgtable;
12829: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
12830: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
12831: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12832: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
12833: }
12834: }
12835: if ($modifyform) {
1.1071 raeburn 12836: if ($actionurl eq '/adm/dependencies') {
12837: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
12838: }
1.987 raeburn 12839: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
12840: '<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".
12841: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
12842: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
12843: '</ol></p>'."\n".'<p>'.
12844: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
12845: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
12846: &start_data_table()."\n".
12847: &start_data_table_header_row().
12848: '<th>'.&mt('Change?').'</th>'.
12849: '<th>'.&mt('Current reference').'</th>'.
12850: '<th>'.&mt('Required reference').'</th>'.
12851: &end_data_table_header_row()."\n".
12852: $modifyform.
12853: &end_data_table().'<br />'."\n".$hiddenstate.
12854: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
12855: '</form>'."\n";
12856: }
12857: return;
12858: }
12859:
12860: sub modify_html_refs {
1.1123 raeburn 12861: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 12862: my $container;
12863: if ($context eq 'portfolio') {
12864: $container = $env{'form.container'};
12865: } elsif ($context eq 'coursedoc') {
12866: $container = $env{'form.primaryurl'};
1.1071 raeburn 12867: } elsif ($context eq 'manage_dependencies') {
12868: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
12869: $container = "/$container";
1.1123 raeburn 12870: } elsif ($context eq 'syllabus') {
12871: $container = $url;
1.987 raeburn 12872: } else {
1.1027 raeburn 12873: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 12874: }
12875: my (%allfiles,%codebase,$output,$content);
12876: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 12877: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 12878: if (wantarray) {
12879: return ('',0,0);
12880: } else {
12881: return;
12882: }
12883: }
12884: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12885: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 12886: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
12887: if (wantarray) {
12888: return ('',0,0);
12889: } else {
12890: return;
12891: }
12892: }
1.987 raeburn 12893: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 12894: if ($content eq '-1') {
12895: if (wantarray) {
12896: return ('',0,0);
12897: } else {
12898: return;
12899: }
12900: }
1.987 raeburn 12901: } else {
1.1071 raeburn 12902: unless ($container =~ /^\Q$dir_root\E/) {
12903: if (wantarray) {
12904: return ('',0,0);
12905: } else {
12906: return;
12907: }
12908: }
1.1317 raeburn 12909: if (open(my $fh,'<',$container)) {
1.987 raeburn 12910: $content = join('', <$fh>);
12911: close($fh);
12912: } else {
1.1071 raeburn 12913: if (wantarray) {
12914: return ('',0,0);
12915: } else {
12916: return;
12917: }
1.987 raeburn 12918: }
12919: }
12920: my ($count,$codebasecount) = (0,0);
12921: my $mm = new File::MMagic;
12922: my $mime_type = $mm->checktype_contents($content);
12923: if ($mime_type eq 'text/html') {
12924: my $parse_result =
12925: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
12926: \%codebase,\$content);
12927: if ($parse_result eq 'ok') {
12928: foreach my $i (@changes) {
12929: my $orig = &unescape($env{'form.embedded_orig_'.$i});
12930: my $ref = &unescape($env{'form.embedded_ref_'.$i});
12931: if ($allfiles{$ref}) {
12932: my $newname = $orig;
12933: my ($attrib_regexp,$codebase);
1.1006 raeburn 12934: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 12935: if ($attrib_regexp =~ /:/) {
12936: $attrib_regexp =~ s/\:/|/g;
12937: }
12938: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12939: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12940: $count += $numchg;
1.1123 raeburn 12941: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 12942: delete($allfiles{$ref});
1.987 raeburn 12943: }
12944: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 12945: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 12946: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
12947: $codebasecount ++;
12948: }
12949: }
12950: }
1.1123 raeburn 12951: my $skiprewrites;
1.987 raeburn 12952: if ($count || $codebasecount) {
12953: my $saveresult;
1.1071 raeburn 12954: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 12955: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 12956: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12957: if ($url eq $container) {
12958: my ($fname) = ($container =~ m{/([^/]+)$});
12959: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12960: $count,'<span class="LC_filename">'.
1.1071 raeburn 12961: $fname.'</span>').'</p>';
1.987 raeburn 12962: } else {
12963: $output = '<p class="LC_error">'.
12964: &mt('Error: update failed for: [_1].',
12965: '<span class="LC_filename">'.
12966: $container.'</span>').'</p>';
12967: }
1.1123 raeburn 12968: if ($context eq 'syllabus') {
12969: unless ($saveresult eq 'ok') {
12970: $skiprewrites = 1;
12971: }
12972: }
1.987 raeburn 12973: } else {
1.1317 raeburn 12974: if (open(my $fh,'>',$container)) {
1.987 raeburn 12975: print $fh $content;
12976: close($fh);
12977: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12978: $count,'<span class="LC_filename">'.
12979: $container.'</span>').'</p>';
1.661 raeburn 12980: } else {
1.987 raeburn 12981: $output = '<p class="LC_error">'.
12982: &mt('Error: could not update [_1].',
12983: '<span class="LC_filename">'.
12984: $container.'</span>').'</p>';
1.661 raeburn 12985: }
12986: }
12987: }
1.1123 raeburn 12988: if (($context eq 'syllabus') && (!$skiprewrites)) {
12989: my ($actionurl,$state);
12990: $actionurl = "/public/$udom/$uname/syllabus";
12991: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
12992: &ask_for_embedded_content($actionurl,$state,\%allfiles,
12993: \%codebase,
12994: {'context' => 'rewrites',
12995: 'ignore_remote_references' => 1,});
12996: if (ref($mapping) eq 'HASH') {
12997: my $rewrites = 0;
12998: foreach my $key (keys(%{$mapping})) {
12999: next if ($key =~ m{^https?://});
13000: my $ref = $mapping->{$key};
13001: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
13002: my $attrib;
13003: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
13004: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
13005: }
13006: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13007: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13008: $rewrites += $numchg;
13009: }
13010: }
13011: if ($rewrites) {
13012: my $saveresult;
13013: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13014: if ($url eq $container) {
13015: my ($fname) = ($container =~ m{/([^/]+)$});
13016: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
13017: $count,'<span class="LC_filename">'.
13018: $fname.'</span>').'</p>';
13019: } else {
13020: $output .= '<p class="LC_error">'.
13021: &mt('Error: could not update links in [_1].',
13022: '<span class="LC_filename">'.
13023: $container.'</span>').'</p>';
13024:
13025: }
13026: }
13027: }
13028: }
1.987 raeburn 13029: } else {
13030: &logthis('Failed to parse '.$container.
13031: ' to modify references: '.$parse_result);
1.661 raeburn 13032: }
13033: }
1.1071 raeburn 13034: if (wantarray) {
13035: return ($output,$count,$codebasecount);
13036: } else {
13037: return $output;
13038: }
1.661 raeburn 13039: }
13040:
13041: sub check_for_existing {
13042: my ($path,$fname,$element) = @_;
13043: my ($state,$msg);
13044: if (-d $path.'/'.$fname) {
13045: $state = 'exists';
13046: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13047: } elsif (-e $path.'/'.$fname) {
13048: $state = 'exists';
13049: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13050: }
13051: if ($state eq 'exists') {
13052: $msg = '<span class="LC_error">'.$msg.'</span><br />';
13053: }
13054: return ($state,$msg);
13055: }
13056:
13057: sub check_for_upload {
13058: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
13059: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 13060: my $filesize = length($env{'form.'.$element});
13061: if (!$filesize) {
13062: my $msg = '<span class="LC_error">'.
13063: &mt('Unable to upload [_1]. (size = [_2] bytes)',
13064: '<span class="LC_filename">'.$fname.'</span>',
13065: $filesize).'<br />'.
1.1007 raeburn 13066: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 13067: '</span>';
13068: return ('zero_bytes',$msg);
13069: }
13070: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 13071: my $getpropath = 1;
1.1021 raeburn 13072: my ($dirlistref,$listerror) =
13073: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 13074: my $found_file = 0;
13075: my $locked_file = 0;
1.991 raeburn 13076: my @lockers;
13077: my $navmap;
13078: if ($env{'request.course.id'}) {
13079: $navmap = Apache::lonnavmaps::navmap->new();
13080: }
1.1021 raeburn 13081: if (ref($dirlistref) eq 'ARRAY') {
13082: foreach my $line (@{$dirlistref}) {
13083: my ($file_name,$rest)=split(/\&/,$line,2);
13084: if ($file_name eq $fname){
13085: $file_name = $path.$file_name;
13086: if ($group ne '') {
13087: $file_name = $group.$file_name;
13088: }
13089: $found_file = 1;
13090: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
13091: foreach my $lock (@lockers) {
13092: if (ref($lock) eq 'ARRAY') {
13093: my ($symb,$crsid) = @{$lock};
13094: if ($crsid eq $env{'request.course.id'}) {
13095: if (ref($navmap)) {
13096: my $res = $navmap->getBySymb($symb);
13097: foreach my $part (@{$res->parts()}) {
13098: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
13099: unless (($slot_status == $res->RESERVED) ||
13100: ($slot_status == $res->RESERVED_LOCATION)) {
13101: $locked_file = 1;
13102: }
1.991 raeburn 13103: }
1.1021 raeburn 13104: } else {
13105: $locked_file = 1;
1.991 raeburn 13106: }
13107: } else {
13108: $locked_file = 1;
13109: }
13110: }
1.1021 raeburn 13111: }
13112: } else {
13113: my @info = split(/\&/,$rest);
13114: my $currsize = $info[6]/1000;
13115: if ($currsize < $filesize) {
13116: my $extra = $filesize - $currsize;
13117: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 13118: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 13119: &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 13120: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
13121: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
13122: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 13123: return ('will_exceed_quota',$msg);
13124: }
1.984 raeburn 13125: }
13126: }
1.661 raeburn 13127: }
13128: }
13129: }
13130: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 13131: my $msg = '<p class="LC_warning">'.
13132: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 13133: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 13134: return ('will_exceed_quota',$msg);
13135: } elsif ($found_file) {
13136: if ($locked_file) {
1.1179 bisitz 13137: my $msg = '<p class="LC_warning">';
1.661 raeburn 13138: $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 13139: $msg .= '</p>';
1.661 raeburn 13140: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
13141: return ('file_locked',$msg);
13142: } else {
1.1179 bisitz 13143: my $msg = '<p class="LC_error">';
1.984 raeburn 13144: $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 13145: $msg .= '</p>';
1.984 raeburn 13146: return ('existingfile',$msg);
1.661 raeburn 13147: }
13148: }
13149: }
13150:
1.987 raeburn 13151: sub check_for_traversal {
13152: my ($path,$url,$toplevel) = @_;
13153: my @parts=split(/\//,$path);
13154: my $cleanpath;
13155: my $fullpath = $url;
13156: for (my $i=0;$i<@parts;$i++) {
13157: next if ($parts[$i] eq '.');
13158: if ($parts[$i] eq '..') {
13159: $fullpath =~ s{([^/]+/)$}{};
13160: } else {
13161: $fullpath .= $parts[$i].'/';
13162: }
13163: }
13164: if ($fullpath =~ /^\Q$url\E(.*)$/) {
13165: $cleanpath = $1;
13166: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
13167: my $curr_toprel = $1;
13168: my @parts = split(/\//,$curr_toprel);
13169: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
13170: my @urlparts = split(/\//,$url_toprel);
13171: my $doubledots;
13172: my $startdiff = -1;
13173: for (my $i=0; $i<@urlparts; $i++) {
13174: if ($startdiff == -1) {
13175: unless ($urlparts[$i] eq $parts[$i]) {
13176: $startdiff = $i;
13177: $doubledots .= '../';
13178: }
13179: } else {
13180: $doubledots .= '../';
13181: }
13182: }
13183: if ($startdiff > -1) {
13184: $cleanpath = $doubledots;
13185: for (my $i=$startdiff; $i<@parts; $i++) {
13186: $cleanpath .= $parts[$i].'/';
13187: }
13188: }
13189: }
13190: $cleanpath =~ s{(/)$}{};
13191: return $cleanpath;
13192: }
1.31 albertel 13193:
1.1053 raeburn 13194: sub is_archive_file {
13195: my ($mimetype) = @_;
13196: if (($mimetype eq 'application/octet-stream') ||
13197: ($mimetype eq 'application/x-stuffit') ||
13198: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
13199: return 1;
13200: }
13201: return;
13202: }
13203:
13204: sub decompress_form {
1.1065 raeburn 13205: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 13206: my %lt = &Apache::lonlocal::texthash (
13207: this => 'This file is an archive file.',
1.1067 raeburn 13208: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 13209: itsc => 'Its contents are as follows:',
1.1053 raeburn 13210: youm => 'You may wish to extract its contents.',
13211: extr => 'Extract contents',
1.1067 raeburn 13212: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
13213: proa => 'Process automatically?',
1.1053 raeburn 13214: yes => 'Yes',
13215: no => 'No',
1.1067 raeburn 13216: fold => 'Title for folder containing movie',
13217: movi => 'Title for page containing embedded movie',
1.1053 raeburn 13218: );
1.1065 raeburn 13219: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 13220: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 13221: my $info = &list_archive_contents($fileloc,\@paths);
13222: if (@paths) {
13223: foreach my $path (@paths) {
13224: $path =~ s{^/}{};
1.1067 raeburn 13225: if ($path =~ m{^([^/]+)/$}) {
13226: $topdir = $1;
13227: }
1.1065 raeburn 13228: if ($path =~ m{^([^/]+)/}) {
13229: $toplevel{$1} = $path;
13230: } else {
13231: $toplevel{$path} = $path;
13232: }
13233: }
13234: }
1.1067 raeburn 13235: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 13236: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 13237: "$topdir/media/",
13238: "$topdir/media/$topdir.mp4",
13239: "$topdir/media/FirstFrame.png",
13240: "$topdir/media/player.swf",
13241: "$topdir/media/swfobject.js",
13242: "$topdir/media/expressInstall.swf");
1.1197 raeburn 13243: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 13244: "$topdir/$topdir.mp4",
13245: "$topdir/$topdir\_config.xml",
13246: "$topdir/$topdir\_controller.swf",
13247: "$topdir/$topdir\_embed.css",
13248: "$topdir/$topdir\_First_Frame.png",
13249: "$topdir/$topdir\_player.html",
13250: "$topdir/$topdir\_Thumbnails.png",
13251: "$topdir/playerProductInstall.swf",
13252: "$topdir/scripts/",
13253: "$topdir/scripts/config_xml.js",
13254: "$topdir/scripts/handlebars.js",
13255: "$topdir/scripts/jquery-1.7.1.min.js",
13256: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
13257: "$topdir/scripts/modernizr.js",
13258: "$topdir/scripts/player-min.js",
13259: "$topdir/scripts/swfobject.js",
13260: "$topdir/skins/",
13261: "$topdir/skins/configuration_express.xml",
13262: "$topdir/skins/express_show/",
13263: "$topdir/skins/express_show/player-min.css",
13264: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 13265: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
13266: "$topdir/$topdir.mp4",
13267: "$topdir/$topdir\_config.xml",
13268: "$topdir/$topdir\_controller.swf",
13269: "$topdir/$topdir\_embed.css",
13270: "$topdir/$topdir\_First_Frame.png",
13271: "$topdir/$topdir\_player.html",
13272: "$topdir/$topdir\_Thumbnails.png",
13273: "$topdir/playerProductInstall.swf",
13274: "$topdir/scripts/",
13275: "$topdir/scripts/config_xml.js",
13276: "$topdir/scripts/techsmith-smart-player.min.js",
13277: "$topdir/skins/",
13278: "$topdir/skins/configuration_express.xml",
13279: "$topdir/skins/express_show/",
13280: "$topdir/skins/express_show/spritesheet.min.css",
13281: "$topdir/skins/express_show/spritesheet.png",
13282: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 13283: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 13284: if (@diffs == 0) {
1.1164 raeburn 13285: $is_camtasia = 6;
13286: } else {
1.1197 raeburn 13287: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 13288: if (@diffs == 0) {
13289: $is_camtasia = 8;
1.1197 raeburn 13290: } else {
13291: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
13292: if (@diffs == 0) {
13293: $is_camtasia = 8;
13294: }
1.1164 raeburn 13295: }
1.1067 raeburn 13296: }
13297: }
13298: my $output;
13299: if ($is_camtasia) {
13300: $output = <<"ENDCAM";
13301: <script type="text/javascript" language="Javascript">
13302: // <![CDATA[
13303:
13304: function camtasiaToggle() {
13305: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
13306: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 13307: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 13308: document.getElementById('camtasia_titles').style.display='block';
13309: } else {
13310: document.getElementById('camtasia_titles').style.display='none';
13311: }
13312: }
13313: }
13314: return;
13315: }
13316:
13317: // ]]>
13318: </script>
13319: <p>$lt{'camt'}</p>
13320: ENDCAM
1.1065 raeburn 13321: } else {
1.1067 raeburn 13322: $output = '<p>'.$lt{'this'};
13323: if ($info eq '') {
13324: $output .= ' '.$lt{'youm'}.'</p>'."\n";
13325: } else {
13326: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
13327: '<div><pre>'.$info.'</pre></div>';
13328: }
1.1065 raeburn 13329: }
1.1067 raeburn 13330: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 13331: my $duplicates;
13332: my $num = 0;
13333: if (ref($dirlist) eq 'ARRAY') {
13334: foreach my $item (@{$dirlist}) {
13335: if (ref($item) eq 'ARRAY') {
13336: if (exists($toplevel{$item->[0]})) {
13337: $duplicates .=
13338: &start_data_table_row().
13339: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
13340: 'value="0" checked="checked" />'.&mt('No').'</label>'.
13341: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
13342: 'value="1" />'.&mt('Yes').'</label>'.
13343: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
13344: '<td>'.$item->[0].'</td>';
13345: if ($item->[2]) {
13346: $duplicates .= '<td>'.&mt('Directory').'</td>';
13347: } else {
13348: $duplicates .= '<td>'.&mt('File').'</td>';
13349: }
13350: $duplicates .= '<td>'.$item->[3].'</td>'.
13351: '<td>'.
13352: &Apache::lonlocal::locallocaltime($item->[4]).
13353: '</td>'.
13354: &end_data_table_row();
13355: $num ++;
13356: }
13357: }
13358: }
13359: }
13360: my $itemcount;
13361: if (@paths > 0) {
13362: $itemcount = scalar(@paths);
13363: } else {
13364: $itemcount = 1;
13365: }
1.1067 raeburn 13366: if ($is_camtasia) {
13367: $output .= $lt{'auto'}.'<br />'.
13368: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 13369: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 13370: $lt{'yes'}.'</label> <label>'.
13371: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
13372: $lt{'no'}.'</label></span><br />'.
13373: '<div id="camtasia_titles" style="display:block">'.
13374: &Apache::lonhtmlcommon::start_pick_box().
13375: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
13376: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
13377: &Apache::lonhtmlcommon::row_closure().
13378: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
13379: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
13380: &Apache::lonhtmlcommon::row_closure(1).
13381: &Apache::lonhtmlcommon::end_pick_box().
13382: '</div>';
13383: }
1.1065 raeburn 13384: $output .=
13385: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 13386: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
13387: "\n";
1.1065 raeburn 13388: if ($duplicates ne '') {
13389: $output .= '<p><span class="LC_warning">'.
13390: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
13391: &start_data_table().
13392: &start_data_table_header_row().
13393: '<th>'.&mt('Overwrite?').'</th>'.
13394: '<th>'.&mt('Name').'</th>'.
13395: '<th>'.&mt('Type').'</th>'.
13396: '<th>'.&mt('Size').'</th>'.
13397: '<th>'.&mt('Last modified').'</th>'.
13398: &end_data_table_header_row().
13399: $duplicates.
13400: &end_data_table().
13401: '</p>';
13402: }
1.1067 raeburn 13403: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 13404: if (ref($hiddenelements) eq 'HASH') {
13405: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
13406: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
13407: }
13408: }
13409: $output .= <<"END";
1.1067 raeburn 13410: <br />
1.1053 raeburn 13411: <input type="submit" name="decompress" value="$lt{'extr'}" />
13412: </form>
13413: $noextract
13414: END
13415: return $output;
13416: }
13417:
1.1065 raeburn 13418: sub decompression_utility {
13419: my ($program) = @_;
13420: my @utilities = ('tar','gunzip','bunzip2','unzip');
13421: my $location;
13422: if (grep(/^\Q$program\E$/,@utilities)) {
13423: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
13424: '/usr/sbin/') {
13425: if (-x $dir.$program) {
13426: $location = $dir.$program;
13427: last;
13428: }
13429: }
13430: }
13431: return $location;
13432: }
13433:
13434: sub list_archive_contents {
13435: my ($file,$pathsref) = @_;
13436: my (@cmd,$output);
13437: my $needsregexp;
13438: if ($file =~ /\.zip$/) {
13439: @cmd = (&decompression_utility('unzip'),"-l");
13440: $needsregexp = 1;
13441: } elsif (($file =~ m/\.tar\.gz$/) ||
13442: ($file =~ /\.tgz$/)) {
13443: @cmd = (&decompression_utility('tar'),"-ztf");
13444: } elsif ($file =~ /\.tar\.bz2$/) {
13445: @cmd = (&decompression_utility('tar'),"-jtf");
13446: } elsif ($file =~ m|\.tar$|) {
13447: @cmd = (&decompression_utility('tar'),"-tf");
13448: }
13449: if (@cmd) {
13450: undef($!);
13451: undef($@);
13452: if (open(my $fh,"-|", @cmd, $file)) {
13453: while (my $line = <$fh>) {
13454: $output .= $line;
13455: chomp($line);
13456: my $item;
13457: if ($needsregexp) {
13458: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
13459: } else {
13460: $item = $line;
13461: }
13462: if ($item ne '') {
13463: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
13464: push(@{$pathsref},$item);
13465: }
13466: }
13467: }
13468: close($fh);
13469: }
13470: }
13471: return $output;
13472: }
13473:
1.1053 raeburn 13474: sub decompress_uploaded_file {
13475: my ($file,$dir) = @_;
13476: &Apache::lonnet::appenv({'cgi.file' => $file});
13477: &Apache::lonnet::appenv({'cgi.dir' => $dir});
13478: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
13479: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
13480: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
13481: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
13482: my $decompressed = $env{'cgi.decompressed'};
13483: &Apache::lonnet::delenv('cgi.file');
13484: &Apache::lonnet::delenv('cgi.dir');
13485: &Apache::lonnet::delenv('cgi.decompressed');
13486: return ($decompressed,$result);
13487: }
13488:
1.1055 raeburn 13489: sub process_decompression {
13490: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 13491: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
13492: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13493: &mt('Unexpected file path.').'</p>'."\n";
13494: }
13495: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
13496: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13497: &mt('Unexpected course context.').'</p>'."\n";
13498: }
1.1293 raeburn 13499: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 13500: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13501: &mt('Filename contained unexpected characters.').'</p>'."\n";
13502: }
1.1055 raeburn 13503: my ($dir,$error,$warning,$output);
1.1180 raeburn 13504: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 13505: $error = &mt('Filename not a supported archive file type.').
13506: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 13507: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
13508: } else {
13509: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13510: if ($docuhome eq 'no_host') {
13511: $error = &mt('Could not determine home server for course.');
13512: } else {
13513: my @ids=&Apache::lonnet::current_machine_ids();
13514: my $currdir = "$dir_root/$destination";
13515: if (grep(/^\Q$docuhome\E$/,@ids)) {
13516: $dir = &LONCAPA::propath($docudom,$docuname).
13517: "$dir_root/$destination";
13518: } else {
13519: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
13520: "$dir_root/$docudom/$docuname/$destination";
13521: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
13522: $error = &mt('Archive file not found.');
13523: }
13524: }
1.1065 raeburn 13525: my (@to_overwrite,@to_skip);
13526: if ($env{'form.archive_overwrite_total'} > 0) {
13527: my $total = $env{'form.archive_overwrite_total'};
13528: for (my $i=0; $i<$total; $i++) {
13529: if ($env{'form.archive_overwrite_'.$i} == 1) {
13530: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
13531: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
13532: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
13533: }
13534: }
13535: }
13536: my $numskip = scalar(@to_skip);
1.1292 raeburn 13537: my $numoverwrite = scalar(@to_overwrite);
13538: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 13539: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
13540: } elsif ($dir eq '') {
1.1055 raeburn 13541: $error = &mt('Directory containing archive file unavailable.');
13542: } elsif (!$error) {
1.1065 raeburn 13543: my ($decompressed,$display);
1.1292 raeburn 13544: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 13545: my $tempdir = time.'_'.$$.int(rand(10000));
13546: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 13547: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
13548: ($decompressed,$display) =
13549: &decompress_uploaded_file($file,"$dir/$tempdir");
13550: foreach my $item (@to_skip) {
13551: if (($item ne '') && ($item !~ /\.\./)) {
13552: if (-f "$dir/$tempdir/$item") {
13553: unlink("$dir/$tempdir/$item");
13554: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 13555: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 13556: }
13557: }
13558: }
13559: foreach my $item (@to_overwrite) {
13560: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
13561: if (($item ne '') && ($item !~ /\.\./)) {
13562: if (-f "$dir/$item") {
13563: unlink("$dir/$item");
13564: } elsif (-d "$dir/$item") {
1.1300 raeburn 13565: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 13566: }
13567: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
13568: }
1.1065 raeburn 13569: }
13570: }
1.1292 raeburn 13571: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 13572: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 13573: }
1.1065 raeburn 13574: }
13575: } else {
13576: ($decompressed,$display) =
13577: &decompress_uploaded_file($file,$dir);
13578: }
1.1055 raeburn 13579: if ($decompressed eq 'ok') {
1.1065 raeburn 13580: $output = '<p class="LC_info">'.
13581: &mt('Files extracted successfully from archive.').
13582: '</p>'."\n";
1.1055 raeburn 13583: my ($warning,$result,@contents);
13584: my ($newdirlistref,$newlisterror) =
13585: &Apache::lonnet::dirlist($currdir,$docudom,
13586: $docuname,1);
13587: my (%is_dir,%changes,@newitems);
13588: my $dirptr = 16384;
1.1065 raeburn 13589: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 13590: foreach my $dir_line (@{$newdirlistref}) {
13591: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 13592: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 13593: push(@newitems,$item);
13594: if ($dirptr&$testdir) {
13595: $is_dir{$item} = 1;
13596: }
13597: $changes{$item} = 1;
13598: }
13599: }
13600: }
13601: if (keys(%changes) > 0) {
13602: foreach my $item (sort(@newitems)) {
13603: if ($changes{$item}) {
13604: push(@contents,$item);
13605: }
13606: }
13607: }
13608: if (@contents > 0) {
1.1067 raeburn 13609: my $wantform;
13610: unless ($env{'form.autoextract_camtasia'}) {
13611: $wantform = 1;
13612: }
1.1056 raeburn 13613: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 13614: my ($count,$datatable) = &get_extracted($docudom,$docuname,
13615: $currdir,\%is_dir,
13616: \%children,\%parent,
1.1056 raeburn 13617: \@contents,\%dirorder,
13618: \%titles,$wantform);
1.1055 raeburn 13619: if ($datatable ne '') {
13620: $output .= &archive_options_form('decompressed',$datatable,
13621: $count,$hiddenelem);
1.1065 raeburn 13622: my $startcount = 6;
1.1055 raeburn 13623: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 13624: \%titles,\%children);
1.1055 raeburn 13625: }
1.1067 raeburn 13626: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 13627: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 13628: my %displayed;
13629: my $total = 1;
13630: $env{'form.archive_directory'} = [];
13631: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
13632: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
13633: $path =~ s{/$}{};
13634: my $item;
13635: if ($path ne '') {
13636: $item = "$path/$titles{$i}";
13637: } else {
13638: $item = $titles{$i};
13639: }
13640: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
13641: if ($item eq $contents[0]) {
13642: push(@{$env{'form.archive_directory'}},$i);
13643: $env{'form.archive_'.$i} = 'display';
13644: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
13645: $displayed{'folder'} = $i;
1.1164 raeburn 13646: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
13647: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 13648: $env{'form.archive_'.$i} = 'display';
13649: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
13650: $displayed{'web'} = $i;
13651: } else {
1.1164 raeburn 13652: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
13653: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
13654: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 13655: push(@{$env{'form.archive_directory'}},$i);
13656: }
13657: $env{'form.archive_'.$i} = 'dependency';
13658: }
13659: $total ++;
13660: }
13661: for (my $i=1; $i<$total; $i++) {
13662: next if ($i == $displayed{'web'});
13663: next if ($i == $displayed{'folder'});
13664: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
13665: }
13666: $env{'form.phase'} = 'decompress_cleanup';
13667: $env{'form.archivedelete'} = 1;
13668: $env{'form.archive_count'} = $total-1;
13669: $output .=
13670: &process_extracted_files('coursedocs',$docudom,
13671: $docuname,$destination,
13672: $dir_root,$hiddenelem);
13673: }
1.1055 raeburn 13674: } else {
13675: $warning = &mt('No new items extracted from archive file.');
13676: }
13677: } else {
13678: $output = $display;
13679: $error = &mt('An error occurred during extraction from the archive file.');
13680: }
13681: }
13682: }
13683: }
13684: if ($error) {
13685: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13686: $error.'</p>'."\n";
13687: }
13688: if ($warning) {
13689: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13690: }
13691: return $output;
13692: }
13693:
13694: sub get_extracted {
1.1056 raeburn 13695: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
13696: $titles,$wantform) = @_;
1.1055 raeburn 13697: my $count = 0;
13698: my $depth = 0;
13699: my $datatable;
1.1056 raeburn 13700: my @hierarchy;
1.1055 raeburn 13701: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 13702: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
13703: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 13704: foreach my $item (@{$contents}) {
13705: $count ++;
1.1056 raeburn 13706: @{$dirorder->{$count}} = @hierarchy;
13707: $titles->{$count} = $item;
1.1055 raeburn 13708: &archive_hierarchy($depth,$count,$parent,$children);
13709: if ($wantform) {
13710: $datatable .= &archive_row($is_dir->{$item},$item,
13711: $currdir,$depth,$count);
13712: }
13713: if ($is_dir->{$item}) {
13714: $depth ++;
1.1056 raeburn 13715: push(@hierarchy,$count);
13716: $parent->{$depth} = $count;
1.1055 raeburn 13717: $datatable .=
13718: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 13719: \$depth,\$count,\@hierarchy,$dirorder,
13720: $children,$parent,$titles,$wantform);
1.1055 raeburn 13721: $depth --;
1.1056 raeburn 13722: pop(@hierarchy);
1.1055 raeburn 13723: }
13724: }
13725: return ($count,$datatable);
13726: }
13727:
13728: sub recurse_extracted_archive {
1.1056 raeburn 13729: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
13730: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 13731: my $result='';
1.1056 raeburn 13732: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
13733: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
13734: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 13735: return $result;
13736: }
13737: my $dirptr = 16384;
13738: my ($newdirlistref,$newlisterror) =
13739: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
13740: if (ref($newdirlistref) eq 'ARRAY') {
13741: foreach my $dir_line (@{$newdirlistref}) {
13742: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
13743: unless ($item =~ /^\.+$/) {
13744: $$count ++;
1.1056 raeburn 13745: @{$dirorder->{$$count}} = @{$hierarchy};
13746: $titles->{$$count} = $item;
1.1055 raeburn 13747: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 13748:
1.1055 raeburn 13749: my $is_dir;
13750: if ($dirptr&$testdir) {
13751: $is_dir = 1;
13752: }
13753: if ($wantform) {
13754: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
13755: }
13756: if ($is_dir) {
13757: $$depth ++;
1.1056 raeburn 13758: push(@{$hierarchy},$$count);
13759: $parent->{$$depth} = $$count;
1.1055 raeburn 13760: $result .=
13761: &recurse_extracted_archive("$currdir/$item",$docudom,
13762: $docuname,$depth,$count,
1.1056 raeburn 13763: $hierarchy,$dirorder,$children,
13764: $parent,$titles,$wantform);
1.1055 raeburn 13765: $$depth --;
1.1056 raeburn 13766: pop(@{$hierarchy});
1.1055 raeburn 13767: }
13768: }
13769: }
13770: }
13771: return $result;
13772: }
13773:
13774: sub archive_hierarchy {
13775: my ($depth,$count,$parent,$children) =@_;
13776: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
13777: if (exists($parent->{$depth})) {
13778: $children->{$parent->{$depth}} .= $count.':';
13779: }
13780: }
13781: return;
13782: }
13783:
13784: sub archive_row {
13785: my ($is_dir,$item,$currdir,$depth,$count) = @_;
13786: my ($name) = ($item =~ m{([^/]+)$});
13787: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 13788: 'display' => 'Add as file',
1.1055 raeburn 13789: 'dependency' => 'Include as dependency',
13790: 'discard' => 'Discard',
13791: );
13792: if ($is_dir) {
1.1059 raeburn 13793: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 13794: }
1.1056 raeburn 13795: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
13796: my $offset = 0;
1.1055 raeburn 13797: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 13798: $offset ++;
1.1065 raeburn 13799: if ($action ne 'display') {
13800: $offset ++;
13801: }
1.1055 raeburn 13802: $output .= '<td><span class="LC_nobreak">'.
13803: '<label><input type="radio" name="archive_'.$count.
13804: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
13805: my $text = $choices{$action};
13806: if ($is_dir) {
13807: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
13808: if ($action eq 'display') {
1.1059 raeburn 13809: $text = &mt('Add as folder');
1.1055 raeburn 13810: }
1.1056 raeburn 13811: } else {
13812: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
13813:
13814: }
13815: $output .= ' /> '.$choices{$action}.'</label></span>';
13816: if ($action eq 'dependency') {
13817: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
13818: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
13819: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
13820: '<option value=""></option>'."\n".
13821: '</select>'."\n".
13822: '</div>';
1.1059 raeburn 13823: } elsif ($action eq 'display') {
13824: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
13825: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
13826: '</div>';
1.1055 raeburn 13827: }
1.1056 raeburn 13828: $output .= '</td>';
1.1055 raeburn 13829: }
13830: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
13831: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
13832: for (my $i=0; $i<$depth; $i++) {
13833: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
13834: }
13835: if ($is_dir) {
13836: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
13837: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
13838: } else {
13839: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
13840: }
13841: $output .= ' '.$name.'</td>'."\n".
13842: &end_data_table_row();
13843: return $output;
13844: }
13845:
13846: sub archive_options_form {
1.1065 raeburn 13847: my ($form,$display,$count,$hiddenelem) = @_;
13848: my %lt = &Apache::lonlocal::texthash(
13849: perm => 'Permanently remove archive file?',
13850: hows => 'How should each extracted item be incorporated in the course?',
13851: cont => 'Content actions for all',
13852: addf => 'Add as folder/file',
13853: incd => 'Include as dependency for a displayed file',
13854: disc => 'Discard',
13855: no => 'No',
13856: yes => 'Yes',
13857: save => 'Save',
13858: );
13859: my $output = <<"END";
13860: <form name="$form" method="post" action="">
13861: <p><span class="LC_nobreak">$lt{'perm'}
13862: <label>
13863: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
13864: </label>
13865:
13866: <label>
13867: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
13868: </span>
13869: </p>
13870: <input type="hidden" name="phase" value="decompress_cleanup" />
13871: <br />$lt{'hows'}
13872: <div class="LC_columnSection">
13873: <fieldset>
13874: <legend>$lt{'cont'}</legend>
13875: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
13876: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
13877: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
13878: </fieldset>
13879: </div>
13880: END
13881: return $output.
1.1055 raeburn 13882: &start_data_table()."\n".
1.1065 raeburn 13883: $display."\n".
1.1055 raeburn 13884: &end_data_table()."\n".
13885: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
13886: $hiddenelem.
1.1065 raeburn 13887: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 13888: '</form>';
13889: }
13890:
13891: sub archive_javascript {
1.1056 raeburn 13892: my ($startcount,$numitems,$titles,$children) = @_;
13893: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 13894: my $maintitle = $env{'form.comment'};
1.1055 raeburn 13895: my $scripttag = <<START;
13896: <script type="text/javascript">
13897: // <![CDATA[
13898:
13899: function checkAll(form,prefix) {
13900: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
13901: for (var i=0; i < form.elements.length; i++) {
13902: var id = form.elements[i].id;
13903: if ((id != '') && (id != undefined)) {
13904: if (idstr.test(id)) {
13905: if (form.elements[i].type == 'radio') {
13906: form.elements[i].checked = true;
1.1056 raeburn 13907: var nostart = i-$startcount;
1.1059 raeburn 13908: var offset = nostart%7;
13909: var count = (nostart-offset)/7;
1.1056 raeburn 13910: dependencyCheck(form,count,offset);
1.1055 raeburn 13911: }
13912: }
13913: }
13914: }
13915: }
13916:
13917: function propagateCheck(form,count) {
13918: if (count > 0) {
1.1059 raeburn 13919: var startelement = $startcount + ((count-1) * 7);
13920: for (var j=1; j<6; j++) {
13921: if ((j != 2) && (j != 4)) {
1.1056 raeburn 13922: var item = startelement + j;
13923: if (form.elements[item].type == 'radio') {
13924: if (form.elements[item].checked) {
13925: containerCheck(form,count,j);
13926: break;
13927: }
1.1055 raeburn 13928: }
13929: }
13930: }
13931: }
13932: }
13933:
13934: numitems = $numitems
1.1056 raeburn 13935: var titles = new Array(numitems);
13936: var parents = new Array(numitems);
1.1055 raeburn 13937: for (var i=0; i<numitems; i++) {
1.1056 raeburn 13938: parents[i] = new Array;
1.1055 raeburn 13939: }
1.1059 raeburn 13940: var maintitle = '$maintitle';
1.1055 raeburn 13941:
13942: START
13943:
1.1056 raeburn 13944: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
13945: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 13946: for (my $i=0; $i<@contents; $i ++) {
13947: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
13948: }
13949: }
13950:
1.1056 raeburn 13951: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
13952: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
13953: }
13954:
1.1055 raeburn 13955: $scripttag .= <<END;
13956:
13957: function containerCheck(form,count,offset) {
13958: if (count > 0) {
1.1056 raeburn 13959: dependencyCheck(form,count,offset);
1.1059 raeburn 13960: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 13961: form.elements[item].checked = true;
13962: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
13963: if (parents[count].length > 0) {
13964: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 13965: containerCheck(form,parents[count][j],offset);
13966: }
13967: }
13968: }
13969: }
13970: }
13971:
13972: function dependencyCheck(form,count,offset) {
13973: if (count > 0) {
1.1059 raeburn 13974: var chosen = (offset+$startcount)+7*(count-1);
13975: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 13976: var currtype = form.elements[depitem].type;
13977: if (form.elements[chosen].value == 'dependency') {
13978: document.getElementById('arc_depon_'+count).style.display='block';
13979: form.elements[depitem].options.length = 0;
13980: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 13981: for (var i=1; i<=numitems; i++) {
13982: if (i == count) {
13983: continue;
13984: }
1.1059 raeburn 13985: var startelement = $startcount + (i-1) * 7;
13986: for (var j=1; j<6; j++) {
13987: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 13988: var item = startelement + j;
13989: if (form.elements[item].type == 'radio') {
13990: if (form.elements[item].checked) {
13991: if (form.elements[item].value == 'display') {
13992: var n = form.elements[depitem].options.length;
13993: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
13994: }
13995: }
13996: }
13997: }
13998: }
13999: }
14000: } else {
14001: document.getElementById('arc_depon_'+count).style.display='none';
14002: form.elements[depitem].options.length = 0;
14003: form.elements[depitem].options[0] = new Option('Select','',true,true);
14004: }
1.1059 raeburn 14005: titleCheck(form,count,offset);
1.1056 raeburn 14006: }
14007: }
14008:
14009: function propagateSelect(form,count,offset) {
14010: if (count > 0) {
1.1065 raeburn 14011: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 14012: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
14013: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14014: if (parents[count].length > 0) {
14015: for (var j=0; j<parents[count].length; j++) {
14016: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 14017: }
14018: }
14019: }
14020: }
14021: }
1.1056 raeburn 14022:
14023: function containerSelect(form,count,offset,picked) {
14024: if (count > 0) {
1.1065 raeburn 14025: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 14026: if (form.elements[item].type == 'radio') {
14027: if (form.elements[item].value == 'dependency') {
14028: if (form.elements[item+1].type == 'select-one') {
14029: for (var i=0; i<form.elements[item+1].options.length; i++) {
14030: if (form.elements[item+1].options[i].value == picked) {
14031: form.elements[item+1].selectedIndex = i;
14032: break;
14033: }
14034: }
14035: }
14036: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14037: if (parents[count].length > 0) {
14038: for (var j=0; j<parents[count].length; j++) {
14039: containerSelect(form,parents[count][j],offset,picked);
14040: }
14041: }
14042: }
14043: }
14044: }
14045: }
14046: }
14047:
1.1059 raeburn 14048: function titleCheck(form,count,offset) {
14049: if (count > 0) {
14050: var chosen = (offset+$startcount)+7*(count-1);
14051: var depitem = $startcount + ((count-1) * 7) + 2;
14052: var currtype = form.elements[depitem].type;
14053: if (form.elements[chosen].value == 'display') {
14054: document.getElementById('arc_title_'+count).style.display='block';
14055: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
14056: document.getElementById('archive_title_'+count).value=maintitle;
14057: }
14058: } else {
14059: document.getElementById('arc_title_'+count).style.display='none';
14060: if (currtype == 'text') {
14061: document.getElementById('archive_title_'+count).value='';
14062: }
14063: }
14064: }
14065: return;
14066: }
14067:
1.1055 raeburn 14068: // ]]>
14069: </script>
14070: END
14071: return $scripttag;
14072: }
14073:
14074: sub process_extracted_files {
1.1067 raeburn 14075: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 14076: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 14077: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 14078: my @ids=&Apache::lonnet::current_machine_ids();
14079: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 14080: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 14081: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14082: if (grep(/^\Q$docuhome\E$/,@ids)) {
14083: $prefix = &LONCAPA::propath($docudom,$docuname);
14084: $pathtocheck = "$dir_root/$destination";
14085: $dir = $dir_root;
14086: $ishome = 1;
14087: } else {
14088: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
14089: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 14090: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 14091: }
14092: my $currdir = "$dir_root/$destination";
14093: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
14094: if ($env{'form.folderpath'}) {
14095: my @items = split('&',$env{'form.folderpath'});
14096: $folders{'0'} = $items[-2];
1.1099 raeburn 14097: if ($env{'form.folderpath'} =~ /\:1$/) {
14098: $containers{'0'}='page';
14099: } else {
14100: $containers{'0'}='sequence';
14101: }
1.1055 raeburn 14102: }
14103: my @archdirs = &get_env_multiple('form.archive_directory');
14104: if ($numitems) {
14105: for (my $i=1; $i<=$numitems; $i++) {
14106: my $path = $env{'form.archive_content_'.$i};
14107: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
14108: my $item = $1;
14109: $toplevelitems{$item} = $i;
14110: if (grep(/^\Q$i\E$/,@archdirs)) {
14111: $is_dir{$item} = 1;
14112: }
14113: }
14114: }
14115: }
1.1067 raeburn 14116: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 14117: if (keys(%toplevelitems) > 0) {
14118: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 14119: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
14120: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 14121: }
1.1066 raeburn 14122: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 14123: if ($numitems) {
14124: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 14125: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 14126: my $path = $env{'form.archive_content_'.$i};
14127: if ($path =~ /^\Q$pathtocheck\E/) {
14128: if ($env{'form.archive_'.$i} eq 'discard') {
14129: if ($prefix ne '' && $path ne '') {
14130: if (-e $prefix.$path) {
1.1066 raeburn 14131: if ((@archdirs > 0) &&
14132: (grep(/^\Q$i\E$/,@archdirs))) {
14133: $todeletedir{$prefix.$path} = 1;
14134: } else {
14135: $todelete{$prefix.$path} = 1;
14136: }
1.1055 raeburn 14137: }
14138: }
14139: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 14140: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 14141: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 14142: $docstitle = $env{'form.archive_title_'.$i};
14143: if ($docstitle eq '') {
14144: $docstitle = $title;
14145: }
1.1055 raeburn 14146: $outer = 0;
1.1056 raeburn 14147: if (ref($dirorder{$i}) eq 'ARRAY') {
14148: if (@{$dirorder{$i}} > 0) {
14149: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 14150: if ($env{'form.archive_'.$item} eq 'display') {
14151: $outer = $item;
14152: last;
14153: }
14154: }
14155: }
14156: }
14157: my ($errtext,$fatal) =
14158: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
14159: '/'.$folders{$outer}.'.'.
14160: $containers{$outer});
14161: next if ($fatal);
14162: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
14163: if ($context eq 'coursedocs') {
1.1056 raeburn 14164: $mapinner{$i} = time;
1.1055 raeburn 14165: $folders{$i} = 'default_'.$mapinner{$i};
14166: $containers{$i} = 'sequence';
14167: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14168: $folders{$i}.'.'.$containers{$i};
14169: my $newidx = &LONCAPA::map::getresidx();
14170: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 14171: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 14172: push(@LONCAPA::map::order,$newidx);
14173: my ($outtext,$errtext) =
14174: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14175: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 14176: '.'.$containers{$outer},1,1);
1.1056 raeburn 14177: $newseqid{$i} = $newidx;
1.1067 raeburn 14178: unless ($errtext) {
1.1294 raeburn 14179: $result .= '<li>'.&mt('Folder: [_1] added to course',
14180: &HTML::Entities::encode($docstitle,'<>&"')).
14181: '</li>'."\n";
1.1067 raeburn 14182: }
1.1055 raeburn 14183: }
14184: } else {
14185: if ($context eq 'coursedocs') {
14186: my $newidx=&LONCAPA::map::getresidx();
14187: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14188: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
14189: $title;
1.1294 raeburn 14190: if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
14191: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
14192: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
14193: }
14194: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14195: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
14196: }
14197: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14198: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
14199: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
14200: unless ($ishome) {
14201: my $fetch = "$newdest{$i}/$title";
14202: $fetch =~ s/^\Q$prefix$dir\E//;
14203: $prompttofetch{$fetch} = 1;
14204: }
1.1292 raeburn 14205: }
1.1067 raeburn 14206: }
1.1294 raeburn 14207: $LONCAPA::map::resources[$newidx]=
14208: $docstitle.':'.$url.':false:normal:res';
14209: push(@LONCAPA::map::order, $newidx);
14210: my ($outtext,$errtext)=
14211: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14212: $docuname.'/'.$folders{$outer}.
14213: '.'.$containers{$outer},1,1);
14214: unless ($errtext) {
14215: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
14216: $result .= '<li>'.&mt('File: [_1] added to course',
14217: &HTML::Entities::encode($docstitle,'<>&"')).
14218: '</li>'."\n";
14219: }
1.1067 raeburn 14220: }
1.1294 raeburn 14221: } else {
14222: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14223: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 14224: }
1.1055 raeburn 14225: }
14226: }
1.1086 raeburn 14227: }
14228: } else {
1.1294 raeburn 14229: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14230: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 14231: }
14232: }
14233: for (my $i=1; $i<=$numitems; $i++) {
14234: next unless ($env{'form.archive_'.$i} eq 'dependency');
14235: my $path = $env{'form.archive_content_'.$i};
14236: if ($path =~ /^\Q$pathtocheck\E/) {
14237: my ($title) = ($path =~ m{/([^/]+)$});
14238: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
14239: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
14240: if (ref($dirorder{$i}) eq 'ARRAY') {
14241: my ($itemidx,$fullpath,$relpath);
14242: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
14243: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 14244: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 14245: if ($dirorder{$i}->[$j] eq $container) {
14246: $itemidx = $j;
1.1056 raeburn 14247: }
14248: }
1.1086 raeburn 14249: }
14250: if ($itemidx eq '') {
14251: $itemidx = 0;
14252: }
14253: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
14254: if ($mapinner{$referrer{$i}}) {
14255: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
14256: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14257: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14258: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14259: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14260: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14261: if (!-e $fullpath) {
14262: mkdir($fullpath,0755);
1.1056 raeburn 14263: }
14264: }
1.1086 raeburn 14265: } else {
14266: last;
1.1056 raeburn 14267: }
1.1086 raeburn 14268: }
14269: }
14270: } elsif ($newdest{$referrer{$i}}) {
14271: $fullpath = $newdest{$referrer{$i}};
14272: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14273: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
14274: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
14275: last;
14276: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14277: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14278: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14279: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14280: if (!-e $fullpath) {
14281: mkdir($fullpath,0755);
1.1056 raeburn 14282: }
14283: }
1.1086 raeburn 14284: } else {
14285: last;
1.1056 raeburn 14286: }
1.1055 raeburn 14287: }
14288: }
1.1086 raeburn 14289: if ($fullpath ne '') {
14290: if (-e "$prefix$path") {
1.1292 raeburn 14291: unless (rename("$prefix$path","$fullpath/$title")) {
14292: $warning .= &mt('Failed to rename dependency').'<br />';
14293: }
1.1086 raeburn 14294: }
14295: if (-e "$fullpath/$title") {
14296: my $showpath;
14297: if ($relpath ne '') {
14298: $showpath = "$relpath/$title";
14299: } else {
14300: $showpath = "/$title";
14301: }
1.1294 raeburn 14302: $result .= '<li>'.&mt('[_1] included as a dependency',
14303: &HTML::Entities::encode($showpath,'<>&"')).
14304: '</li>'."\n";
1.1292 raeburn 14305: unless ($ishome) {
14306: my $fetch = "$fullpath/$title";
14307: $fetch =~ s/^\Q$prefix$dir\E//;
14308: $prompttofetch{$fetch} = 1;
14309: }
1.1086 raeburn 14310: }
14311: }
1.1055 raeburn 14312: }
1.1086 raeburn 14313: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
14314: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 14315: &HTML::Entities::encode($path,'<>&"'),
14316: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
14317: '<br />';
1.1055 raeburn 14318: }
14319: } else {
1.1294 raeburn 14320: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 14321: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 14322: }
14323: }
14324: if (keys(%todelete)) {
14325: foreach my $key (keys(%todelete)) {
14326: unlink($key);
1.1066 raeburn 14327: }
14328: }
14329: if (keys(%todeletedir)) {
14330: foreach my $key (keys(%todeletedir)) {
14331: rmdir($key);
14332: }
14333: }
14334: foreach my $dir (sort(keys(%is_dir))) {
14335: if (($pathtocheck ne '') && ($dir ne '')) {
14336: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 14337: }
14338: }
1.1067 raeburn 14339: if ($result ne '') {
14340: $output .= '<ul>'."\n".
14341: $result."\n".
14342: '</ul>';
14343: }
14344: unless ($ishome) {
14345: my $replicationfail;
14346: foreach my $item (keys(%prompttofetch)) {
14347: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
14348: unless ($fetchresult eq 'ok') {
14349: $replicationfail .= '<li>'.$item.'</li>'."\n";
14350: }
14351: }
14352: if ($replicationfail) {
14353: $output .= '<p class="LC_error">'.
14354: &mt('Course home server failed to retrieve:').'<ul>'.
14355: $replicationfail.
14356: '</ul></p>';
14357: }
14358: }
1.1055 raeburn 14359: } else {
14360: $warning = &mt('No items found in archive.');
14361: }
14362: if ($error) {
14363: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14364: $error.'</p>'."\n";
14365: }
14366: if ($warning) {
14367: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14368: }
14369: return $output;
14370: }
14371:
1.1066 raeburn 14372: sub cleanup_empty_dirs {
14373: my ($path) = @_;
14374: if (($path ne '') && (-d $path)) {
14375: if (opendir(my $dirh,$path)) {
14376: my @dircontents = grep(!/^\./,readdir($dirh));
14377: my $numitems = 0;
14378: foreach my $item (@dircontents) {
14379: if (-d "$path/$item") {
1.1111 raeburn 14380: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 14381: if (-e "$path/$item") {
14382: $numitems ++;
14383: }
14384: } else {
14385: $numitems ++;
14386: }
14387: }
14388: if ($numitems == 0) {
14389: rmdir($path);
14390: }
14391: closedir($dirh);
14392: }
14393: }
14394: return;
14395: }
14396:
1.41 ng 14397: =pod
1.45 matthew 14398:
1.1162 raeburn 14399: =item * &get_folder_hierarchy()
1.1068 raeburn 14400:
14401: Provides hierarchy of names of folders/sub-folders containing the current
14402: item,
14403:
14404: Inputs: 3
14405: - $navmap - navmaps object
14406:
14407: - $map - url for map (either the trigger itself, or map containing
14408: the resource, which is the trigger).
14409:
14410: - $showitem - 1 => show title for map itself; 0 => do not show.
14411:
14412: Outputs: 1 @pathitems - array of folder/subfolder names.
14413:
14414: =cut
14415:
14416: sub get_folder_hierarchy {
14417: my ($navmap,$map,$showitem) = @_;
14418: my @pathitems;
14419: if (ref($navmap)) {
14420: my $mapres = $navmap->getResourceByUrl($map);
14421: if (ref($mapres)) {
14422: my $pcslist = $mapres->map_hierarchy();
14423: if ($pcslist ne '') {
14424: my @pcs = split(/,/,$pcslist);
14425: foreach my $pc (@pcs) {
14426: if ($pc == 1) {
1.1129 raeburn 14427: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 14428: } else {
14429: my $res = $navmap->getByMapPc($pc);
14430: if (ref($res)) {
14431: my $title = $res->compTitle();
14432: $title =~ s/\W+/_/g;
14433: if ($title ne '') {
14434: push(@pathitems,$title);
14435: }
14436: }
14437: }
14438: }
14439: }
1.1071 raeburn 14440: if ($showitem) {
14441: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 14442: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 14443: } else {
14444: my $maptitle = $mapres->compTitle();
14445: $maptitle =~ s/\W+/_/g;
14446: if ($maptitle ne '') {
14447: push(@pathitems,$maptitle);
14448: }
1.1068 raeburn 14449: }
14450: }
14451: }
14452: }
14453: return @pathitems;
14454: }
14455:
14456: =pod
14457:
1.1015 raeburn 14458: =item * &get_turnedin_filepath()
14459:
14460: Determines path in a user's portfolio file for storage of files uploaded
14461: to a specific essayresponse or dropbox item.
14462:
14463: Inputs: 3 required + 1 optional.
14464: $symb is symb for resource, $uname and $udom are for current user (required).
14465: $caller is optional (can be "submission", if routine is called when storing
14466: an upoaded file when "Submit Answer" button was pressed).
14467:
14468: Returns array containing $path and $multiresp.
14469: $path is path in portfolio. $multiresp is 1 if this resource contains more
14470: than one file upload item. Callers of routine should append partid as a
14471: subdirectory to $path in cases where $multiresp is 1.
14472:
14473: Called by: homework/essayresponse.pm and homework/structuretags.pm
14474:
14475: =cut
14476:
14477: sub get_turnedin_filepath {
14478: my ($symb,$uname,$udom,$caller) = @_;
14479: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
14480: my $turnindir;
14481: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
14482: $turnindir = $userhash{'turnindir'};
14483: my ($path,$multiresp);
14484: if ($turnindir eq '') {
14485: if ($caller eq 'submission') {
14486: $turnindir = &mt('turned in');
14487: $turnindir =~ s/\W+/_/g;
14488: my %newhash = (
14489: 'turnindir' => $turnindir,
14490: );
14491: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
14492: }
14493: }
14494: if ($turnindir ne '') {
14495: $path = '/'.$turnindir.'/';
14496: my ($multipart,$turnin,@pathitems);
14497: my $navmap = Apache::lonnavmaps::navmap->new();
14498: if (defined($navmap)) {
14499: my $mapres = $navmap->getResourceByUrl($map);
14500: if (ref($mapres)) {
14501: my $pcslist = $mapres->map_hierarchy();
14502: if ($pcslist ne '') {
14503: foreach my $pc (split(/,/,$pcslist)) {
14504: my $res = $navmap->getByMapPc($pc);
14505: if (ref($res)) {
14506: my $title = $res->compTitle();
14507: $title =~ s/\W+/_/g;
14508: if ($title ne '') {
1.1149 raeburn 14509: if (($pc > 1) && (length($title) > 12)) {
14510: $title = substr($title,0,12);
14511: }
1.1015 raeburn 14512: push(@pathitems,$title);
14513: }
14514: }
14515: }
14516: }
14517: my $maptitle = $mapres->compTitle();
14518: $maptitle =~ s/\W+/_/g;
14519: if ($maptitle ne '') {
1.1149 raeburn 14520: if (length($maptitle) > 12) {
14521: $maptitle = substr($maptitle,0,12);
14522: }
1.1015 raeburn 14523: push(@pathitems,$maptitle);
14524: }
14525: unless ($env{'request.state'} eq 'construct') {
14526: my $res = $navmap->getBySymb($symb);
14527: if (ref($res)) {
14528: my $partlist = $res->parts();
14529: my $totaluploads = 0;
14530: if (ref($partlist) eq 'ARRAY') {
14531: foreach my $part (@{$partlist}) {
14532: my @types = $res->responseType($part);
14533: my @ids = $res->responseIds($part);
14534: for (my $i=0; $i < scalar(@ids); $i++) {
14535: if ($types[$i] eq 'essay') {
14536: my $partid = $part.'_'.$ids[$i];
14537: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
14538: $totaluploads ++;
14539: }
14540: }
14541: }
14542: }
14543: if ($totaluploads > 1) {
14544: $multiresp = 1;
14545: }
14546: }
14547: }
14548: }
14549: } else {
14550: return;
14551: }
14552: } else {
14553: return;
14554: }
14555: my $restitle=&Apache::lonnet::gettitle($symb);
14556: $restitle =~ s/\W+/_/g;
14557: if ($restitle eq '') {
14558: $restitle = ($resurl =~ m{/[^/]+$});
14559: if ($restitle eq '') {
14560: $restitle = time;
14561: }
14562: }
1.1149 raeburn 14563: if (length($restitle) > 12) {
14564: $restitle = substr($restitle,0,12);
14565: }
1.1015 raeburn 14566: push(@pathitems,$restitle);
14567: $path .= join('/',@pathitems);
14568: }
14569: return ($path,$multiresp);
14570: }
14571:
14572: =pod
14573:
1.464 albertel 14574: =back
1.41 ng 14575:
1.112 bowersj2 14576: =head1 CSV Upload/Handling functions
1.38 albertel 14577:
1.41 ng 14578: =over 4
14579:
1.648 raeburn 14580: =item * &upfile_store($r)
1.41 ng 14581:
14582: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 14583: needs $env{'form.upfile'}
1.41 ng 14584: returns $datatoken to be put into hidden field
14585:
14586: =cut
1.31 albertel 14587:
14588: sub upfile_store {
14589: my $r=shift;
1.258 albertel 14590: $env{'form.upfile'}=~s/\r/\n/gs;
14591: $env{'form.upfile'}=~s/\f/\n/gs;
14592: $env{'form.upfile'}=~s/\n+/\n/gs;
14593: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 14594:
1.1299 raeburn 14595: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
14596: '_enroll_'.$env{'request.course.id'}.'_'.
14597: time.'_'.$$);
14598: return if ($datatoken eq '');
14599:
1.31 albertel 14600: {
1.158 raeburn 14601: my $datafile = $r->dir_config('lonDaemons').
14602: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 14603: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 14604: print $fh $env{'form.upfile'};
1.158 raeburn 14605: close($fh);
14606: }
1.31 albertel 14607: }
14608: return $datatoken;
14609: }
14610:
1.56 matthew 14611: =pod
14612:
1.1290 raeburn 14613: =item * &load_tmp_file($r,$datatoken)
1.41 ng 14614:
14615: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 14616: $datatoken is the name to assign to the temporary file.
1.258 albertel 14617: sets $env{'form.upfile'} to the contents of the file
1.41 ng 14618:
14619: =cut
1.31 albertel 14620:
14621: sub load_tmp_file {
1.1290 raeburn 14622: my ($r,$datatoken) = @_;
14623: return if ($datatoken eq '');
1.31 albertel 14624: my @studentdata=();
14625: {
1.158 raeburn 14626: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 14627: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 14628: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 14629: @studentdata=<$fh>;
14630: close($fh);
14631: }
1.31 albertel 14632: }
1.258 albertel 14633: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 14634: }
14635:
1.1290 raeburn 14636: sub valid_datatoken {
14637: my ($datatoken) = @_;
1.1325 raeburn 14638: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290 raeburn 14639: return $datatoken;
14640: }
14641: return;
14642: }
14643:
1.56 matthew 14644: =pod
14645:
1.648 raeburn 14646: =item * &upfile_record_sep()
1.41 ng 14647:
14648: Separate uploaded file into records
14649: returns array of records,
1.258 albertel 14650: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 14651:
14652: =cut
1.31 albertel 14653:
14654: sub upfile_record_sep {
1.258 albertel 14655: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 14656: } else {
1.248 albertel 14657: my @records;
1.258 albertel 14658: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 14659: if ($line=~/^\s*$/) { next; }
14660: push(@records,$line);
14661: }
14662: return @records;
1.31 albertel 14663: }
14664: }
14665:
1.56 matthew 14666: =pod
14667:
1.648 raeburn 14668: =item * &record_sep($record)
1.41 ng 14669:
1.258 albertel 14670: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 14671:
14672: =cut
14673:
1.263 www 14674: sub takeleft {
14675: my $index=shift;
14676: return substr('0000'.$index,-4,4);
14677: }
14678:
1.31 albertel 14679: sub record_sep {
14680: my $record=shift;
14681: my %components=();
1.258 albertel 14682: if ($env{'form.upfiletype'} eq 'xml') {
14683: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 14684: my $i=0;
1.356 albertel 14685: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 14686: $field=~s/^(\"|\')//;
14687: $field=~s/(\"|\')$//;
1.263 www 14688: $components{&takeleft($i)}=$field;
1.31 albertel 14689: $i++;
14690: }
1.258 albertel 14691: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 14692: my $i=0;
1.356 albertel 14693: foreach my $field (split(/\t/,$record)) {
1.31 albertel 14694: $field=~s/^(\"|\')//;
14695: $field=~s/(\"|\')$//;
1.263 www 14696: $components{&takeleft($i)}=$field;
1.31 albertel 14697: $i++;
14698: }
14699: } else {
1.561 www 14700: my $separator=',';
1.480 banghart 14701: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 14702: $separator=';';
1.480 banghart 14703: }
1.31 albertel 14704: my $i=0;
1.561 www 14705: # the character we are looking for to indicate the end of a quote or a record
14706: my $looking_for=$separator;
14707: # do not add the characters to the fields
14708: my $ignore=0;
14709: # we just encountered a separator (or the beginning of the record)
14710: my $just_found_separator=1;
14711: # store the field we are working on here
14712: my $field='';
14713: # work our way through all characters in record
14714: foreach my $character ($record=~/(.)/g) {
14715: if ($character eq $looking_for) {
14716: if ($character ne $separator) {
14717: # Found the end of a quote, again looking for separator
14718: $looking_for=$separator;
14719: $ignore=1;
14720: } else {
14721: # Found a separator, store away what we got
14722: $components{&takeleft($i)}=$field;
14723: $i++;
14724: $just_found_separator=1;
14725: $ignore=0;
14726: $field='';
14727: }
14728: next;
14729: }
14730: # single or double quotation marks after a separator indicate beginning of a quote
14731: # we are now looking for the end of the quote and need to ignore separators
14732: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
14733: $looking_for=$character;
14734: next;
14735: }
14736: # ignore would be true after we reached the end of a quote
14737: if ($ignore) { next; }
14738: if (($just_found_separator) && ($character=~/\s/)) { next; }
14739: $field.=$character;
14740: $just_found_separator=0;
1.31 albertel 14741: }
1.561 www 14742: # catch the very last entry, since we never encountered the separator
14743: $components{&takeleft($i)}=$field;
1.31 albertel 14744: }
14745: return %components;
14746: }
14747:
1.144 matthew 14748: ######################################################
14749: ######################################################
14750:
1.56 matthew 14751: =pod
14752:
1.648 raeburn 14753: =item * &upfile_select_html()
1.41 ng 14754:
1.144 matthew 14755: Return HTML code to select a file from the users machine and specify
14756: the file type.
1.41 ng 14757:
14758: =cut
14759:
1.144 matthew 14760: ######################################################
14761: ######################################################
1.31 albertel 14762: sub upfile_select_html {
1.144 matthew 14763: my %Types = (
14764: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 14765: semisv => &mt('Semicolon separated values'),
1.144 matthew 14766: space => &mt('Space separated'),
14767: tab => &mt('Tabulator separated'),
14768: # xml => &mt('HTML/XML'),
14769: );
14770: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 14771: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 14772: foreach my $type (sort(keys(%Types))) {
14773: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
14774: }
14775: $Str .= "</select>\n";
14776: return $Str;
1.31 albertel 14777: }
14778:
1.301 albertel 14779: sub get_samples {
14780: my ($records,$toget) = @_;
14781: my @samples=({});
14782: my $got=0;
14783: foreach my $rec (@$records) {
14784: my %temp = &record_sep($rec);
14785: if (! grep(/\S/, values(%temp))) { next; }
14786: if (%temp) {
14787: $samples[$got]=\%temp;
14788: $got++;
14789: if ($got == $toget) { last; }
14790: }
14791: }
14792: return \@samples;
14793: }
14794:
1.144 matthew 14795: ######################################################
14796: ######################################################
14797:
1.56 matthew 14798: =pod
14799:
1.648 raeburn 14800: =item * &csv_print_samples($r,$records)
1.41 ng 14801:
14802: Prints a table of sample values from each column uploaded $r is an
14803: Apache Request ref, $records is an arrayref from
14804: &Apache::loncommon::upfile_record_sep
14805:
14806: =cut
14807:
1.144 matthew 14808: ######################################################
14809: ######################################################
1.31 albertel 14810: sub csv_print_samples {
14811: my ($r,$records) = @_;
1.662 bisitz 14812: my $samples = &get_samples($records,5);
1.301 albertel 14813:
1.594 raeburn 14814: $r->print(&mt('Samples').'<br />'.&start_data_table().
14815: &start_data_table_header_row());
1.356 albertel 14816: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 14817: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 14818: $r->print(&end_data_table_header_row());
1.301 albertel 14819: foreach my $hash (@$samples) {
1.594 raeburn 14820: $r->print(&start_data_table_row());
1.356 albertel 14821: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 14822: $r->print('<td>');
1.356 albertel 14823: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 14824: $r->print('</td>');
14825: }
1.594 raeburn 14826: $r->print(&end_data_table_row());
1.31 albertel 14827: }
1.594 raeburn 14828: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 14829: }
14830:
1.144 matthew 14831: ######################################################
14832: ######################################################
14833:
1.56 matthew 14834: =pod
14835:
1.648 raeburn 14836: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 14837:
14838: Prints a table to create associations between values and table columns.
1.144 matthew 14839:
1.41 ng 14840: $r is an Apache Request ref,
14841: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 14842: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 14843:
14844: =cut
14845:
1.144 matthew 14846: ######################################################
14847: ######################################################
1.31 albertel 14848: sub csv_print_select_table {
14849: my ($r,$records,$d) = @_;
1.301 albertel 14850: my $i=0;
14851: my $samples = &get_samples($records,1);
1.144 matthew 14852: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 14853: &start_data_table().&start_data_table_header_row().
1.144 matthew 14854: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 14855: '<th>'.&mt('Column').'</th>'.
14856: &end_data_table_header_row()."\n");
1.356 albertel 14857: foreach my $array_ref (@$d) {
14858: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 14859: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 14860:
1.875 bisitz 14861: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 14862: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 14863: $r->print('<option value="none"></option>');
1.356 albertel 14864: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
14865: $r->print('<option value="'.$sample.'"'.
14866: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 14867: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 14868: }
1.594 raeburn 14869: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 14870: $i++;
14871: }
1.594 raeburn 14872: $r->print(&end_data_table());
1.31 albertel 14873: $i--;
14874: return $i;
14875: }
1.56 matthew 14876:
1.144 matthew 14877: ######################################################
14878: ######################################################
14879:
1.56 matthew 14880: =pod
1.31 albertel 14881:
1.648 raeburn 14882: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 14883:
14884: Prints a table of sample values from the upload and can make associate samples to internal names.
14885:
14886: $r is an Apache Request ref,
14887: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
14888: $d is an array of 2 element arrays (internal name, displayed name)
14889:
14890: =cut
14891:
1.144 matthew 14892: ######################################################
14893: ######################################################
1.31 albertel 14894: sub csv_samples_select_table {
14895: my ($r,$records,$d) = @_;
14896: my $i=0;
1.144 matthew 14897: #
1.662 bisitz 14898: my $max_samples = 5;
14899: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 14900: $r->print(&start_data_table().
14901: &start_data_table_header_row().'<th>'.
14902: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
14903: &end_data_table_header_row());
1.301 albertel 14904:
14905: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 14906: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 14907: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 14908: foreach my $option (@$d) {
14909: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 14910: $r->print('<option value="'.$value.'"'.
1.253 albertel 14911: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 14912: $display.'</option>');
1.31 albertel 14913: }
14914: $r->print('</select></td><td>');
1.662 bisitz 14915: foreach my $line (0..($max_samples-1)) {
1.301 albertel 14916: if (defined($samples->[$line]{$key})) {
14917: $r->print($samples->[$line]{$key}."<br />\n");
14918: }
14919: }
1.594 raeburn 14920: $r->print('</td>'.&end_data_table_row());
1.31 albertel 14921: $i++;
14922: }
1.594 raeburn 14923: $r->print(&end_data_table());
1.31 albertel 14924: $i--;
14925: return($i);
1.115 matthew 14926: }
14927:
1.144 matthew 14928: ######################################################
14929: ######################################################
14930:
1.115 matthew 14931: =pod
14932:
1.648 raeburn 14933: =item * &clean_excel_name($name)
1.115 matthew 14934:
14935: Returns a replacement for $name which does not contain any illegal characters.
14936:
14937: =cut
14938:
1.144 matthew 14939: ######################################################
14940: ######################################################
1.115 matthew 14941: sub clean_excel_name {
14942: my ($name) = @_;
14943: $name =~ s/[:\*\?\/\\]//g;
14944: if (length($name) > 31) {
14945: $name = substr($name,0,31);
14946: }
14947: return $name;
1.25 albertel 14948: }
1.84 albertel 14949:
1.85 albertel 14950: =pod
14951:
1.648 raeburn 14952: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 14953:
14954: Returns either 1 or undef
14955:
14956: 1 if the part is to be hidden, undef if it is to be shown
14957:
14958: Arguments are:
14959:
14960: $id the id of the part to be checked
14961: $symb, optional the symb of the resource to check
14962: $udom, optional the domain of the user to check for
14963: $uname, optional the username of the user to check for
14964:
14965: =cut
1.84 albertel 14966:
14967: sub check_if_partid_hidden {
14968: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 14969: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 14970: $symb,$udom,$uname);
1.141 albertel 14971: my $truth=1;
14972: #if the string starts with !, then the list is the list to show not hide
14973: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 14974: my @hiddenlist=split(/,/,$hiddenparts);
14975: foreach my $checkid (@hiddenlist) {
1.141 albertel 14976: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 14977: }
1.141 albertel 14978: return !$truth;
1.84 albertel 14979: }
1.127 matthew 14980:
1.138 matthew 14981:
14982: ############################################################
14983: ############################################################
14984:
14985: =pod
14986:
1.157 matthew 14987: =back
14988:
1.138 matthew 14989: =head1 cgi-bin script and graphing routines
14990:
1.157 matthew 14991: =over 4
14992:
1.648 raeburn 14993: =item * &get_cgi_id()
1.138 matthew 14994:
14995: Inputs: none
14996:
14997: Returns an id which can be used to pass environment variables
14998: to various cgi-bin scripts. These environment variables will
14999: be removed from the users environment after a given time by
15000: the routine &Apache::lonnet::transfer_profile_to_env.
15001:
15002: =cut
15003:
15004: ############################################################
15005: ############################################################
1.152 albertel 15006: my $uniq=0;
1.136 matthew 15007: sub get_cgi_id {
1.154 albertel 15008: $uniq=($uniq+1)%100000;
1.280 albertel 15009: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 15010: }
15011:
1.127 matthew 15012: ############################################################
15013: ############################################################
15014:
15015: =pod
15016:
1.648 raeburn 15017: =item * &DrawBarGraph()
1.127 matthew 15018:
1.138 matthew 15019: Facilitates the plotting of data in a (stacked) bar graph.
15020: Puts plot definition data into the users environment in order for
15021: graph.png to plot it. Returns an <img> tag for the plot.
15022: The bars on the plot are labeled '1','2',...,'n'.
15023:
15024: Inputs:
15025:
15026: =over 4
15027:
15028: =item $Title: string, the title of the plot
15029:
15030: =item $xlabel: string, text describing the X-axis of the plot
15031:
15032: =item $ylabel: string, text describing the Y-axis of the plot
15033:
15034: =item $Max: scalar, the maximum Y value to use in the plot
15035: If $Max is < any data point, the graph will not be rendered.
15036:
1.140 matthew 15037: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 15038: they are plotted. If undefined, default values will be used.
15039:
1.178 matthew 15040: =item $labels: array ref holding the labels to use on the x-axis for the bars.
15041:
1.138 matthew 15042: =item @Values: An array of array references. Each array reference holds data
15043: to be plotted in a stacked bar chart.
15044:
1.239 matthew 15045: =item If the final element of @Values is a hash reference the key/value
15046: pairs will be added to the graph definition.
15047:
1.138 matthew 15048: =back
15049:
15050: Returns:
15051:
15052: An <img> tag which references graph.png and the appropriate identifying
15053: information for the plot.
15054:
1.127 matthew 15055: =cut
15056:
15057: ############################################################
15058: ############################################################
1.134 matthew 15059: sub DrawBarGraph {
1.178 matthew 15060: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 15061: #
15062: if (! defined($colors)) {
15063: $colors = ['#33ff00',
15064: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
15065: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
15066: ];
15067: }
1.228 matthew 15068: my $extra_settings = {};
15069: if (ref($Values[-1]) eq 'HASH') {
15070: $extra_settings = pop(@Values);
15071: }
1.127 matthew 15072: #
1.136 matthew 15073: my $identifier = &get_cgi_id();
15074: my $id = 'cgi.'.$identifier;
1.129 matthew 15075: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 15076: return '';
15077: }
1.225 matthew 15078: #
15079: my @Labels;
15080: if (defined($labels)) {
15081: @Labels = @$labels;
15082: } else {
15083: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 15084: push(@Labels,$i+1);
1.225 matthew 15085: }
15086: }
15087: #
1.129 matthew 15088: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 15089: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 15090: my %ValuesHash;
15091: my $NumSets=1;
15092: foreach my $array (@Values) {
15093: next if (! ref($array));
1.136 matthew 15094: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 15095: join(',',@$array);
1.129 matthew 15096: }
1.127 matthew 15097: #
1.136 matthew 15098: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 15099: if ($NumBars < 3) {
15100: $width = 120+$NumBars*32;
1.220 matthew 15101: $xskip = 1;
1.225 matthew 15102: $bar_width = 30;
15103: } elsif ($NumBars < 5) {
15104: $width = 120+$NumBars*20;
15105: $xskip = 1;
15106: $bar_width = 20;
1.220 matthew 15107: } elsif ($NumBars < 10) {
1.136 matthew 15108: $width = 120+$NumBars*15;
15109: $xskip = 1;
15110: $bar_width = 15;
15111: } elsif ($NumBars <= 25) {
15112: $width = 120+$NumBars*11;
15113: $xskip = 5;
15114: $bar_width = 8;
15115: } elsif ($NumBars <= 50) {
15116: $width = 120+$NumBars*8;
15117: $xskip = 5;
15118: $bar_width = 4;
15119: } else {
15120: $width = 120+$NumBars*8;
15121: $xskip = 5;
15122: $bar_width = 4;
15123: }
15124: #
1.137 matthew 15125: $Max = 1 if ($Max < 1);
15126: if ( int($Max) < $Max ) {
15127: $Max++;
15128: $Max = int($Max);
15129: }
1.127 matthew 15130: $Title = '' if (! defined($Title));
15131: $xlabel = '' if (! defined($xlabel));
15132: $ylabel = '' if (! defined($ylabel));
1.369 www 15133: $ValuesHash{$id.'.title'} = &escape($Title);
15134: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
15135: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 15136: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 15137: $ValuesHash{$id.'.NumBars'} = $NumBars;
15138: $ValuesHash{$id.'.NumSets'} = $NumSets;
15139: $ValuesHash{$id.'.PlotType'} = 'bar';
15140: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15141: $ValuesHash{$id.'.height'} = $height;
15142: $ValuesHash{$id.'.width'} = $width;
15143: $ValuesHash{$id.'.xskip'} = $xskip;
15144: $ValuesHash{$id.'.bar_width'} = $bar_width;
15145: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 15146: #
1.228 matthew 15147: # Deal with other parameters
15148: while (my ($key,$value) = each(%$extra_settings)) {
15149: $ValuesHash{$id.'.'.$key} = $value;
15150: }
15151: #
1.646 raeburn 15152: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 15153: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15154: }
15155:
15156: ############################################################
15157: ############################################################
15158:
15159: =pod
15160:
1.648 raeburn 15161: =item * &DrawXYGraph()
1.137 matthew 15162:
1.138 matthew 15163: Facilitates the plotting of data in an XY graph.
15164: Puts plot definition data into the users environment in order for
15165: graph.png to plot it. Returns an <img> tag for the plot.
15166:
15167: Inputs:
15168:
15169: =over 4
15170:
15171: =item $Title: string, the title of the plot
15172:
15173: =item $xlabel: string, text describing the X-axis of the plot
15174:
15175: =item $ylabel: string, text describing the Y-axis of the plot
15176:
15177: =item $Max: scalar, the maximum Y value to use in the plot
15178: If $Max is < any data point, the graph will not be rendered.
15179:
15180: =item $colors: Array ref containing the hex color codes for the data to be
15181: plotted in. If undefined, default values will be used.
15182:
15183: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15184:
15185: =item $Ydata: Array ref containing Array refs.
1.185 www 15186: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 15187:
15188: =item %Values: hash indicating or overriding any default values which are
15189: passed to graph.png.
15190: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15191:
15192: =back
15193:
15194: Returns:
15195:
15196: An <img> tag which references graph.png and the appropriate identifying
15197: information for the plot.
15198:
1.137 matthew 15199: =cut
15200:
15201: ############################################################
15202: ############################################################
15203: sub DrawXYGraph {
15204: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
15205: #
15206: # Create the identifier for the graph
15207: my $identifier = &get_cgi_id();
15208: my $id = 'cgi.'.$identifier;
15209: #
15210: $Title = '' if (! defined($Title));
15211: $xlabel = '' if (! defined($xlabel));
15212: $ylabel = '' if (! defined($ylabel));
15213: my %ValuesHash =
15214: (
1.369 www 15215: $id.'.title' => &escape($Title),
15216: $id.'.xlabel' => &escape($xlabel),
15217: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 15218: $id.'.y_max_value'=> $Max,
15219: $id.'.labels' => join(',',@$Xlabels),
15220: $id.'.PlotType' => 'XY',
15221: );
15222: #
15223: if (defined($colors) && ref($colors) eq 'ARRAY') {
15224: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15225: }
15226: #
15227: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
15228: return '';
15229: }
15230: my $NumSets=1;
1.138 matthew 15231: foreach my $array (@{$Ydata}){
1.137 matthew 15232: next if (! ref($array));
15233: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
15234: }
1.138 matthew 15235: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 15236: #
15237: # Deal with other parameters
15238: while (my ($key,$value) = each(%Values)) {
15239: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 15240: }
15241: #
1.646 raeburn 15242: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 15243: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15244: }
15245:
15246: ############################################################
15247: ############################################################
15248:
15249: =pod
15250:
1.648 raeburn 15251: =item * &DrawXYYGraph()
1.138 matthew 15252:
15253: Facilitates the plotting of data in an XY graph with two Y axes.
15254: Puts plot definition data into the users environment in order for
15255: graph.png to plot it. Returns an <img> tag for the plot.
15256:
15257: Inputs:
15258:
15259: =over 4
15260:
15261: =item $Title: string, the title of the plot
15262:
15263: =item $xlabel: string, text describing the X-axis of the plot
15264:
15265: =item $ylabel: string, text describing the Y-axis of the plot
15266:
15267: =item $colors: Array ref containing the hex color codes for the data to be
15268: plotted in. If undefined, default values will be used.
15269:
15270: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15271:
15272: =item $Ydata1: The first data set
15273:
15274: =item $Min1: The minimum value of the left Y-axis
15275:
15276: =item $Max1: The maximum value of the left Y-axis
15277:
15278: =item $Ydata2: The second data set
15279:
15280: =item $Min2: The minimum value of the right Y-axis
15281:
15282: =item $Max2: The maximum value of the left Y-axis
15283:
15284: =item %Values: hash indicating or overriding any default values which are
15285: passed to graph.png.
15286: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15287:
15288: =back
15289:
15290: Returns:
15291:
15292: An <img> tag which references graph.png and the appropriate identifying
15293: information for the plot.
1.136 matthew 15294:
15295: =cut
15296:
15297: ############################################################
15298: ############################################################
1.137 matthew 15299: sub DrawXYYGraph {
15300: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
15301: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 15302: #
15303: # Create the identifier for the graph
15304: my $identifier = &get_cgi_id();
15305: my $id = 'cgi.'.$identifier;
15306: #
15307: $Title = '' if (! defined($Title));
15308: $xlabel = '' if (! defined($xlabel));
15309: $ylabel = '' if (! defined($ylabel));
15310: my %ValuesHash =
15311: (
1.369 www 15312: $id.'.title' => &escape($Title),
15313: $id.'.xlabel' => &escape($xlabel),
15314: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 15315: $id.'.labels' => join(',',@$Xlabels),
15316: $id.'.PlotType' => 'XY',
15317: $id.'.NumSets' => 2,
1.137 matthew 15318: $id.'.two_axes' => 1,
15319: $id.'.y1_max_value' => $Max1,
15320: $id.'.y1_min_value' => $Min1,
15321: $id.'.y2_max_value' => $Max2,
15322: $id.'.y2_min_value' => $Min2,
1.136 matthew 15323: );
15324: #
1.137 matthew 15325: if (defined($colors) && ref($colors) eq 'ARRAY') {
15326: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15327: }
15328: #
15329: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
15330: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 15331: return '';
15332: }
15333: my $NumSets=1;
1.137 matthew 15334: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 15335: next if (! ref($array));
15336: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 15337: }
15338: #
15339: # Deal with other parameters
15340: while (my ($key,$value) = each(%Values)) {
15341: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 15342: }
15343: #
1.646 raeburn 15344: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 15345: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 15346: }
15347:
15348: ############################################################
15349: ############################################################
15350:
15351: =pod
15352:
1.157 matthew 15353: =back
15354:
1.139 matthew 15355: =head1 Statistics helper routines?
15356:
15357: Bad place for them but what the hell.
15358:
1.157 matthew 15359: =over 4
15360:
1.648 raeburn 15361: =item * &chartlink()
1.139 matthew 15362:
15363: Returns a link to the chart for a specific student.
15364:
15365: Inputs:
15366:
15367: =over 4
15368:
15369: =item $linktext: The text of the link
15370:
15371: =item $sname: The students username
15372:
15373: =item $sdomain: The students domain
15374:
15375: =back
15376:
1.157 matthew 15377: =back
15378:
1.139 matthew 15379: =cut
15380:
15381: ############################################################
15382: ############################################################
15383: sub chartlink {
15384: my ($linktext, $sname, $sdomain) = @_;
15385: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 15386: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 15387: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 15388: '">'.$linktext.'</a>';
1.153 matthew 15389: }
15390:
15391: #######################################################
15392: #######################################################
15393:
15394: =pod
15395:
15396: =head1 Course Environment Routines
1.157 matthew 15397:
15398: =over 4
1.153 matthew 15399:
1.648 raeburn 15400: =item * &restore_course_settings()
1.153 matthew 15401:
1.648 raeburn 15402: =item * &store_course_settings()
1.153 matthew 15403:
15404: Restores/Store indicated form parameters from the course environment.
15405: Will not overwrite existing values of the form parameters.
15406:
15407: Inputs:
15408: a scalar describing the data (e.g. 'chart', 'problem_analysis')
15409:
15410: a hash ref describing the data to be stored. For example:
15411:
15412: %Save_Parameters = ('Status' => 'scalar',
15413: 'chartoutputmode' => 'scalar',
15414: 'chartoutputdata' => 'scalar',
15415: 'Section' => 'array',
1.373 raeburn 15416: 'Group' => 'array',
1.153 matthew 15417: 'StudentData' => 'array',
15418: 'Maps' => 'array');
15419:
15420: Returns: both routines return nothing
15421:
1.631 raeburn 15422: =back
15423:
1.153 matthew 15424: =cut
15425:
15426: #######################################################
15427: #######################################################
15428: sub store_course_settings {
1.496 albertel 15429: return &store_settings($env{'request.course.id'},@_);
15430: }
15431:
15432: sub store_settings {
1.153 matthew 15433: # save to the environment
15434: # appenv the same items, just to be safe
1.300 albertel 15435: my $udom = $env{'user.domain'};
15436: my $uname = $env{'user.name'};
1.496 albertel 15437: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15438: my %SaveHash;
15439: my %AppHash;
15440: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 15441: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 15442: my $envname = 'environment.'.$basename;
1.258 albertel 15443: if (exists($env{'form.'.$setting})) {
1.153 matthew 15444: # Save this value away
15445: if ($type eq 'scalar' &&
1.258 albertel 15446: (! exists($env{$envname}) ||
15447: $env{$envname} ne $env{'form.'.$setting})) {
15448: $SaveHash{$basename} = $env{'form.'.$setting};
15449: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 15450: } elsif ($type eq 'array') {
15451: my $stored_form;
1.258 albertel 15452: if (ref($env{'form.'.$setting})) {
1.153 matthew 15453: $stored_form = join(',',
15454: map {
1.369 www 15455: &escape($_);
1.258 albertel 15456: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 15457: } else {
15458: $stored_form =
1.369 www 15459: &escape($env{'form.'.$setting});
1.153 matthew 15460: }
15461: # Determine if the array contents are the same.
1.258 albertel 15462: if ($stored_form ne $env{$envname}) {
1.153 matthew 15463: $SaveHash{$basename} = $stored_form;
15464: $AppHash{$envname} = $stored_form;
15465: }
15466: }
15467: }
15468: }
15469: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 15470: $udom,$uname);
1.153 matthew 15471: if ($put_result !~ /^(ok|delayed)/) {
15472: &Apache::lonnet::logthis('unable to save form parameters, '.
15473: 'got error:'.$put_result);
15474: }
15475: # Make sure these settings stick around in this session, too
1.646 raeburn 15476: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 15477: return;
15478: }
15479:
15480: sub restore_course_settings {
1.499 albertel 15481: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 15482: }
15483:
15484: sub restore_settings {
15485: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15486: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 15487: next if (exists($env{'form.'.$setting}));
1.496 albertel 15488: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 15489: '.'.$setting;
1.258 albertel 15490: if (exists($env{$envname})) {
1.153 matthew 15491: if ($type eq 'scalar') {
1.258 albertel 15492: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 15493: } elsif ($type eq 'array') {
1.258 albertel 15494: $env{'form.'.$setting} = [
1.153 matthew 15495: map {
1.369 www 15496: &unescape($_);
1.258 albertel 15497: } split(',',$env{$envname})
1.153 matthew 15498: ];
15499: }
15500: }
15501: }
1.127 matthew 15502: }
15503:
1.618 raeburn 15504: #######################################################
15505: #######################################################
15506:
15507: =pod
15508:
15509: =head1 Domain E-mail Routines
15510:
15511: =over 4
15512:
1.648 raeburn 15513: =item * &build_recipient_list()
1.618 raeburn 15514:
1.1144 raeburn 15515: Build recipient lists for following types of e-mail:
1.766 raeburn 15516: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 15517: (d) Help requests, (e) Course requests needing approval, (f) loncapa
15518: module change checking, student/employee ID conflict checks, as
15519: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
15520: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 15521:
15522: Inputs:
1.619 raeburn 15523: defmail (scalar - email address of default recipient),
1.1144 raeburn 15524: mailing type (scalar: errormail, packagesmail, helpdeskmail,
15525: requestsmail, updatesmail, or idconflictsmail).
15526:
1.619 raeburn 15527: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 15528:
1.619 raeburn 15529: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 15530: i.e., predates configuration by DC via domainprefs.pm
15531:
15532: $requname username of requester (if mailing type is helpdeskmail)
15533:
15534: $requdom domain of requester (if mailing type is helpdeskmail)
15535:
15536: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
15537:
1.618 raeburn 15538:
1.655 raeburn 15539: Returns: comma separated list of addresses to which to send e-mail.
15540:
15541: =back
1.618 raeburn 15542:
15543: =cut
15544:
15545: ############################################################
15546: ############################################################
15547: sub build_recipient_list {
1.1297 raeburn 15548: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 15549: my @recipients;
1.1270 raeburn 15550: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 15551: my %domconfig =
1.1270 raeburn 15552: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 15553: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 15554: if (exists($domconfig{'contacts'}{$mailing})) {
15555: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
15556: my @contacts = ('adminemail','supportemail');
15557: foreach my $item (@contacts) {
15558: if ($domconfig{'contacts'}{$mailing}{$item}) {
15559: my $addr = $domconfig{'contacts'}{$item};
15560: if (!grep(/^\Q$addr\E$/,@recipients)) {
15561: push(@recipients,$addr);
15562: }
1.619 raeburn 15563: }
1.1270 raeburn 15564: }
15565: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
15566: if ($mailing eq 'helpdeskmail') {
15567: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
15568: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
15569: my @ok_bccs;
15570: foreach my $bcc (@bccs) {
15571: $bcc =~ s/^\s+//g;
15572: $bcc =~ s/\s+$//g;
15573: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15574: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15575: push(@ok_bccs,$bcc);
15576: }
15577: }
15578: }
15579: if (@ok_bccs > 0) {
15580: $allbcc = join(', ',@ok_bccs);
15581: }
15582: }
15583: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 15584: }
15585: }
1.766 raeburn 15586: } elsif ($origmail ne '') {
1.1270 raeburn 15587: $lastresort = $origmail;
1.618 raeburn 15588: }
1.1297 raeburn 15589: if ($mailing eq 'helpdeskmail') {
15590: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
15591: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
15592: my ($inststatus,$inststatus_checked);
15593: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
15594: ($env{'user.domain'} ne 'public')) {
15595: $inststatus_checked = 1;
15596: $inststatus = $env{'environment.inststatus'};
15597: }
15598: unless ($inststatus_checked) {
15599: if (($requname ne '') && ($requdom ne '')) {
15600: if (($requname =~ /^$match_username$/) &&
15601: ($requdom =~ /^$match_domain$/) &&
15602: (&Apache::lonnet::domain($requdom))) {
15603: my $requhome = &Apache::lonnet::homeserver($requname,
15604: $requdom);
15605: unless ($requhome eq 'no_host') {
15606: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
15607: $inststatus = $userenv{'inststatus'};
15608: $inststatus_checked = 1;
15609: }
15610: }
15611: }
15612: }
15613: unless ($inststatus_checked) {
15614: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
15615: my %srch = (srchby => 'email',
15616: srchdomain => $defdom,
15617: srchterm => $reqemail,
15618: srchtype => 'exact');
15619: my %srch_results = &Apache::lonnet::usersearch(\%srch);
15620: foreach my $uname (keys(%srch_results)) {
15621: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15622: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15623: $inststatus_checked = 1;
15624: last;
15625: }
15626: }
15627: unless ($inststatus_checked) {
15628: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
15629: if ($dirsrchres eq 'ok') {
15630: foreach my $uname (keys(%srch_results)) {
15631: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15632: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15633: $inststatus_checked = 1;
15634: last;
15635: }
15636: }
15637: }
15638: }
15639: }
15640: }
15641: if ($inststatus ne '') {
15642: foreach my $status (split(/\:/,$inststatus)) {
15643: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
15644: my @contacts = ('adminemail','supportemail');
15645: foreach my $item (@contacts) {
15646: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
15647: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
15648: if (!grep(/^\Q$addr\E$/,@recipients)) {
15649: push(@recipients,$addr);
15650: }
15651: }
15652: }
15653: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
15654: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
15655: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
15656: my @ok_bccs;
15657: foreach my $bcc (@bccs) {
15658: $bcc =~ s/^\s+//g;
15659: $bcc =~ s/\s+$//g;
15660: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15661: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15662: push(@ok_bccs,$bcc);
15663: }
15664: }
15665: }
15666: if (@ok_bccs > 0) {
15667: $allbcc = join(', ',@ok_bccs);
15668: }
15669: }
15670: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
15671: last;
15672: }
15673: }
15674: }
15675: }
15676: }
1.619 raeburn 15677: } elsif ($origmail ne '') {
1.1270 raeburn 15678: $lastresort = $origmail;
15679: }
1.1297 raeburn 15680: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 15681: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
15682: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
15683: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
15684: my %what = (
15685: perlvar => 1,
15686: );
15687: my $primary = &Apache::lonnet::domain($defdom,'primary');
15688: if ($primary) {
15689: my $gotaddr;
15690: my ($result,$returnhash) =
15691: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
15692: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
15693: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
15694: $lastresort = $returnhash->{'lonSupportEMail'};
15695: $gotaddr = 1;
15696: }
15697: }
15698: unless ($gotaddr) {
15699: my $uintdom = &Apache::lonnet::internet_dom($primary);
15700: my $intdom = &Apache::lonnet::internet_dom($lonhost);
15701: unless ($uintdom eq $intdom) {
15702: my %domconfig =
15703: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
15704: if (ref($domconfig{'contacts'}) eq 'HASH') {
15705: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
15706: my @contacts = ('adminemail','supportemail');
15707: foreach my $item (@contacts) {
15708: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
15709: my $addr = $domconfig{'contacts'}{$item};
15710: if (!grep(/^\Q$addr\E$/,@recipients)) {
15711: push(@recipients,$addr);
15712: }
15713: }
15714: }
15715: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
15716: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
15717: }
15718: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
15719: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
15720: my @ok_bccs;
15721: foreach my $bcc (@bccs) {
15722: $bcc =~ s/^\s+//g;
15723: $bcc =~ s/\s+$//g;
15724: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15725: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15726: push(@ok_bccs,$bcc);
15727: }
15728: }
15729: }
15730: if (@ok_bccs > 0) {
15731: $allbcc = join(', ',@ok_bccs);
15732: }
15733: }
15734: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
15735: }
15736: }
15737: }
15738: }
15739: }
15740: }
1.618 raeburn 15741: }
1.688 raeburn 15742: if (defined($defmail)) {
15743: if ($defmail ne '') {
15744: push(@recipients,$defmail);
15745: }
1.618 raeburn 15746: }
15747: if ($otheremails) {
1.619 raeburn 15748: my @others;
15749: if ($otheremails =~ /,/) {
15750: @others = split(/,/,$otheremails);
1.618 raeburn 15751: } else {
1.619 raeburn 15752: push(@others,$otheremails);
15753: }
15754: foreach my $addr (@others) {
15755: if (!grep(/^\Q$addr\E$/,@recipients)) {
15756: push(@recipients,$addr);
15757: }
1.618 raeburn 15758: }
15759: }
1.1298 raeburn 15760: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 15761: if ((!@recipients) && ($lastresort ne '')) {
15762: push(@recipients,$lastresort);
15763: }
15764: } elsif ($lastresort ne '') {
15765: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
15766: push(@recipients,$lastresort);
15767: }
15768: }
1.1271 raeburn 15769: my $recipientlist = join(',',@recipients);
1.1270 raeburn 15770: if (wantarray) {
15771: return ($recipientlist,$allbcc,$addtext);
15772: } else {
15773: return $recipientlist;
15774: }
1.618 raeburn 15775: }
15776:
1.127 matthew 15777: ############################################################
15778: ############################################################
1.154 albertel 15779:
1.655 raeburn 15780: =pod
15781:
1.1224 musolffc 15782: =over 4
15783:
1.1223 musolffc 15784: =item * &mime_email()
15785:
15786: Sends an email with a possible attachment
15787:
15788: Inputs:
15789:
15790: =over 4
15791:
15792: from - Sender's email address
15793:
1.1343 raeburn 15794: replyto - Reply-To email address
15795:
1.1223 musolffc 15796: to - Email address of recipient
15797:
15798: subject - Subject of email
15799:
15800: body - Body of email
15801:
15802: cc_string - Carbon copy email address
15803:
15804: bcc - Blind carbon copy email address
15805:
15806: attachment_path - Path of file to be attached
15807:
15808: file_name - Name of file to be attached
15809:
15810: attachment_text - The body of an attachment of type "TEXT"
15811:
15812: =back
15813:
15814: =back
15815:
15816: =cut
15817:
15818: ############################################################
15819: ############################################################
15820:
15821: sub mime_email {
1.1343 raeburn 15822: my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
15823: $file_name,$attachment_text) = @_;
15824:
1.1223 musolffc 15825: my $msg = MIME::Lite->new(
15826: From => $from,
15827: To => $to,
15828: Subject => $subject,
15829: Type =>'TEXT',
15830: Data => $body,
15831: );
1.1343 raeburn 15832: if ($replyto ne '') {
15833: $msg->add("Reply-To" => $replyto);
15834: }
1.1223 musolffc 15835: if ($cc_string ne '') {
15836: $msg->add("Cc" => $cc_string);
15837: }
15838: if ($bcc ne '') {
15839: $msg->add("Bcc" => $bcc);
15840: }
15841: $msg->attr("content-type" => "text/plain");
15842: $msg->attr("content-type.charset" => "UTF-8");
15843: # Attach file if given
15844: if ($attachment_path) {
15845: unless ($file_name) {
15846: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
15847: }
15848: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
15849: $msg->attach(Type => $type,
15850: Path => $attachment_path,
15851: Filename => $file_name
15852: );
15853: # Otherwise attach text if given
15854: } elsif ($attachment_text) {
15855: $msg->attach(Type => 'TEXT',
15856: Data => $attachment_text);
15857: }
15858: # Send it
15859: $msg->send('sendmail');
15860: }
15861:
15862: ############################################################
15863: ############################################################
15864:
15865: =pod
15866:
1.655 raeburn 15867: =head1 Course Catalog Routines
15868:
15869: =over 4
15870:
15871: =item * &gather_categories()
15872:
15873: Converts category definitions - keys of categories hash stored in
15874: coursecategories in configuration.db on the primary library server in a
15875: domain - to an array. Also generates javascript and idx hash used to
15876: generate Domain Coordinator interface for editing Course Categories.
15877:
15878: Inputs:
1.663 raeburn 15879:
1.655 raeburn 15880: categories (reference to hash of category definitions).
1.663 raeburn 15881:
1.655 raeburn 15882: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15883: categories and subcategories).
1.663 raeburn 15884:
1.655 raeburn 15885: idx (reference to hash of counters used in Domain Coordinator interface for
15886: editing Course Categories).
1.663 raeburn 15887:
1.655 raeburn 15888: jsarray (reference to array of categories used to create Javascript arrays for
15889: Domain Coordinator interface for editing Course Categories).
15890:
15891: Returns: nothing
15892:
15893: Side effects: populates cats, idx and jsarray.
15894:
15895: =cut
15896:
15897: sub gather_categories {
15898: my ($categories,$cats,$idx,$jsarray) = @_;
15899: my %counters;
15900: my $num = 0;
15901: foreach my $item (keys(%{$categories})) {
15902: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
15903: if ($container eq '' && $depth == 0) {
15904: $cats->[$depth][$categories->{$item}] = $cat;
15905: } else {
15906: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
15907: }
15908: my ($escitem,$tail) = split(/:/,$item,2);
15909: if ($counters{$tail} eq '') {
15910: $counters{$tail} = $num;
15911: $num ++;
15912: }
15913: if (ref($idx) eq 'HASH') {
15914: $idx->{$item} = $counters{$tail};
15915: }
15916: if (ref($jsarray) eq 'ARRAY') {
15917: push(@{$jsarray->[$counters{$tail}]},$item);
15918: }
15919: }
15920: return;
15921: }
15922:
15923: =pod
15924:
15925: =item * &extract_categories()
15926:
15927: Used to generate breadcrumb trails for course categories.
15928:
15929: Inputs:
1.663 raeburn 15930:
1.655 raeburn 15931: categories (reference to hash of category definitions).
1.663 raeburn 15932:
1.655 raeburn 15933: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15934: categories and subcategories).
1.663 raeburn 15935:
1.655 raeburn 15936: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 15937:
1.655 raeburn 15938: allitems (reference to hash - key is category key
15939: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15940:
1.655 raeburn 15941: idx (reference to hash of counters used in Domain Coordinator interface for
15942: editing Course Categories).
1.663 raeburn 15943:
1.655 raeburn 15944: jsarray (reference to array of categories used to create Javascript arrays for
15945: Domain Coordinator interface for editing Course Categories).
15946:
1.665 raeburn 15947: subcats (reference to hash of arrays containing all subcategories within each
15948: category, -recursive)
15949:
1.1321 raeburn 15950: maxd (reference to hash used to hold max depth for all top-level categories).
15951:
1.655 raeburn 15952: Returns: nothing
15953:
15954: Side effects: populates trails and allitems hash references.
15955:
15956: =cut
15957:
15958: sub extract_categories {
1.1321 raeburn 15959: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 15960: if (ref($categories) eq 'HASH') {
15961: &gather_categories($categories,$cats,$idx,$jsarray);
15962: if (ref($cats->[0]) eq 'ARRAY') {
15963: for (my $i=0; $i<@{$cats->[0]}; $i++) {
15964: my $name = $cats->[0][$i];
15965: my $item = &escape($name).'::0';
15966: my $trailstr;
15967: if ($name eq 'instcode') {
15968: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 15969: } elsif ($name eq 'communities') {
15970: $trailstr = &mt('Communities');
1.1239 raeburn 15971: } elsif ($name eq 'placement') {
15972: $trailstr = &mt('Placement Tests');
1.655 raeburn 15973: } else {
15974: $trailstr = $name;
15975: }
15976: if ($allitems->{$item} eq '') {
15977: push(@{$trails},$trailstr);
15978: $allitems->{$item} = scalar(@{$trails})-1;
15979: }
15980: my @parents = ($name);
15981: if (ref($cats->[1]{$name}) eq 'ARRAY') {
15982: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
15983: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 15984: if (ref($subcats) eq 'HASH') {
15985: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
15986: }
1.1321 raeburn 15987: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 15988: }
15989: } else {
15990: if (ref($subcats) eq 'HASH') {
15991: $subcats->{$item} = [];
1.655 raeburn 15992: }
1.1321 raeburn 15993: if (ref($maxd) eq 'HASH') {
15994: $maxd->{$name} = 1;
15995: }
1.655 raeburn 15996: }
15997: }
15998: }
15999: }
16000: return;
16001: }
16002:
16003: =pod
16004:
1.1162 raeburn 16005: =item * &recurse_categories()
1.655 raeburn 16006:
16007: Recursively used to generate breadcrumb trails for course categories.
16008:
16009: Inputs:
1.663 raeburn 16010:
1.655 raeburn 16011: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16012: categories and subcategories).
1.663 raeburn 16013:
1.655 raeburn 16014: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 16015:
16016: category (current course category, for which breadcrumb trail is being generated).
16017:
16018: trails (reference to array of breadcrumb trails for each category).
16019:
1.655 raeburn 16020: allitems (reference to hash - key is category key
16021: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16022:
1.655 raeburn 16023: parents (array containing containers directories for current category,
16024: back to top level).
16025:
16026: Returns: nothing
16027:
16028: Side effects: populates trails and allitems hash references
16029:
16030: =cut
16031:
16032: sub recurse_categories {
1.1321 raeburn 16033: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 16034: my $shallower = $depth - 1;
16035: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
16036: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
16037: my $name = $cats->[$depth]{$category}[$k];
16038: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16039: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16040: if ($allitems->{$item} eq '') {
16041: push(@{$trails},$trailstr);
16042: $allitems->{$item} = scalar(@{$trails})-1;
16043: }
16044: my $deeper = $depth+1;
16045: push(@{$parents},$category);
1.665 raeburn 16046: if (ref($subcats) eq 'HASH') {
16047: my $subcat = &escape($name).':'.$category.':'.$depth;
16048: for (my $j=@{$parents}; $j>=0; $j--) {
16049: my $higher;
16050: if ($j > 0) {
16051: $higher = &escape($parents->[$j]).':'.
16052: &escape($parents->[$j-1]).':'.$j;
16053: } else {
16054: $higher = &escape($parents->[$j]).'::'.$j;
16055: }
16056: push(@{$subcats->{$higher}},$subcat);
16057: }
16058: }
16059: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321 raeburn 16060: $subcats,$maxd);
1.655 raeburn 16061: pop(@{$parents});
16062: }
16063: } else {
16064: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16065: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16066: if ($allitems->{$item} eq '') {
16067: push(@{$trails},$trailstr);
16068: $allitems->{$item} = scalar(@{$trails})-1;
16069: }
1.1321 raeburn 16070: if (ref($maxd) eq 'HASH') {
16071: if ($depth > $maxd->{$parents->[0]}) {
16072: $maxd->{$parents->[0]} = $depth;
16073: }
16074: }
1.655 raeburn 16075: }
16076: return;
16077: }
16078:
1.663 raeburn 16079: =pod
16080:
1.1162 raeburn 16081: =item * &assign_categories_table()
1.663 raeburn 16082:
16083: Create a datatable for display of hierarchical categories in a domain,
16084: with checkboxes to allow a course to be categorized.
16085:
16086: Inputs:
16087:
16088: cathash - reference to hash of categories defined for the domain (from
16089: configuration.db)
16090:
16091: currcat - scalar with an & separated list of categories assigned to a course.
16092:
1.919 raeburn 16093: type - scalar contains course type (Course or Community).
16094:
1.1260 raeburn 16095: disabled - scalar (optional) contains disabled="disabled" if input elements are
16096: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16097:
1.663 raeburn 16098: Returns: $output (markup to be displayed)
16099:
16100: =cut
16101:
16102: sub assign_categories_table {
1.1259 raeburn 16103: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 16104: my $output;
16105: if (ref($cathash) eq 'HASH') {
1.1321 raeburn 16106: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
16107: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 16108: $maxdepth = scalar(@cats);
16109: if (@cats > 0) {
16110: my $itemcount = 0;
16111: if (ref($cats[0]) eq 'ARRAY') {
16112: my @currcategories;
16113: if ($currcat ne '') {
16114: @currcategories = split('&',$currcat);
16115: }
1.919 raeburn 16116: my $table;
1.663 raeburn 16117: for (my $i=0; $i<@{$cats[0]}; $i++) {
16118: my $parent = $cats[0][$i];
1.919 raeburn 16119: next if ($parent eq 'instcode');
16120: if ($type eq 'Community') {
16121: next unless ($parent eq 'communities');
1.1239 raeburn 16122: } elsif ($type eq 'Placement') {
16123: next unless ($parent eq 'placement');
1.919 raeburn 16124: } else {
1.1239 raeburn 16125: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 16126: }
1.663 raeburn 16127: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
16128: my $item = &escape($parent).'::0';
16129: my $checked = '';
16130: if (@currcategories > 0) {
16131: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 16132: $checked = ' checked="checked"';
1.663 raeburn 16133: }
16134: }
1.919 raeburn 16135: my $parent_title = $parent;
16136: if ($parent eq 'communities') {
16137: $parent_title = &mt('Communities');
1.1239 raeburn 16138: } elsif ($parent eq 'placement') {
16139: $parent_title = &mt('Placement Tests');
1.919 raeburn 16140: }
16141: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
16142: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16143: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 16144: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 16145: my $depth = 1;
16146: push(@path,$parent);
1.1259 raeburn 16147: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 16148: pop(@path);
1.919 raeburn 16149: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 16150: $itemcount ++;
16151: }
1.919 raeburn 16152: if ($itemcount) {
16153: $output = &Apache::loncommon::start_data_table().
16154: $table.
16155: &Apache::loncommon::end_data_table();
16156: }
1.663 raeburn 16157: }
16158: }
16159: }
16160: return $output;
16161: }
16162:
16163: =pod
16164:
1.1162 raeburn 16165: =item * &assign_category_rows()
1.663 raeburn 16166:
16167: Create a datatable row for display of nested categories in a domain,
16168: with checkboxes to allow a course to be categorized,called recursively.
16169:
16170: Inputs:
16171:
16172: itemcount - track row number for alternating colors
16173:
16174: cats - reference to array of arrays/hashes which encapsulates hierarchy of
16175: categories and subcategories.
16176:
16177: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
16178:
16179: parent - parent of current category item
16180:
16181: path - Array containing all categories back up through the hierarchy from the
16182: current category to the top level.
16183:
16184: currcategories - reference to array of current categories assigned to the course
16185:
1.1260 raeburn 16186: disabled - scalar (optional) contains disabled="disabled" if input elements are
16187: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16188:
1.663 raeburn 16189: Returns: $output (markup to be displayed).
16190:
16191: =cut
16192:
16193: sub assign_category_rows {
1.1259 raeburn 16194: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 16195: my ($text,$name,$item,$chgstr);
16196: if (ref($cats) eq 'ARRAY') {
16197: my $maxdepth = scalar(@{$cats});
16198: if (ref($cats->[$depth]) eq 'HASH') {
16199: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
16200: my $numchildren = @{$cats->[$depth]{$parent}};
16201: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 16202: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 16203: for (my $j=0; $j<$numchildren; $j++) {
16204: $name = $cats->[$depth]{$parent}[$j];
16205: $item = &escape($name).':'.&escape($parent).':'.$depth;
16206: my $deeper = $depth+1;
16207: my $checked = '';
16208: if (ref($currcategories) eq 'ARRAY') {
16209: if (@{$currcategories} > 0) {
16210: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 16211: $checked = ' checked="checked"';
1.663 raeburn 16212: }
16213: }
16214: }
1.664 raeburn 16215: $text .= '<tr><td><span class="LC_nobreak"><label>'.
16216: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16217: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 16218: '<input type="hidden" name="catname" value="'.$name.'" />'.
16219: '</td><td>';
1.663 raeburn 16220: if (ref($path) eq 'ARRAY') {
16221: push(@{$path},$name);
1.1259 raeburn 16222: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 16223: pop(@{$path});
16224: }
16225: $text .= '</td></tr>';
16226: }
16227: $text .= '</table></td>';
16228: }
16229: }
16230: }
16231: return $text;
16232: }
16233:
1.1181 raeburn 16234: =pod
16235:
16236: =back
16237:
16238: =cut
16239:
1.655 raeburn 16240: ############################################################
16241: ############################################################
16242:
16243:
1.443 albertel 16244: sub commit_customrole {
1.664 raeburn 16245: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 16246: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 16247: ($start?', '.&mt('starting').' '.localtime($start):'').
16248: ($end?', ending '.localtime($end):'').': <b>'.
16249: &Apache::lonnet::assigncustomrole(
1.664 raeburn 16250: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 16251: '</b><br />';
16252: return $output;
16253: }
16254:
16255: sub commit_standardrole {
1.1116 raeburn 16256: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 16257: my ($output,$logmsg,$linefeed);
16258: if ($context eq 'auto') {
16259: $linefeed = "\n";
16260: } else {
16261: $linefeed = "<br />\n";
16262: }
1.443 albertel 16263: if ($three eq 'st') {
1.541 raeburn 16264: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 16265: $one,$two,$sec,$context,$credits);
1.541 raeburn 16266: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 16267: ($result eq 'unknown_course') || ($result eq 'refused')) {
16268: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 16269: } else {
1.541 raeburn 16270: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 16271: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16272: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
16273: if ($context eq 'auto') {
16274: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
16275: } else {
16276: $output .= '<b>'.$result.'</b>'.$linefeed.
16277: &mt('Add to classlist').': <b>ok</b>';
16278: }
16279: $output .= $linefeed;
1.443 albertel 16280: }
16281: } else {
16282: $output = &mt('Assigning').' '.$three.' in '.$url.
16283: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16284: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 16285: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 16286: if ($context eq 'auto') {
16287: $output .= $result.$linefeed;
16288: } else {
16289: $output .= '<b>'.$result.'</b>'.$linefeed;
16290: }
1.443 albertel 16291: }
16292: return $output;
16293: }
16294:
16295: sub commit_studentrole {
1.1116 raeburn 16296: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
16297: $credits) = @_;
1.626 raeburn 16298: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 16299: if ($context eq 'auto') {
16300: $linefeed = "\n";
16301: } else {
16302: $linefeed = '<br />'."\n";
16303: }
1.443 albertel 16304: if (defined($one) && defined($two)) {
16305: my $cid=$one.'_'.$two;
16306: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
16307: my $secchange = 0;
16308: my $expire_role_result;
16309: my $modify_section_result;
1.628 raeburn 16310: if ($oldsec ne '-1') {
16311: if ($oldsec ne $sec) {
1.443 albertel 16312: $secchange = 1;
1.628 raeburn 16313: my $now = time;
1.443 albertel 16314: my $uurl='/'.$cid;
16315: $uurl=~s/\_/\//g;
16316: if ($oldsec) {
16317: $uurl.='/'.$oldsec;
16318: }
1.626 raeburn 16319: $oldsecurl = $uurl;
1.628 raeburn 16320: $expire_role_result =
1.652 raeburn 16321: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 16322: if ($env{'request.course.sec'} ne '') {
16323: if ($expire_role_result eq 'refused') {
16324: my @roles = ('st');
16325: my @statuses = ('previous');
16326: my @roledoms = ($one);
16327: my $withsec = 1;
16328: my %roleshash =
16329: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
16330: \@statuses,\@roles,\@roledoms,$withsec);
16331: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
16332: my ($oldstart,$oldend) =
16333: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
16334: if ($oldend > 0 && $oldend <= $now) {
16335: $expire_role_result = 'ok';
16336: }
16337: }
16338: }
16339: }
1.443 albertel 16340: $result = $expire_role_result;
16341: }
16342: }
16343: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 16344: $modify_section_result =
16345: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
16346: undef,undef,undef,$sec,
16347: $end,$start,'','',$cid,
16348: '',$context,$credits);
1.443 albertel 16349: if ($modify_section_result =~ /^ok/) {
16350: if ($secchange == 1) {
1.628 raeburn 16351: if ($sec eq '') {
16352: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
16353: } else {
16354: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
16355: }
1.443 albertel 16356: } elsif ($oldsec eq '-1') {
1.628 raeburn 16357: if ($sec eq '') {
16358: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
16359: } else {
16360: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16361: }
1.443 albertel 16362: } else {
1.628 raeburn 16363: if ($sec eq '') {
16364: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
16365: } else {
16366: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16367: }
1.443 albertel 16368: }
16369: } else {
1.1115 raeburn 16370: if ($secchange) {
1.628 raeburn 16371: $$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;
16372: } else {
16373: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
16374: }
1.443 albertel 16375: }
16376: $result = $modify_section_result;
16377: } elsif ($secchange == 1) {
1.628 raeburn 16378: if ($oldsec eq '') {
1.1103 raeburn 16379: $$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 16380: } else {
16381: $$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;
16382: }
1.626 raeburn 16383: if ($expire_role_result eq 'refused') {
16384: my $newsecurl = '/'.$cid;
16385: $newsecurl =~ s/\_/\//g;
16386: if ($sec ne '') {
16387: $newsecurl.='/'.$sec;
16388: }
16389: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
16390: if ($sec eq '') {
16391: $$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;
16392: } else {
16393: $$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;
16394: }
16395: }
16396: }
1.443 albertel 16397: }
16398: } else {
1.626 raeburn 16399: $$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 16400: $result = "error: incomplete course id\n";
16401: }
16402: return $result;
16403: }
16404:
1.1108 raeburn 16405: sub show_role_extent {
16406: my ($scope,$context,$role) = @_;
16407: $scope =~ s{^/}{};
16408: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
16409: push(@courseroles,'co');
16410: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
16411: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
16412: $scope =~ s{/}{_};
16413: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
16414: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
16415: my ($audom,$auname) = split(/\//,$scope);
16416: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
16417: &Apache::loncommon::plainname($auname,$audom).'</span>');
16418: } else {
16419: $scope =~ s{/$}{};
16420: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
16421: &Apache::lonnet::domain($scope,'description').'</span>');
16422: }
16423: }
16424:
1.443 albertel 16425: ############################################################
16426: ############################################################
16427:
1.566 albertel 16428: sub check_clone {
1.578 raeburn 16429: my ($args,$linefeed) = @_;
1.566 albertel 16430: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
16431: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
16432: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344 raeburn 16433: my $clonetitle;
16434: my @clonemsg;
1.566 albertel 16435: my $can_clone = 0;
1.944 raeburn 16436: my $lctype = lc($args->{'crstype'});
1.908 raeburn 16437: if ($lctype ne 'community') {
16438: $lctype = 'course';
16439: }
1.566 albertel 16440: if ($clonehome eq 'no_host') {
1.944 raeburn 16441: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16442: push(@clonemsg,({
16443: mt => 'No new community created.',
16444: args => [],
16445: },
16446: {
16447: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
16448: args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
16449: }));
1.908 raeburn 16450: } else {
1.1344 raeburn 16451: push(@clonemsg,({
16452: mt => 'No new course created.',
16453: args => [],
16454: },
16455: {
16456: mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
16457: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16458: }));
16459: }
1.566 albertel 16460: } else {
16461: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344 raeburn 16462: $clonetitle = $clonedesc{'description'};
1.944 raeburn 16463: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 16464: if ($clonedesc{'type'} ne 'Community') {
1.1344 raeburn 16465: push(@clonemsg,({
16466: mt => 'No new community created.',
16467: args => [],
16468: },
16469: {
16470: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
16471: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16472: }));
16473: return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 16474: }
16475: }
1.1262 raeburn 16476: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 16477: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 16478: $can_clone = 1;
16479: } else {
1.1221 raeburn 16480: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 16481: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 16482: if ($clonehash{'cloners'} eq '') {
16483: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
16484: if ($domdefs{'canclone'}) {
16485: unless ($domdefs{'canclone'} eq 'none') {
16486: if ($domdefs{'canclone'} eq 'domain') {
16487: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
16488: $can_clone = 1;
16489: }
16490: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16491: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
16492: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
16493: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
16494: $can_clone = 1;
16495: }
16496: }
16497: }
16498: }
1.578 raeburn 16499: } else {
1.1221 raeburn 16500: my @cloners = split(/,/,$clonehash{'cloners'});
16501: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 16502: $can_clone = 1;
1.1221 raeburn 16503: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 16504: $can_clone = 1;
1.1225 raeburn 16505: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
16506: $can_clone = 1;
1.1221 raeburn 16507: }
16508: unless ($can_clone) {
1.1225 raeburn 16509: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16510: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 16511: my (%gotdomdefaults,%gotcodedefaults);
16512: foreach my $cloner (@cloners) {
16513: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
16514: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
16515: my (%codedefaults,@code_order);
16516: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
16517: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
16518: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
16519: }
16520: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
16521: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
16522: }
16523: } else {
16524: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
16525: \%codedefaults,
16526: \@code_order);
16527: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
16528: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
16529: }
16530: if (@code_order > 0) {
16531: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
16532: $cloner,$clonehash{'internal.coursecode'},
16533: $args->{'crscode'})) {
16534: $can_clone = 1;
16535: last;
16536: }
16537: }
16538: }
16539: }
16540: }
1.1225 raeburn 16541: }
16542: }
16543: unless ($can_clone) {
16544: my $ccrole = 'cc';
16545: if ($args->{'crstype'} eq 'Community') {
16546: $ccrole = 'co';
16547: }
16548: my %roleshash =
16549: &Apache::lonnet::get_my_roles($args->{'ccuname'},
16550: $args->{'ccdomain'},
16551: 'userroles',['active'],[$ccrole],
16552: [$args->{'clonedomain'}]);
16553: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
16554: $can_clone = 1;
16555: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
16556: $args->{'ccuname'},$args->{'ccdomain'})) {
16557: $can_clone = 1;
1.1221 raeburn 16558: }
16559: }
16560: unless ($can_clone) {
16561: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16562: push(@clonemsg,({
16563: mt => 'No new community created.',
16564: args => [],
16565: },
16566: {
16567: 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]).',
16568: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16569: }));
1.942 raeburn 16570: } else {
1.1344 raeburn 16571: push(@clonemsg,({
16572: mt => 'No new course created.',
16573: args => [],
16574: },
16575: {
16576: 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]).',
16577: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16578: }));
1.1221 raeburn 16579: }
1.566 albertel 16580: }
1.578 raeburn 16581: }
1.566 albertel 16582: }
1.1344 raeburn 16583: return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16584: }
16585:
1.444 albertel 16586: sub construct_course {
1.1262 raeburn 16587: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344 raeburn 16588: $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
16589: my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 16590: my $linefeed = '<br />'."\n";
16591: if ($context eq 'auto') {
16592: $linefeed = "\n";
16593: }
1.566 albertel 16594:
16595: #
16596: # Are we cloning?
16597: #
1.1344 raeburn 16598: my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16599: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344 raeburn 16600: ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 16601: if (!$can_clone) {
1.1344 raeburn 16602: return (0,$outcome,$clonemsgref);
1.566 albertel 16603: }
16604: }
16605:
1.444 albertel 16606: #
16607: # Open course
16608: #
1.1239 raeburn 16609: my $showncrstype;
16610: if ($args->{'crstype'} eq 'Placement') {
16611: $showncrstype = 'placement test';
16612: } else {
16613: $showncrstype = lc($args->{'crstype'});
16614: }
1.444 albertel 16615: my %cenv=();
16616: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
16617: $args->{'cdescr'},
16618: $args->{'curl'},
16619: $args->{'course_home'},
16620: $args->{'nonstandard'},
16621: $args->{'crscode'},
16622: $args->{'ccuname'}.':'.
16623: $args->{'ccdomain'},
1.882 raeburn 16624: $args->{'crstype'},
1.1344 raeburn 16625: $cnum,$context,$category,
16626: $callercontext);
1.444 albertel 16627:
16628: # Note: The testing routines depend on this being output; see
16629: # Utils::Course. This needs to at least be output as a comment
16630: # if anyone ever decides to not show this, and Utils::Course::new
16631: # will need to be suitably modified.
1.1344 raeburn 16632: if (($callercontext eq 'auto') && ($user_lh ne '')) {
16633: $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
16634: } else {
16635: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
16636: }
1.943 raeburn 16637: if ($$courseid =~ /^error:/) {
1.1344 raeburn 16638: return (0,$outcome,$clonemsgref);
1.943 raeburn 16639: }
16640:
1.444 albertel 16641: #
16642: # Check if created correctly
16643: #
1.479 albertel 16644: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 16645: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 16646: if ($crsuhome eq 'no_host') {
1.1344 raeburn 16647: if (($callercontext eq 'auto') && ($user_lh ne '')) {
16648: $outcome .= &mt_user($user_lh,
16649: 'Course creation failed, unrecognized course home server.');
16650: } else {
16651: $outcome .= &mt('Course creation failed, unrecognized course home server.');
16652: }
16653: $outcome .= $linefeed;
16654: return (0,$outcome,$clonemsgref);
1.943 raeburn 16655: }
1.541 raeburn 16656: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 16657:
1.444 albertel 16658: #
1.566 albertel 16659: # Do the cloning
16660: #
1.1344 raeburn 16661: my @clonemsg;
1.566 albertel 16662: if ($can_clone && $cloneid) {
1.1344 raeburn 16663: push(@clonemsg,
16664: {
16665: mt => 'Created [_1] by cloning from [_2]',
16666: args => [$showncrstype,$clonetitle],
16667: });
1.566 albertel 16668: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 16669: # Copy all files
1.1344 raeburn 16670: my @info =
16671: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
16672: $args->{'dateshift'},$args->{'crscode'},
16673: $args->{'ccuname'}.':'.$args->{'ccdomain'},
16674: $args->{'tinyurls'});
16675: if (@info) {
16676: push(@clonemsg,@info);
16677: }
1.444 albertel 16678: # Restore URL
1.566 albertel 16679: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 16680: # Restore title
1.566 albertel 16681: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 16682: # Restore creation date, creator and creation context.
16683: $cenv{'internal.created'}=$oldcenv{'internal.created'};
16684: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
16685: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 16686: # Mark as cloned
1.566 albertel 16687: $cenv{'clonedfrom'}=$cloneid;
1.638 www 16688: # Need to clone grading mode
16689: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
16690: $cenv{'grading'}=$newenv{'grading'};
16691: # Do not clone these environment entries
16692: &Apache::lonnet::del('environment',
16693: ['default_enrollment_start_date',
16694: 'default_enrollment_end_date',
16695: 'question.email',
16696: 'policy.email',
16697: 'comment.email',
16698: 'pch.users.denied',
1.725 raeburn 16699: 'plc.users.denied',
16700: 'hidefromcat',
1.1121 raeburn 16701: 'checkforpriv',
1.1355 raeburn 16702: 'categories'],
1.638 www 16703: $$crsudom,$$crsunum);
1.1170 raeburn 16704: if ($args->{'textbook'}) {
16705: $cenv{'internal.textbook'} = $args->{'textbook'};
16706: }
1.444 albertel 16707: }
1.566 albertel 16708:
1.444 albertel 16709: #
16710: # Set environment (will override cloned, if existing)
16711: #
16712: my @sections = ();
16713: my @xlists = ();
16714: if ($args->{'crstype'}) {
16715: $cenv{'type'}=$args->{'crstype'};
16716: }
1.1371 raeburn 16717: if ($args->{'lti'}) {
16718: $cenv{'internal.lti'}=$args->{'lti'};
16719: }
1.444 albertel 16720: if ($args->{'crsid'}) {
16721: $cenv{'courseid'}=$args->{'crsid'};
16722: }
16723: if ($args->{'crscode'}) {
16724: $cenv{'internal.coursecode'}=$args->{'crscode'};
16725: }
16726: if ($args->{'crsquota'} ne '') {
16727: $cenv{'internal.coursequota'}=$args->{'crsquota'};
16728: } else {
16729: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
16730: }
16731: if ($args->{'ccuname'}) {
16732: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
16733: ':'.$args->{'ccdomain'};
16734: } else {
16735: $cenv{'internal.courseowner'} = $args->{'curruser'};
16736: }
1.1116 raeburn 16737: if ($args->{'defaultcredits'}) {
16738: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
16739: }
1.444 albertel 16740: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
16741: if ($args->{'crssections'}) {
16742: $cenv{'internal.sectionnums'} = '';
16743: if ($args->{'crssections'} =~ m/,/) {
16744: @sections = split/,/,$args->{'crssections'};
16745: } else {
16746: $sections[0] = $args->{'crssections'};
16747: }
16748: if (@sections > 0) {
16749: foreach my $item (@sections) {
16750: my ($sec,$gp) = split/:/,$item;
16751: my $class = $args->{'crscode'}.$sec;
16752: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
16753: $cenv{'internal.sectionnums'} .= $item.',';
16754: unless ($addcheck eq 'ok') {
1.1263 raeburn 16755: push(@badclasses,$class);
1.444 albertel 16756: }
16757: }
16758: $cenv{'internal.sectionnums'} =~ s/,$//;
16759: }
16760: }
16761: # do not hide course coordinator from staff listing,
16762: # even if privileged
16763: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 16764: # add course coordinator's domain to domains to check for privileged users
16765: # if different to course domain
16766: if ($$crsudom ne $args->{'ccdomain'}) {
16767: $cenv{'checkforpriv'} = $args->{'ccdomain'};
16768: }
1.444 albertel 16769: # add crosslistings
16770: if ($args->{'crsxlist'}) {
16771: $cenv{'internal.crosslistings'}='';
16772: if ($args->{'crsxlist'} =~ m/,/) {
16773: @xlists = split/,/,$args->{'crsxlist'};
16774: } else {
16775: $xlists[0] = $args->{'crsxlist'};
16776: }
16777: if (@xlists > 0) {
16778: foreach my $item (@xlists) {
16779: my ($xl,$gp) = split/:/,$item;
16780: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
16781: $cenv{'internal.crosslistings'} .= $item.',';
16782: unless ($addcheck eq 'ok') {
1.1263 raeburn 16783: push(@badclasses,$xl);
1.444 albertel 16784: }
16785: }
16786: $cenv{'internal.crosslistings'} =~ s/,$//;
16787: }
16788: }
16789: if ($args->{'autoadds'}) {
16790: $cenv{'internal.autoadds'}=$args->{'autoadds'};
16791: }
16792: if ($args->{'autodrops'}) {
16793: $cenv{'internal.autodrops'}=$args->{'autodrops'};
16794: }
16795: # check for notification of enrollment changes
16796: my @notified = ();
16797: if ($args->{'notify_owner'}) {
16798: if ($args->{'ccuname'} ne '') {
16799: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
16800: }
16801: }
16802: if ($args->{'notify_dc'}) {
16803: if ($uname ne '') {
1.630 raeburn 16804: push(@notified,$uname.':'.$udom);
1.444 albertel 16805: }
16806: }
16807: if (@notified > 0) {
16808: my $notifylist;
16809: if (@notified > 1) {
16810: $notifylist = join(',',@notified);
16811: } else {
16812: $notifylist = $notified[0];
16813: }
16814: $cenv{'internal.notifylist'} = $notifylist;
16815: }
16816: if (@badclasses > 0) {
16817: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 16818: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
16819: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
16820: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 16821: );
1.1264 raeburn 16822: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
16823: &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 16824: if ($context eq 'auto') {
16825: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 16826: } else {
1.566 albertel 16827: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 16828: }
16829: foreach my $item (@badclasses) {
1.541 raeburn 16830: if ($context eq 'auto') {
1.1261 raeburn 16831: $outcome .= " - $item\n";
1.541 raeburn 16832: } else {
1.1261 raeburn 16833: $outcome .= "<li>$item</li>\n";
1.541 raeburn 16834: }
1.1261 raeburn 16835: }
16836: if ($context eq 'auto') {
16837: $outcome .= $linefeed;
16838: } else {
16839: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 16840: }
1.444 albertel 16841: }
16842: if ($args->{'no_end_date'}) {
16843: $args->{'endaccess'} = 0;
16844: }
16845: $cenv{'internal.autostart'}=$args->{'enrollstart'};
16846: $cenv{'internal.autoend'}=$args->{'enrollend'};
16847: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
16848: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
16849: if ($args->{'showphotos'}) {
16850: $cenv{'internal.showphotos'}=$args->{'showphotos'};
16851: }
16852: $cenv{'internal.authtype'} = $args->{'authtype'};
16853: $cenv{'internal.autharg'} = $args->{'autharg'};
16854: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
16855: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 16856: 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');
16857: if ($context eq 'auto') {
16858: $outcome .= $krb_msg;
16859: } else {
1.566 albertel 16860: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 16861: }
16862: $outcome .= $linefeed;
1.444 albertel 16863: }
16864: }
16865: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
16866: if ($args->{'setpolicy'}) {
16867: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16868: }
16869: if ($args->{'setcontent'}) {
16870: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16871: }
1.1251 raeburn 16872: if ($args->{'setcomment'}) {
16873: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16874: }
1.444 albertel 16875: }
16876: if ($args->{'reshome'}) {
16877: $cenv{'reshome'}=$args->{'reshome'}.'/';
16878: $cenv{'reshome'}=~s/\/+$/\//;
16879: }
16880: #
16881: # course has keyed access
16882: #
16883: if ($args->{'setkeys'}) {
16884: $cenv{'keyaccess'}='yes';
16885: }
16886: # if specified, key authority is not course, but user
16887: # only active if keyaccess is yes
16888: if ($args->{'keyauth'}) {
1.487 albertel 16889: my ($user,$domain) = split(':',$args->{'keyauth'});
16890: $user = &LONCAPA::clean_username($user);
16891: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 16892: if ($user ne '' && $domain ne '') {
1.487 albertel 16893: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 16894: }
16895: }
16896:
1.1166 raeburn 16897: #
1.1167 raeburn 16898: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 16899: #
16900: if ($args->{'uniquecode'}) {
16901: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
16902: if ($code) {
16903: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 16904: my %crsinfo =
16905: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
16906: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
16907: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
16908: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
16909: }
1.1166 raeburn 16910: if (ref($coderef)) {
16911: $$coderef = $code;
16912: }
16913: }
16914: }
16915:
1.444 albertel 16916: if ($args->{'disresdis'}) {
16917: $cenv{'pch.roles.denied'}='st';
16918: }
16919: if ($args->{'disablechat'}) {
16920: $cenv{'plc.roles.denied'}='st';
16921: }
16922:
16923: # Record we've not yet viewed the Course Initialization Helper for this
16924: # course
16925: $cenv{'course.helper.not.run'} = 1;
16926: #
16927: # Use new Randomseed
16928: #
16929: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
16930: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
16931: #
16932: # The encryption code and receipt prefix for this course
16933: #
16934: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
16935: $cenv{'internal.encpref'}=100+int(9*rand(99));
16936: #
16937: # By default, use standard grading
16938: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
16939:
1.541 raeburn 16940: $outcome .= $linefeed.&mt('Setting environment').': '.
16941: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16942: #
16943: # Open all assignments
16944: #
16945: if ($args->{'openall'}) {
1.1341 raeburn 16946: my $opendate = time;
16947: if ($args->{'openallfrom'} =~ /^\d+$/) {
16948: $opendate = $args->{'openallfrom'};
16949: }
1.444 albertel 16950: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341 raeburn 16951: my %storecontent = ($storeunder => $opendate,
1.444 albertel 16952: $storeunder.'.type' => 'date_start');
1.1341 raeburn 16953: $outcome .= &mt('All assignments open starting [_1]',
16954: &Apache::lonlocal::locallocaltime($opendate)).': '.
16955: &Apache::lonnet::cput
16956: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16957: }
16958: #
16959: # Set first page
16960: #
16961: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
16962: || ($cloneid)) {
1.445 albertel 16963: use LONCAPA::map;
1.444 albertel 16964: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 16965:
16966: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
16967: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
16968:
1.444 albertel 16969: $outcome .= ($fatal?$errtext:'read ok').' - ';
16970: my $title; my $url;
16971: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 16972: $title=&mt('Syllabus');
1.444 albertel 16973: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
16974: } else {
1.963 raeburn 16975: $title=&mt('Table of Contents');
1.444 albertel 16976: $url='/adm/navmaps';
16977: }
1.445 albertel 16978:
16979: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
16980: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
16981:
16982: if ($errtext) { $fatal=2; }
1.541 raeburn 16983: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 16984: }
1.566 albertel 16985:
1.1237 raeburn 16986: #
16987: # Set params for Placement Tests
16988: #
1.1239 raeburn 16989: if ($args->{'crstype'} eq 'Placement') {
16990: my %storecontent;
16991: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
16992: my %defaults = (
16993: buttonshide => { value => 'yes',
16994: type => 'string_yesno',},
16995: type => { value => 'randomizetry',
16996: type => 'string_questiontype',},
16997: maxtries => { value => 1,
16998: type => 'int_pos',},
16999: problemstatus => { value => 'no',
17000: type => 'string_problemstatus',},
17001: );
17002: foreach my $key (keys(%defaults)) {
17003: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
17004: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
17005: }
1.1237 raeburn 17006: &Apache::lonnet::cput
17007: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
17008: }
17009:
1.1344 raeburn 17010: return (1,$outcome,\@clonemsg);
1.444 albertel 17011: }
17012:
1.1166 raeburn 17013: sub make_unique_code {
17014: my ($cdom,$cnum) = @_;
17015: # get lock on uniquecodes db
17016: my $lockhash = {
17017: $cnum."\0".'uniquecodes' => $env{'user.name'}.
17018: ':'.$env{'user.domain'},
17019: };
17020: my $tries = 0;
17021: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17022: my ($code,$error);
17023:
17024: while (($gotlock ne 'ok') && ($tries<3)) {
17025: $tries ++;
17026: sleep 1;
17027: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17028: }
17029: if ($gotlock eq 'ok') {
17030: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
17031: my $gotcode;
17032: my $attempts = 0;
17033: while ((!$gotcode) && ($attempts < 100)) {
17034: $code = &generate_code();
17035: if (!exists($currcodes{$code})) {
17036: $gotcode = 1;
17037: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
17038: $error = 'nostore';
17039: }
17040: }
17041: $attempts ++;
17042: }
17043: my @del_lock = ($cnum."\0".'uniquecodes');
17044: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
17045: } else {
17046: $error = 'nolock';
17047: }
17048: return ($code,$error);
17049: }
17050:
17051: sub generate_code {
17052: my $code;
17053: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
17054: for (my $i=0; $i<6; $i++) {
17055: my $lettnum = int (rand 2);
17056: my $item = '';
17057: if ($lettnum) {
17058: $item = $letts[int( rand(18) )];
17059: } else {
17060: $item = 1+int( rand(8) );
17061: }
17062: $code .= $item;
17063: }
17064: return $code;
17065: }
17066:
1.444 albertel 17067: ############################################################
17068: ############################################################
17069:
1.1237 raeburn 17070: # Community, Course and Placement Test
1.378 raeburn 17071: sub course_type {
17072: my ($cid) = @_;
17073: if (!defined($cid)) {
17074: $cid = $env{'request.course.id'};
17075: }
1.404 albertel 17076: if (defined($env{'course.'.$cid.'.type'})) {
17077: return $env{'course.'.$cid.'.type'};
1.378 raeburn 17078: } else {
17079: return 'Course';
1.377 raeburn 17080: }
17081: }
1.156 albertel 17082:
1.406 raeburn 17083: sub group_term {
17084: my $crstype = &course_type();
17085: my %names = (
17086: 'Course' => 'group',
1.865 raeburn 17087: 'Community' => 'group',
1.1237 raeburn 17088: 'Placement' => 'group',
1.406 raeburn 17089: );
17090: return $names{$crstype};
17091: }
17092:
1.902 raeburn 17093: sub course_types {
1.1310 raeburn 17094: my @types = ('official','unofficial','community','textbook','placement','lti');
1.902 raeburn 17095: my %typename = (
17096: official => 'Official course',
17097: unofficial => 'Unofficial course',
17098: community => 'Community',
1.1165 raeburn 17099: textbook => 'Textbook course',
1.1237 raeburn 17100: placement => 'Placement test',
1.1310 raeburn 17101: lti => 'LTI provider',
1.902 raeburn 17102: );
17103: return (\@types,\%typename);
17104: }
17105:
1.156 albertel 17106: sub icon {
17107: my ($file)=@_;
1.505 albertel 17108: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 17109: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 17110: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 17111: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
17112: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
17113: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17114: $curfext.".gif") {
17115: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17116: $curfext.".gif";
17117: }
17118: }
1.249 albertel 17119: return &lonhttpdurl($iconname);
1.154 albertel 17120: }
1.84 albertel 17121:
1.575 albertel 17122: sub lonhttpdurl {
1.692 www 17123: #
17124: # Had been used for "small fry" static images on separate port 8080.
17125: # Modify here if lightweight http functionality desired again.
17126: # Currently eliminated due to increasing firewall issues.
17127: #
1.575 albertel 17128: my ($url)=@_;
1.692 www 17129: return $url;
1.215 albertel 17130: }
17131:
1.213 albertel 17132: sub connection_aborted {
17133: my ($r)=@_;
17134: $r->print(" ");$r->rflush();
17135: my $c = $r->connection;
17136: return $c->aborted();
17137: }
17138:
1.221 foxr 17139: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 17140: # strings as 'strings'.
17141: sub escape_single {
1.221 foxr 17142: my ($input) = @_;
1.223 albertel 17143: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 17144: $input =~ s/\'/\\\'/g; # Esacpe the 's....
17145: return $input;
17146: }
1.223 albertel 17147:
1.222 foxr 17148: # Same as escape_single, but escape's "'s This
17149: # can be used for "strings"
17150: sub escape_double {
17151: my ($input) = @_;
17152: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
17153: $input =~ s/\"/\\\"/g; # Esacpe the "s....
17154: return $input;
17155: }
1.223 albertel 17156:
1.222 foxr 17157: # Escapes the last element of a full URL.
17158: sub escape_url {
17159: my ($url) = @_;
1.238 raeburn 17160: my @urlslices = split(/\//, $url,-1);
1.369 www 17161: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 17162: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 17163: }
1.462 albertel 17164:
1.820 raeburn 17165: sub compare_arrays {
17166: my ($arrayref1,$arrayref2) = @_;
17167: my (@difference,%count);
17168: @difference = ();
17169: %count = ();
17170: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
17171: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
17172: foreach my $element (keys(%count)) {
17173: if ($count{$element} == 1) {
17174: push(@difference,$element);
17175: }
17176: }
17177: }
17178: return @difference;
17179: }
17180:
1.1322 raeburn 17181: sub lon_status_items {
17182: my %defaults = (
17183: E => 100,
17184: W => 4,
17185: N => 1,
1.1324 raeburn 17186: U => 5,
1.1322 raeburn 17187: threshold => 200,
17188: sysmail => 2500,
17189: );
17190: my %names = (
17191: E => 'Errors',
17192: W => 'Warnings',
17193: N => 'Notices',
1.1324 raeburn 17194: U => 'Unsent',
1.1322 raeburn 17195: );
17196: return (\%defaults,\%names);
17197: }
17198:
1.817 bisitz 17199: # -------------------------------------------------------- Initialize user login
1.462 albertel 17200: sub init_user_environment {
1.463 albertel 17201: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 17202: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
17203:
17204: my $public=($username eq 'public' && $domain eq 'public');
17205:
1.1062 raeburn 17206: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 17207: my $now=time;
17208:
17209: if ($public) {
17210: my $max_public=100;
17211: my $oldest;
17212: my $oldest_time=0;
17213: for(my $next=1;$next<=$max_public;$next++) {
17214: if (-e $lonids."/publicuser_$next.id") {
17215: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
17216: if ($mtime<$oldest_time || !$oldest_time) {
17217: $oldest_time=$mtime;
17218: $oldest=$next;
17219: }
17220: } else {
17221: $cookie="publicuser_$next";
17222: last;
17223: }
17224: }
17225: if (!$cookie) { $cookie="publicuser_$oldest"; }
17226: } else {
1.1275 raeburn 17227: # See if old ID present, if so, remove if this isn't a robot,
17228: # killing any existing non-robot sessions
1.463 albertel 17229: if (!$args->{'robot'}) {
17230: opendir(DIR,$lonids);
17231: while ($filename=readdir(DIR)) {
17232: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320 raeburn 17233: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
17234: &GDBM_READER(),0640)) {
1.1295 raeburn 17235: my $linkedfile;
1.1320 raeburn 17236: if (exists($oldenv{'user.linkedenv'})) {
17237: $linkedfile = $oldenv{'user.linkedenv'};
1.1295 raeburn 17238: }
1.1320 raeburn 17239: untie(%oldenv);
17240: if (unlink("$lonids/$filename")) {
17241: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
17242: if (-l "$lonids/$linkedfile.id") {
17243: unlink("$lonids/$linkedfile.id");
17244: }
1.1295 raeburn 17245: }
17246: }
17247: } else {
17248: unlink($lonids.'/'.$filename);
17249: }
1.463 albertel 17250: }
1.462 albertel 17251: }
1.463 albertel 17252: closedir(DIR);
1.1204 raeburn 17253: # If there is a undeleted lockfile for the user's paste buffer remove it.
17254: my $namespace = 'nohist_courseeditor';
17255: my $lockingkey = 'paste'."\0".'locked_num';
17256: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
17257: $domain,$username);
17258: if (exists($lockhash{$lockingkey})) {
17259: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
17260: unless ($delresult eq 'ok') {
17261: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
17262: }
17263: }
1.462 albertel 17264: }
17265: # Give them a new cookie
1.463 albertel 17266: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 17267: : $now.$$.int(rand(10000)));
1.463 albertel 17268: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 17269:
17270: # Initialize roles
17271:
1.1062 raeburn 17272: ($userroles,$firstaccenv,$timerintenv) =
17273: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 17274: }
17275: # ------------------------------------ Check browser type and MathML capability
17276:
1.1194 raeburn 17277: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
17278: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 17279:
17280: # ------------------------------------------------------------- Get environment
17281:
17282: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
17283: my ($tmp) = keys(%userenv);
1.1275 raeburn 17284: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 17285: undef(%userenv);
17286: }
17287: if (($userenv{'interface'}) && (!$form->{'interface'})) {
17288: $form->{'interface'}=$userenv{'interface'};
17289: }
17290: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
17291:
17292: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 17293: foreach my $option ('interface','localpath','localres') {
17294: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 17295: }
17296: # --------------------------------------------------------- Write first profile
17297:
17298: {
1.1350 raeburn 17299: my $ip = &Apache::lonnet::get_requestor_ip($r);
1.462 albertel 17300: my %initial_env =
17301: ("user.name" => $username,
17302: "user.domain" => $domain,
17303: "user.home" => $authhost,
17304: "browser.type" => $clientbrowser,
17305: "browser.version" => $clientversion,
17306: "browser.mathml" => $clientmathml,
17307: "browser.unicode" => $clientunicode,
17308: "browser.os" => $clientos,
1.1137 raeburn 17309: "browser.mobile" => $clientmobile,
1.1141 raeburn 17310: "browser.info" => $clientinfo,
1.1194 raeburn 17311: "browser.osversion" => $clientosversion,
1.462 albertel 17312: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
17313: "request.course.fn" => '',
17314: "request.course.uri" => '',
17315: "request.course.sec" => '',
17316: "request.role" => 'cm',
17317: "request.role.adv" => $env{'user.adv'},
1.1350 raeburn 17318: "request.host" => $ip,);
1.462 albertel 17319:
17320: if ($form->{'localpath'}) {
17321: $initial_env{"browser.localpath"} = $form->{'localpath'};
17322: $initial_env{"browser.localres"} = $form->{'localres'};
17323: }
17324:
17325: if ($form->{'interface'}) {
17326: $form->{'interface'}=~s/\W//gs;
17327: $initial_env{"browser.interface"} = $form->{'interface'};
17328: $env{'browser.interface'}=$form->{'interface'};
17329: }
17330:
1.1157 raeburn 17331: if ($form->{'iptoken'}) {
17332: my $lonhost = $r->dir_config('lonHostID');
17333: $initial_env{"user.noloadbalance"} = $lonhost;
17334: $env{'user.noloadbalance'} = $lonhost;
17335: }
17336:
1.1268 raeburn 17337: if ($form->{'noloadbalance'}) {
17338: my @hosts = &Apache::lonnet::current_machine_ids();
17339: my $hosthere = $form->{'noloadbalance'};
17340: if (grep(/^\Q$hosthere\E$/,@hosts)) {
17341: $initial_env{"user.noloadbalance"} = $hosthere;
17342: $env{'user.noloadbalance'} = $hosthere;
17343: }
17344: }
17345:
1.1016 raeburn 17346: unless ($domain eq 'public') {
1.1273 raeburn 17347: my %is_adv = ( is_adv => $env{'user.adv'} );
17348: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
17349:
17350: foreach my $tool ('aboutme','blog','webdav','portfolio') {
17351: $userenv{'availabletools.'.$tool} =
17352: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
17353: undef,\%userenv,\%domdef,\%is_adv);
17354: }
1.980 raeburn 17355:
1.1311 raeburn 17356: foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273 raeburn 17357: $userenv{'canrequest.'.$crstype} =
17358: &Apache::lonnet::usertools_access($username,$domain,$crstype,
17359: 'reload','requestcourses',
17360: \%userenv,\%domdef,\%is_adv);
17361: }
1.724 raeburn 17362:
1.1273 raeburn 17363: $userenv{'canrequest.author'} =
17364: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
17365: 'reload','requestauthor',
1.980 raeburn 17366: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 17367: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
17368: $domain,$username);
17369: my $reqstatus = $reqauthor{'author_status'};
17370: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
17371: if (ref($reqauthor{'author'}) eq 'HASH') {
17372: $userenv{'requestauthorqueued'} = $reqstatus.':'.
17373: $reqauthor{'author'}{'timestamp'};
17374: }
1.1092 raeburn 17375: }
1.1287 raeburn 17376: my ($types,$typename) = &course_types();
17377: if (ref($types) eq 'ARRAY') {
17378: my @options = ('approval','validate','autolimit');
17379: my $optregex = join('|',@options);
17380: my (%willtrust,%trustchecked);
17381: foreach my $type (@{$types}) {
17382: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
17383: if ($dom_str ne '') {
17384: my $updatedstr = '';
17385: my @possdomains = split(',',$dom_str);
17386: foreach my $entry (@possdomains) {
17387: my ($extdom,$extopt) = split(':',$entry);
17388: unless ($trustchecked{$extdom}) {
17389: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
17390: $trustchecked{$extdom} = 1;
17391: }
17392: if ($willtrust{$extdom}) {
17393: $updatedstr .= $entry.',';
17394: }
17395: }
17396: $updatedstr =~ s/,$//;
17397: if ($updatedstr) {
17398: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
17399: } else {
17400: delete($userenv{'reqcrsotherdom.'.$type});
17401: }
17402: }
17403: }
17404: }
1.1092 raeburn 17405: }
1.462 albertel 17406: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 17407:
1.462 albertel 17408: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
17409: &GDBM_WRCREAT(),0640)) {
17410: &_add_to_env(\%disk_env,\%initial_env);
17411: &_add_to_env(\%disk_env,\%userenv,'environment.');
17412: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 17413: if (ref($firstaccenv) eq 'HASH') {
17414: &_add_to_env(\%disk_env,$firstaccenv);
17415: }
17416: if (ref($timerintenv) eq 'HASH') {
17417: &_add_to_env(\%disk_env,$timerintenv);
17418: }
1.463 albertel 17419: if (ref($args->{'extra_env'})) {
17420: &_add_to_env(\%disk_env,$args->{'extra_env'});
17421: }
1.462 albertel 17422: untie(%disk_env);
17423: } else {
1.705 tempelho 17424: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
17425: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 17426: return 'error: '.$!;
17427: }
17428: }
17429: $env{'request.role'}='cm';
17430: $env{'request.role.adv'}=$env{'user.adv'};
17431: $env{'browser.type'}=$clientbrowser;
17432:
17433: return $cookie;
17434:
17435: }
17436:
17437: sub _add_to_env {
17438: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 17439: if (ref($env_data) eq 'HASH') {
17440: while (my ($key,$value) = each(%$env_data)) {
17441: $idf->{$prefix.$key} = $value;
17442: $env{$prefix.$key} = $value;
17443: }
1.462 albertel 17444: }
17445: }
17446:
1.685 tempelho 17447: # --- Get the symbolic name of a problem and the url
17448: sub get_symb {
17449: my ($request,$silent) = @_;
1.726 raeburn 17450: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 17451: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
17452: if ($symb eq '') {
17453: if (!$silent) {
1.1071 raeburn 17454: if (ref($request)) {
17455: $request->print("Unable to handle ambiguous references:$url:.");
17456: }
1.685 tempelho 17457: return ();
17458: }
17459: }
17460: &Apache::lonenc::check_decrypt(\$symb);
17461: return ($symb);
17462: }
17463:
17464: # --------------------------------------------------------------Get annotation
17465:
17466: sub get_annotation {
17467: my ($symb,$enc) = @_;
17468:
17469: my $key = $symb;
17470: if (!$enc) {
17471: $key =
17472: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
17473: }
17474: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
17475: return $annotation{$key};
17476: }
17477:
17478: sub clean_symb {
1.731 raeburn 17479: my ($symb,$delete_enc) = @_;
1.685 tempelho 17480:
17481: &Apache::lonenc::check_decrypt(\$symb);
17482: my $enc = $env{'request.enc'};
1.731 raeburn 17483: if ($delete_enc) {
1.730 raeburn 17484: delete($env{'request.enc'});
17485: }
1.685 tempelho 17486:
17487: return ($symb,$enc);
17488: }
1.462 albertel 17489:
1.1181 raeburn 17490: ############################################################
17491: ############################################################
17492:
17493: =pod
17494:
17495: =head1 Routines for building display used to search for courses
17496:
17497:
17498: =over 4
17499:
17500: =item * &build_filters()
17501:
17502: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 17503: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
17504: and quotacheck.pl
17505:
1.1181 raeburn 17506:
17507: Inputs:
17508:
17509: filterlist - anonymous array of fields to include as potential filters
17510:
17511: crstype - course type
17512:
17513: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
17514: to pop-open a course selector (will contain "extra element").
17515:
17516: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
17517:
17518: filter - anonymous hash of criteria and their values
17519:
17520: action - form action
17521:
17522: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
17523:
1.1182 raeburn 17524: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 17525:
17526: cloneruname - username of owner of new course who wants to clone
17527:
17528: clonerudom - domain of owner of new course who wants to clone
17529:
17530: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
17531:
17532: codetitlesref - reference to array of titles of components in institutional codes (official courses)
17533:
17534: codedom - domain
17535:
17536: formname - value of form element named "form".
17537:
17538: fixeddom - domain, if fixed.
17539:
17540: prevphase - value to assign to form element named "phase" when going back to the previous screen
17541:
17542: cnameelement - name of form element in form on opener page which will receive title of selected course
17543:
17544: cnumelement - name of form element in form on opener page which will receive courseID of selected course
17545:
17546: cdomelement - name of form element in form on opener page which will receive domain of selected course
17547:
17548: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
17549:
17550: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
17551:
17552: clonewarning - warning message about missing information for intended course owner when DC creates a course
17553:
1.1182 raeburn 17554:
1.1181 raeburn 17555: Returns: $output - HTML for display of search criteria, and hidden form elements.
17556:
1.1182 raeburn 17557:
1.1181 raeburn 17558: Side Effects: None
17559:
17560: =cut
17561:
17562: # ---------------------------------------------- search for courses based on last activity etc.
17563:
17564: sub build_filters {
17565: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
17566: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
17567: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
17568: $cnameelement,$cnumelement,$cdomelement,$setroles,
17569: $clonetext,$clonewarning) = @_;
1.1182 raeburn 17570: my ($list,$jscript);
1.1181 raeburn 17571: my $onchange = 'javascript:updateFilters(this)';
17572: my ($domainselectform,$sincefilterform,$createdfilterform,
17573: $ownerdomselectform,$persondomselectform,$instcodeform,
17574: $typeselectform,$instcodetitle);
17575: if ($formname eq '') {
17576: $formname = $caller;
17577: }
17578: foreach my $item (@{$filterlist}) {
17579: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
17580: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
17581: if ($item eq 'domainfilter') {
17582: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
17583: } elsif ($item eq 'coursefilter') {
17584: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
17585: } elsif ($item eq 'ownerfilter') {
17586: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17587: } elsif ($item eq 'ownerdomfilter') {
17588: $filter->{'ownerdomfilter'} =
17589: &LONCAPA::clean_domain($filter->{$item});
17590: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
17591: 'ownerdomfilter',1);
17592: } elsif ($item eq 'personfilter') {
17593: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17594: } elsif ($item eq 'persondomfilter') {
17595: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
17596: 'persondomfilter',1);
17597: } else {
17598: $filter->{$item} =~ s/\W//g;
17599: }
17600: if (!$filter->{$item}) {
17601: $filter->{$item} = '';
17602: }
17603: }
17604: if ($item eq 'domainfilter') {
17605: my $allow_blank = 1;
17606: if ($formname eq 'portform') {
17607: $allow_blank=0;
17608: } elsif ($formname eq 'studentform') {
17609: $allow_blank=0;
17610: }
17611: if ($fixeddom) {
17612: $domainselectform = '<input type="hidden" name="domainfilter"'.
17613: ' value="'.$codedom.'" />'.
17614: &Apache::lonnet::domain($codedom,'description');
17615: } else {
17616: $domainselectform = &select_dom_form($filter->{$item},
17617: 'domainfilter',
17618: $allow_blank,'',$onchange);
17619: }
17620: } else {
17621: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
17622: }
17623: }
17624:
17625: # last course activity filter and selection
17626: $sincefilterform = &timebased_select_form('sincefilter',$filter);
17627:
17628: # course created filter and selection
17629: if (exists($filter->{'createdfilter'})) {
17630: $createdfilterform = &timebased_select_form('createdfilter',$filter);
17631: }
17632:
1.1239 raeburn 17633: my $prefix = $crstype;
17634: if ($crstype eq 'Placement') {
17635: $prefix = 'Placement Test'
17636: }
1.1181 raeburn 17637: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 17638: 'cac' => "$prefix Activity",
17639: 'ccr' => "$prefix Created",
17640: 'cde' => "$prefix Title",
17641: 'cdo' => "$prefix Domain",
1.1181 raeburn 17642: 'ins' => 'Institutional Code',
17643: 'inc' => 'Institutional Categorization',
1.1239 raeburn 17644: 'cow' => "$prefix Owner/Co-owner",
17645: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 17646: 'cog' => 'Type',
17647: );
17648:
17649: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17650: my $typeval = 'Course';
17651: if ($crstype eq 'Community') {
17652: $typeval = 'Community';
1.1239 raeburn 17653: } elsif ($crstype eq 'Placement') {
17654: $typeval = 'Placement';
1.1181 raeburn 17655: }
17656: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
17657: } else {
17658: $typeselectform = '<select name="type" size="1"';
17659: if ($onchange) {
17660: $typeselectform .= ' onchange="'.$onchange.'"';
17661: }
17662: $typeselectform .= '>'."\n";
1.1237 raeburn 17663: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 17664: my $shown;
17665: if ($posstype eq 'Placement') {
17666: $shown = &mt('Placement Test');
17667: } else {
17668: $shown = &mt($posstype);
17669: }
1.1181 raeburn 17670: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 17671: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 17672: }
17673: $typeselectform.="</select>";
17674: }
17675:
17676: my ($cloneableonlyform,$cloneabletitle);
17677: if (exists($filter->{'cloneableonly'})) {
17678: my $cloneableon = '';
17679: my $cloneableoff = ' checked="checked"';
17680: if ($filter->{'cloneableonly'}) {
17681: $cloneableon = $cloneableoff;
17682: $cloneableoff = '';
17683: }
17684: $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>';
17685: if ($formname eq 'ccrs') {
1.1187 bisitz 17686: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 17687: } else {
17688: $cloneabletitle = &mt('Cloneable by you');
17689: }
17690: }
17691: my $officialjs;
17692: if ($crstype eq 'Course') {
17693: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 17694: # if (($fixeddom) || ($formname eq 'requestcrs') ||
17695: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
17696: if ($codedom) {
1.1181 raeburn 17697: $officialjs = 1;
17698: ($instcodeform,$jscript,$$numtitlesref) =
17699: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
17700: $officialjs,$codetitlesref);
17701: if ($jscript) {
1.1182 raeburn 17702: $jscript = '<script type="text/javascript">'."\n".
17703: '// <![CDATA['."\n".
17704: $jscript."\n".
17705: '// ]]>'."\n".
17706: '</script>'."\n";
1.1181 raeburn 17707: }
17708: }
17709: if ($instcodeform eq '') {
17710: $instcodeform =
17711: '<input type="text" name="instcodefilter" size="10" value="'.
17712: $list->{'instcodefilter'}.'" />';
17713: $instcodetitle = $lt{'ins'};
17714: } else {
17715: $instcodetitle = $lt{'inc'};
17716: }
17717: if ($fixeddom) {
17718: $instcodetitle .= '<br />('.$codedom.')';
17719: }
17720: }
17721: }
17722: my $output = qq|
17723: <form method="post" name="filterpicker" action="$action">
17724: <input type="hidden" name="form" value="$formname" />
17725: |;
17726: if ($formname eq 'modifycourse') {
17727: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
17728: '<input type="hidden" name="prevphase" value="'.
17729: $prevphase.'" />'."\n";
1.1198 musolffc 17730: } elsif ($formname eq 'quotacheck') {
17731: $output .= qq|
17732: <input type="hidden" name="sortby" value="" />
17733: <input type="hidden" name="sortorder" value="" />
17734: |;
17735: } else {
1.1181 raeburn 17736: my $name_input;
17737: if ($cnameelement ne '') {
17738: $name_input = '<input type="hidden" name="cnameelement" value="'.
17739: $cnameelement.'" />';
17740: }
17741: $output .= qq|
1.1182 raeburn 17742: <input type="hidden" name="cnumelement" value="$cnumelement" />
17743: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 17744: $name_input
17745: $roleelement
17746: $multelement
17747: $typeelement
17748: |;
17749: if ($formname eq 'portform') {
17750: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
17751: }
17752: }
17753: if ($fixeddom) {
17754: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
17755: }
17756: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
17757: if ($sincefilterform) {
17758: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
17759: .$sincefilterform
17760: .&Apache::lonhtmlcommon::row_closure();
17761: }
17762: if ($createdfilterform) {
17763: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
17764: .$createdfilterform
17765: .&Apache::lonhtmlcommon::row_closure();
17766: }
17767: if ($domainselectform) {
17768: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
17769: .$domainselectform
17770: .&Apache::lonhtmlcommon::row_closure();
17771: }
17772: if ($typeselectform) {
17773: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17774: $output .= $typeselectform;
17775: } else {
17776: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
17777: .$typeselectform
17778: .&Apache::lonhtmlcommon::row_closure();
17779: }
17780: }
17781: if ($instcodeform) {
17782: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
17783: .$instcodeform
17784: .&Apache::lonhtmlcommon::row_closure();
17785: }
17786: if (exists($filter->{'ownerfilter'})) {
17787: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
17788: '<table><tr><td>'.&mt('Username').'<br />'.
17789: '<input type="text" name="ownerfilter" size="20" value="'.
17790: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17791: $ownerdomselectform.'</td></tr></table>'.
17792: &Apache::lonhtmlcommon::row_closure();
17793: }
17794: if (exists($filter->{'personfilter'})) {
17795: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
17796: '<table><tr><td>'.&mt('Username').'<br />'.
17797: '<input type="text" name="personfilter" size="20" value="'.
17798: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17799: $persondomselectform.'</td></tr></table>'.
17800: &Apache::lonhtmlcommon::row_closure();
17801: }
17802: if (exists($filter->{'coursefilter'})) {
17803: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
17804: .'<input type="text" name="coursefilter" size="25" value="'
17805: .$list->{'coursefilter'}.'" />'
17806: .&Apache::lonhtmlcommon::row_closure();
17807: }
17808: if ($cloneableonlyform) {
17809: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
17810: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
17811: }
17812: if (exists($filter->{'descriptfilter'})) {
17813: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
17814: .'<input type="text" name="descriptfilter" size="40" value="'
17815: .$list->{'descriptfilter'}.'" />'
17816: .&Apache::lonhtmlcommon::row_closure(1);
17817: }
17818: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
17819: '<input type="hidden" name="updater" value="" />'."\n".
17820: '<input type="submit" name="gosearch" value="'.
17821: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
17822: return $jscript.$clonewarning.$output;
17823: }
17824:
17825: =pod
17826:
17827: =item * &timebased_select_form()
17828:
1.1182 raeburn 17829: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 17830: filter e.g., Course Activity, Course Created, when searching for courses
17831: or communities
17832:
17833: Inputs:
17834:
17835: item - name of form element (sincefilter or createdfilter)
17836:
17837: filter - anonymous hash of criteria and their values
17838:
17839: Returns: HTML for a select box contained a blank, then six time selections,
17840: with value set in incoming form variables currently selected.
17841:
17842: Side Effects: None
17843:
17844: =cut
17845:
17846: sub timebased_select_form {
17847: my ($item,$filter) = @_;
17848: if (ref($filter) eq 'HASH') {
17849: $filter->{$item} =~ s/[^\d-]//g;
17850: if (!$filter->{$item}) { $filter->{$item}=-1; }
17851: return &select_form(
17852: $filter->{$item},
17853: $item,
17854: { '-1' => '',
17855: '86400' => &mt('today'),
17856: '604800' => &mt('last week'),
17857: '2592000' => &mt('last month'),
17858: '7776000' => &mt('last three months'),
17859: '15552000' => &mt('last six months'),
17860: '31104000' => &mt('last year'),
17861: 'select_form_order' =>
17862: ['-1','86400','604800','2592000','7776000',
17863: '15552000','31104000']});
17864: }
17865: }
17866:
17867: =pod
17868:
17869: =item * &js_changer()
17870:
17871: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 17872: when course type or domain is changed, and also to hide 'Searching ...' on
17873: page load completion for page showing search result.
1.1181 raeburn 17874:
17875: Inputs: None
17876:
1.1183 raeburn 17877: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 17878:
17879: Side Effects: None
17880:
17881: =cut
17882:
17883: sub js_changer {
17884: return <<ENDJS;
17885: <script type="text/javascript">
17886: // <![CDATA[
17887: function updateFilters(caller) {
17888: if (typeof(caller) != "undefined") {
17889: document.filterpicker.updater.value = caller.name;
17890: }
17891: document.filterpicker.submit();
17892: }
1.1183 raeburn 17893:
17894: function hideSearching() {
17895: if (document.getElementById('searching')) {
17896: document.getElementById('searching').style.display = 'none';
17897: }
17898: return;
17899: }
17900:
1.1181 raeburn 17901: // ]]>
17902: </script>
17903:
17904: ENDJS
17905: }
17906:
17907: =pod
17908:
1.1182 raeburn 17909: =item * &search_courses()
17910:
17911: Process selected filters form course search form and pass to lonnet::courseiddump
17912: to retrieve a hash for which keys are courseIDs which match the selected filters.
17913:
17914: Inputs:
17915:
17916: dom - domain being searched
17917:
17918: type - course type ('Course' or 'Community' or '.' if any).
17919:
17920: filter - anonymous hash of criteria and their values
17921:
17922: numtitles - for institutional codes - number of categories
17923:
17924: cloneruname - optional username of new course owner
17925:
17926: clonerudom - optional domain of new course owner
17927:
1.1221 raeburn 17928: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 17929: (used when DC is using course creation form)
17930:
17931: codetitles - reference to array of titles of components in institutional codes (official courses).
17932:
1.1221 raeburn 17933: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
17934: (and so can clone automatically)
17935:
17936: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
17937:
17938: reqinstcode - institutional code of new course, where search_courses is used to identify potential
17939: courses to clone
1.1182 raeburn 17940:
17941: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
17942:
17943:
17944: Side Effects: None
17945:
17946: =cut
17947:
17948:
17949: sub search_courses {
1.1221 raeburn 17950: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
17951: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 17952: my (%courses,%showcourses,$cloner);
17953: if (($filter->{'ownerfilter'} ne '') ||
17954: ($filter->{'ownerdomfilter'} ne '')) {
17955: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
17956: $filter->{'ownerdomfilter'};
17957: }
17958: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
17959: if (!$filter->{$item}) {
17960: $filter->{$item}='.';
17961: }
17962: }
17963: my $now = time;
17964: my $timefilter =
17965: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
17966: my ($createdbefore,$createdafter);
17967: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
17968: $createdbefore = $now;
17969: $createdafter = $now-$filter->{'createdfilter'};
17970: }
17971: my ($instcodefilter,$regexpok);
17972: if ($numtitles) {
17973: if ($env{'form.official'} eq 'on') {
17974: $instcodefilter =
17975: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17976: $regexpok = 1;
17977: } elsif ($env{'form.official'} eq 'off') {
17978: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17979: unless ($instcodefilter eq '') {
17980: $regexpok = -1;
17981: }
17982: }
17983: } else {
17984: $instcodefilter = $filter->{'instcodefilter'};
17985: }
17986: if ($instcodefilter eq '') { $instcodefilter = '.'; }
17987: if ($type eq '') { $type = '.'; }
17988:
17989: if (($clonerudom ne '') && ($cloneruname ne '')) {
17990: $cloner = $cloneruname.':'.$clonerudom;
17991: }
17992: %courses = &Apache::lonnet::courseiddump($dom,
17993: $filter->{'descriptfilter'},
17994: $timefilter,
17995: $instcodefilter,
17996: $filter->{'combownerfilter'},
17997: $filter->{'coursefilter'},
17998: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 17999: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 18000: $filter->{'cloneableonly'},
18001: $createdbefore,$createdafter,undef,
1.1221 raeburn 18002: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 18003: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
18004: my $ccrole;
18005: if ($type eq 'Community') {
18006: $ccrole = 'co';
18007: } else {
18008: $ccrole = 'cc';
18009: }
18010: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
18011: $filter->{'persondomfilter'},
18012: 'userroles',undef,
18013: [$ccrole,'in','ad','ep','ta','cr'],
18014: $dom);
18015: foreach my $role (keys(%rolehash)) {
18016: my ($cnum,$cdom,$courserole) = split(':',$role);
18017: my $cid = $cdom.'_'.$cnum;
18018: if (exists($courses{$cid})) {
18019: if (ref($courses{$cid}) eq 'HASH') {
18020: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
18021: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 18022: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 18023: }
18024: } else {
18025: $courses{$cid}{roles} = [$courserole];
18026: }
18027: $showcourses{$cid} = $courses{$cid};
18028: }
18029: }
18030: }
18031: %courses = %showcourses;
18032: }
18033: return %courses;
18034: }
18035:
18036: =pod
18037:
1.1181 raeburn 18038: =back
18039:
1.1207 raeburn 18040: =head1 Routines for version requirements for current course.
18041:
18042: =over 4
18043:
18044: =item * &check_release_required()
18045:
18046: Compares required LON-CAPA version with version on server, and
18047: if required version is newer looks for a server with the required version.
18048:
18049: Looks first at servers in user's owen domain; if none suitable, looks at
18050: servers in course's domain are permitted to host sessions for user's domain.
18051:
18052: Inputs:
18053:
18054: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18055:
18056: $courseid - Course ID of current course
18057:
18058: $rolecode - User's current role in course (for switchserver query string).
18059:
18060: $required - LON-CAPA version needed by course (format: Major.Minor).
18061:
18062:
18063: Returns:
18064:
18065: $switchserver - query string tp append to /adm/switchserver call (if
18066: current server's LON-CAPA version is too old.
18067:
18068: $warning - Message is displayed if no suitable server could be found.
18069:
18070: =cut
18071:
18072: sub check_release_required {
18073: my ($loncaparev,$courseid,$rolecode,$required) = @_;
18074: my ($switchserver,$warning);
18075: if ($required ne '') {
18076: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
18077: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18078: if ($reqdmajor ne '' && $reqdminor ne '') {
18079: my $otherserver;
18080: if (($major eq '' && $minor eq '') ||
18081: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
18082: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
18083: my $switchlcrev =
18084: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
18085: $userdomserver);
18086: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18087: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
18088: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
18089: my $cdom = $env{'course.'.$courseid.'.domain'};
18090: if ($cdom ne $env{'user.domain'}) {
18091: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
18092: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
18093: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
18094: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
18095: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
18096: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
18097: my $canhost =
18098: &Apache::lonnet::can_host_session($env{'user.domain'},
18099: $coursedomserver,
18100: $remoterev,
18101: $udomdefaults{'remotesessions'},
18102: $defdomdefaults{'hostedsessions'});
18103:
18104: if ($canhost) {
18105: $otherserver = $coursedomserver;
18106: } else {
18107: $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.");
18108: }
18109: } else {
18110: $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).");
18111: }
18112: } else {
18113: $otherserver = $userdomserver;
18114: }
18115: }
18116: if ($otherserver ne '') {
18117: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
18118: }
18119: }
18120: }
18121: return ($switchserver,$warning);
18122: }
18123:
18124: =pod
18125:
18126: =item * &check_release_result()
18127:
18128: Inputs:
18129:
18130: $switchwarning - Warning message if no suitable server found to host session.
18131:
18132: $switchserver - query string to append to /adm/switchserver containing lonHostID
18133: and current role.
18134:
18135: Returns: HTML to display with information about requirement to switch server.
18136: Either displaying warning with link to Roles/Courses screen or
18137: display link to switchserver.
18138:
1.1181 raeburn 18139: =cut
18140:
1.1207 raeburn 18141: sub check_release_result {
18142: my ($switchwarning,$switchserver) = @_;
18143: my $output = &start_page('Selected course unavailable on this server').
18144: '<p class="LC_warning">';
18145: if ($switchwarning) {
18146: $output .= $switchwarning.'<br /><a href="/adm/roles">';
18147: if (&show_course()) {
18148: $output .= &mt('Display courses');
18149: } else {
18150: $output .= &mt('Display roles');
18151: }
18152: $output .= '</a>';
18153: } elsif ($switchserver) {
18154: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
18155: '<br />'.
18156: '<a href="/adm/switchserver?'.$switchserver.'">'.
18157: &mt('Switch Server').
18158: '</a>';
18159: }
18160: $output .= '</p>'.&end_page();
18161: return $output;
18162: }
18163:
18164: =pod
18165:
18166: =item * &needs_coursereinit()
18167:
18168: Determine if course contents stored for user's session needs to be
18169: refreshed, because content has changed since "Big Hash" last tied.
18170:
18171: Check for change is made if time last checked is more than 10 minutes ago
18172: (by default).
18173:
18174: Inputs:
18175:
18176: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18177:
18178: $interval (optional) - Time which may elapse (in s) between last check for content
18179: change in current course. (default: 600 s).
18180:
18181: Returns: an array; first element is:
18182:
18183: =over 4
18184:
18185: 'switch' - if content updates mean user's session
18186: needs to be switched to a server running a newer LON-CAPA version
18187:
18188: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
18189: on current server hosting user's session
18190:
18191: '' - if no action required.
18192:
18193: =back
18194:
18195: If first item element is 'switch':
18196:
18197: second item is $switchwarning - Warning message if no suitable server found to host session.
18198:
18199: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
18200: and current role.
18201:
18202: otherwise: no other elements returned.
18203:
18204: =back
18205:
18206: =cut
18207:
18208: sub needs_coursereinit {
18209: my ($loncaparev,$interval) = @_;
18210: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
18211: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18212: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
18213: my $now = time;
18214: if ($interval eq '') {
18215: $interval = 600;
18216: }
18217: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 18218: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1372 raeburn 18219: my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 18220: if ($blocked) {
18221: return ();
18222: }
1.1207 raeburn 18223: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
18224: if ($lastchange > $env{'request.course.tied'}) {
18225: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18226: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
18227: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
18228: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
18229: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
18230: $curr_reqd_hash{'internal.releaserequired'}});
18231: my ($switchserver,$switchwarning) =
18232: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
18233: $curr_reqd_hash{'internal.releaserequired'});
18234: if ($switchwarning ne '' || $switchserver ne '') {
18235: return ('switch',$switchwarning,$switchserver);
18236: }
18237: }
18238: }
18239: return ('update');
18240: }
18241: }
18242: return ();
18243: }
1.1181 raeburn 18244:
1.1083 raeburn 18245: sub update_content_constraints {
1.1326 raeburn 18246: my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
1.1083 raeburn 18247: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18248: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 18249: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 18250: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 18251: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 18252: if ($item eq 'resourcetag') {
18253: if ($name eq 'responsetype') {
18254: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
18255: }
1.1307 raeburn 18256: } elsif ($item eq 'course') {
18257: if ($name eq 'courserestype') {
18258: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
18259: }
1.1083 raeburn 18260: }
18261: }
18262: my $navmap = Apache::lonnavmaps::navmap->new();
18263: if (defined($navmap)) {
1.1307 raeburn 18264: my (%allresponses,%allcrsrestypes);
18265: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
18266: if ($res->is_tool()) {
18267: if ($allcrsrestypes{'exttool'}) {
18268: $allcrsrestypes{'exttool'} ++;
18269: } else {
18270: $allcrsrestypes{'exttool'} = 1;
18271: }
18272: next;
18273: }
1.1083 raeburn 18274: my %responses = $res->responseTypes();
18275: foreach my $key (keys(%responses)) {
18276: next unless(exists($checkresponsetypes{$key}));
18277: $allresponses{$key} += $responses{$key};
18278: }
18279: }
18280: foreach my $key (keys(%allresponses)) {
18281: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
18282: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18283: ($reqdmajor,$reqdminor) = ($major,$minor);
18284: }
18285: }
1.1307 raeburn 18286: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 18287: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 18288: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18289: ($reqdmajor,$reqdminor) = ($major,$minor);
18290: }
18291: }
1.1083 raeburn 18292: undef($navmap);
18293: }
1.1326 raeburn 18294: my (@resources,@order,@resparms,@zombies);
18295: if ($keeporder) {
18296: use LONCAPA::map;
18297: @resources = @LONCAPA::map::resources;
18298: @order = @LONCAPA::map::order;
18299: @resparms = @LONCAPA::map::resparms;
18300: @zombies = @LONCAPA::map::zombies;
18301: }
1.1308 raeburn 18302: my $suppmap = 'supplemental.sequence';
18303: my ($suppcount,$supptools,$errors) = (0,0,0);
18304: ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
18305: $suppcount,$supptools,$errors);
1.1326 raeburn 18306: if ($keeporder) {
18307: @LONCAPA::map::resources = @resources;
18308: @LONCAPA::map::order = @order;
18309: @LONCAPA::map::resparms = @resparms;
18310: @LONCAPA::map::zombies = @zombies;
18311: }
1.1308 raeburn 18312: if ($supptools) {
18313: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
18314: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18315: ($reqdmajor,$reqdminor) = ($major,$minor);
18316: }
18317: }
1.1083 raeburn 18318: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
18319: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
18320: }
18321: return;
18322: }
18323:
1.1110 raeburn 18324: sub allmaps_incourse {
18325: my ($cdom,$cnum,$chome,$cid) = @_;
18326: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
18327: $cid = $env{'request.course.id'};
18328: $cdom = $env{'course.'.$cid.'.domain'};
18329: $cnum = $env{'course.'.$cid.'.num'};
18330: $chome = $env{'course.'.$cid.'.home'};
18331: }
18332: my %allmaps = ();
18333: my $lastchange =
18334: &Apache::lonnet::get_coursechange($cdom,$cnum);
18335: if ($lastchange > $env{'request.course.tied'}) {
18336: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
18337: unless ($ferr) {
1.1326 raeburn 18338: &update_content_constraints($cdom,$cnum,$chome,$cid,1);
1.1110 raeburn 18339: }
18340: }
18341: my $navmap = Apache::lonnavmaps::navmap->new();
18342: if (defined($navmap)) {
18343: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
18344: $allmaps{$res->src()} = 1;
18345: }
18346: }
18347: return \%allmaps;
18348: }
18349:
1.1083 raeburn 18350: sub parse_supplemental_title {
18351: my ($title) = @_;
18352:
18353: my ($foldertitle,$renametitle);
18354: if ($title =~ /&&&/) {
18355: $title = &HTML::Entites::decode($title);
18356: }
18357: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
18358: $renametitle=$4;
18359: my ($time,$uname,$udom) = ($1,$2,$3);
18360: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
18361: my $name = &plainname($uname,$udom);
18362: $name = &HTML::Entities::encode($name,'"<>&\'');
18363: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
18364: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
18365: $name.': <br />'.$foldertitle;
18366: }
18367: if (wantarray) {
18368: return ($title,$foldertitle,$renametitle);
18369: }
18370: return $title;
18371: }
18372:
1.1143 raeburn 18373: sub recurse_supplemental {
1.1308 raeburn 18374: my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
1.1143 raeburn 18375: if ($suppmap) {
18376: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
18377: if ($fatal) {
18378: $errors ++;
18379: } else {
18380: if ($#LONCAPA::map::resources > 0) {
18381: foreach my $res (@LONCAPA::map::resources) {
18382: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
18383: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 18384: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1308 raeburn 18385: ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
18386: $numfiles,$numexttools,$errors);
1.1143 raeburn 18387: } else {
1.1308 raeburn 18388: if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
18389: $numexttools ++;
18390: }
1.1143 raeburn 18391: $numfiles ++;
18392: }
18393: }
18394: }
18395: }
18396: }
18397: }
1.1308 raeburn 18398: return ($numfiles,$numexttools,$errors);
1.1143 raeburn 18399: }
18400:
1.1101 raeburn 18401: sub symb_to_docspath {
1.1267 raeburn 18402: my ($symb,$navmapref) = @_;
18403: return unless ($symb && ref($navmapref));
1.1101 raeburn 18404: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
18405: if ($resurl=~/\.(sequence|page)$/) {
18406: $mapurl=$resurl;
18407: } elsif ($resurl eq 'adm/navmaps') {
18408: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
18409: }
18410: my $mapresobj;
1.1267 raeburn 18411: unless (ref($$navmapref)) {
18412: $$navmapref = Apache::lonnavmaps::navmap->new();
18413: }
18414: if (ref($$navmapref)) {
18415: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 18416: }
18417: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
18418: my $type=$2;
18419: my $path;
18420: if (ref($mapresobj)) {
18421: my $pcslist = $mapresobj->map_hierarchy();
18422: if ($pcslist ne '') {
18423: foreach my $pc (split(/,/,$pcslist)) {
18424: next if ($pc <= 1);
1.1267 raeburn 18425: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 18426: if (ref($res)) {
18427: my $thisurl = $res->src();
18428: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
18429: my $thistitle = $res->title();
18430: $path .= '&'.
18431: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 18432: &escape($thistitle).
1.1101 raeburn 18433: ':'.$res->randompick().
18434: ':'.$res->randomout().
18435: ':'.$res->encrypted().
18436: ':'.$res->randomorder().
18437: ':'.$res->is_page();
18438: }
18439: }
18440: }
18441: $path =~ s/^\&//;
18442: my $maptitle = $mapresobj->title();
18443: if ($mapurl eq 'default') {
1.1129 raeburn 18444: $maptitle = 'Main Content';
1.1101 raeburn 18445: }
18446: $path .= (($path ne '')? '&' : '').
18447: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 18448: &escape($maptitle).
1.1101 raeburn 18449: ':'.$mapresobj->randompick().
18450: ':'.$mapresobj->randomout().
18451: ':'.$mapresobj->encrypted().
18452: ':'.$mapresobj->randomorder().
18453: ':'.$mapresobj->is_page();
18454: } else {
18455: my $maptitle = &Apache::lonnet::gettitle($mapurl);
18456: my $ispage = (($type eq 'page')? 1 : '');
18457: if ($mapurl eq 'default') {
1.1129 raeburn 18458: $maptitle = 'Main Content';
1.1101 raeburn 18459: }
18460: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 18461: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 18462: }
18463: unless ($mapurl eq 'default') {
18464: $path = 'default&'.
1.1146 raeburn 18465: &escape('Main Content').
1.1101 raeburn 18466: ':::::&'.$path;
18467: }
18468: return $path;
18469: }
18470:
1.1094 raeburn 18471: sub captcha_display {
1.1327 raeburn 18472: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 18473: my ($output,$error);
1.1234 raeburn 18474: my ($captcha,$pubkey,$privkey,$version) =
1.1327 raeburn 18475: &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 18476: if ($captcha eq 'original') {
1.1094 raeburn 18477: $output = &create_captcha();
18478: unless ($output) {
1.1172 raeburn 18479: $error = 'captcha';
1.1094 raeburn 18480: }
18481: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 18482: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 18483: unless ($output) {
1.1172 raeburn 18484: $error = 'recaptcha';
1.1094 raeburn 18485: }
18486: }
1.1234 raeburn 18487: return ($output,$error,$captcha,$version);
1.1094 raeburn 18488: }
18489:
18490: sub captcha_response {
1.1327 raeburn 18491: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 18492: my ($captcha_chk,$captcha_error);
1.1327 raeburn 18493: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 18494: if ($captcha eq 'original') {
1.1094 raeburn 18495: ($captcha_chk,$captcha_error) = &check_captcha();
18496: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 18497: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 18498: } else {
18499: $captcha_chk = 1;
18500: }
18501: return ($captcha_chk,$captcha_error);
18502: }
18503:
18504: sub get_captcha_config {
1.1327 raeburn 18505: my ($context,$lonhost,$dom_in_effect) = @_;
1.1234 raeburn 18506: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 18507: my $hostname = &Apache::lonnet::hostname($lonhost);
18508: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
18509: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 18510: if ($context eq 'usercreation') {
18511: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
18512: if (ref($domconfig{$context}) eq 'HASH') {
18513: $hashtocheck = $domconfig{$context}{'cancreate'};
18514: if (ref($hashtocheck) eq 'HASH') {
18515: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
18516: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
18517: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
18518: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
18519: }
18520: if ($privkey && $pubkey) {
18521: $captcha = 'recaptcha';
1.1234 raeburn 18522: $version = $hashtocheck->{'recaptchaversion'};
18523: if ($version ne '2') {
18524: $version = 1;
18525: }
1.1095 raeburn 18526: } else {
18527: $captcha = 'original';
18528: }
18529: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
18530: $captcha = 'original';
18531: }
1.1094 raeburn 18532: }
1.1095 raeburn 18533: } else {
18534: $captcha = 'captcha';
18535: }
18536: } elsif ($context eq 'login') {
18537: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
18538: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
18539: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
18540: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 18541: if ($privkey && $pubkey) {
18542: $captcha = 'recaptcha';
1.1234 raeburn 18543: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
18544: if ($version ne '2') {
18545: $version = 1;
18546: }
1.1095 raeburn 18547: } else {
18548: $captcha = 'original';
1.1094 raeburn 18549: }
1.1095 raeburn 18550: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
18551: $captcha = 'original';
1.1094 raeburn 18552: }
1.1327 raeburn 18553: } elsif ($context eq 'passwords') {
18554: if ($dom_in_effect) {
18555: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
18556: if ($passwdconf{'captcha'} eq 'recaptcha') {
18557: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
18558: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
18559: $privkey = $passwdconf{'recaptchakeys'}{'private'};
18560: }
18561: if ($privkey && $pubkey) {
18562: $captcha = 'recaptcha';
18563: $version = $passwdconf{'recaptchaversion'};
18564: if ($version ne '2') {
18565: $version = 1;
18566: }
18567: } else {
18568: $captcha = 'original';
18569: }
18570: } elsif ($passwdconf{'captcha'} ne 'notused') {
18571: $captcha = 'original';
18572: }
18573: }
18574: }
1.1234 raeburn 18575: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 18576: }
18577:
18578: sub create_captcha {
18579: my %captcha_params = &captcha_settings();
18580: my ($output,$maxtries,$tries) = ('',10,0);
18581: while ($tries < $maxtries) {
18582: $tries ++;
18583: my $captcha = Authen::Captcha->new (
18584: output_folder => $captcha_params{'output_dir'},
18585: data_folder => $captcha_params{'db_dir'},
18586: );
18587: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
18588:
18589: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
18590: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1367 raeburn 18591: '<span class="LC_nobreak">'.
1.1094 raeburn 18592: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 18593: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
1.1367 raeburn 18594: '</span><br />'.
1.1176 raeburn 18595: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 18596: last;
18597: }
18598: }
1.1323 raeburn 18599: if ($output eq '') {
18600: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
18601: }
1.1094 raeburn 18602: return $output;
18603: }
18604:
18605: sub captcha_settings {
18606: my %captcha_params = (
18607: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
18608: www_output_dir => "/captchaspool",
18609: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
18610: numchars => '5',
18611: );
18612: return %captcha_params;
18613: }
18614:
18615: sub check_captcha {
18616: my ($captcha_chk,$captcha_error);
18617: my $code = $env{'form.code'};
18618: my $md5sum = $env{'form.crypt'};
18619: my %captcha_params = &captcha_settings();
18620: my $captcha = Authen::Captcha->new(
18621: output_folder => $captcha_params{'output_dir'},
18622: data_folder => $captcha_params{'db_dir'},
18623: );
1.1109 raeburn 18624: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 18625: my %captcha_hash = (
18626: 0 => 'Code not checked (file error)',
18627: -1 => 'Failed: code expired',
18628: -2 => 'Failed: invalid code (not in database)',
18629: -3 => 'Failed: invalid code (code does not match crypt)',
18630: );
18631: if ($captcha_chk != 1) {
18632: $captcha_error = $captcha_hash{$captcha_chk}
18633: }
18634: return ($captcha_chk,$captcha_error);
18635: }
18636:
18637: sub create_recaptcha {
1.1234 raeburn 18638: my ($pubkey,$version) = @_;
18639: if ($version >= 2) {
1.1367 raeburn 18640: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
18641: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1234 raeburn 18642: } else {
18643: my $use_ssl;
18644: if ($ENV{'SERVER_PORT'} == 443) {
18645: $use_ssl = 1;
18646: }
18647: my $captcha = Captcha::reCAPTCHA->new;
18648: return $captcha->get_options_setter({theme => 'white'})."\n".
18649: $captcha->get_html($pubkey,undef,$use_ssl).
18650: &mt('If the text is hard to read, [_1] will replace them.',
18651: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
18652: '<br /><br />';
18653: }
1.1094 raeburn 18654: }
18655:
18656: sub check_recaptcha {
1.1234 raeburn 18657: my ($privkey,$version) = @_;
1.1094 raeburn 18658: my $captcha_chk;
1.1350 raeburn 18659: my $ip = &Apache::lonnet::get_requestor_ip();
1.1234 raeburn 18660: if ($version >= 2) {
18661: my %info = (
18662: secret => $privkey,
18663: response => $env{'form.g-recaptcha-response'},
1.1350 raeburn 18664: remoteip => $ip,
1.1234 raeburn 18665: );
1.1280 raeburn 18666: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
18667: $request->content(join('&',map {
18668: my $name = escape($_);
18669: "$name=" . ( ref($info{$_}) eq 'ARRAY'
18670: ? join("&$name=", map {escape($_) } @{$info{$_}})
18671: : &escape($info{$_}) );
18672: } keys(%info)));
18673: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 18674: if ($response->is_success) {
18675: my $data = JSON::DWIW->from_json($response->decoded_content);
18676: if (ref($data) eq 'HASH') {
18677: if ($data->{'success'}) {
18678: $captcha_chk = 1;
18679: }
18680: }
18681: }
18682: } else {
18683: my $captcha = Captcha::reCAPTCHA->new;
18684: my $captcha_result =
18685: $captcha->check_answer(
18686: $privkey,
1.1350 raeburn 18687: $ip,
1.1234 raeburn 18688: $env{'form.recaptcha_challenge_field'},
18689: $env{'form.recaptcha_response_field'},
18690: );
18691: if ($captcha_result->{is_valid}) {
18692: $captcha_chk = 1;
18693: }
1.1094 raeburn 18694: }
18695: return $captcha_chk;
18696: }
18697:
1.1174 raeburn 18698: sub emailusername_info {
1.1244 raeburn 18699: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 18700: my %titles = &Apache::lonlocal::texthash (
18701: lastname => 'Last Name',
18702: firstname => 'First Name',
18703: institution => 'School/college/university',
18704: location => "School's city, state/province, country",
18705: web => "School's web address",
18706: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 18707: id => 'Student/Employee ID',
1.1174 raeburn 18708: );
18709: return (\@fields,\%titles);
18710: }
18711:
1.1161 raeburn 18712: sub cleanup_html {
18713: my ($incoming) = @_;
18714: my $outgoing;
18715: if ($incoming ne '') {
18716: $outgoing = $incoming;
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: $outgoing =~ s/"/"/g;
18725: $outgoing =~ s/'/'/g;
18726: $outgoing =~ s/\$/$/g;
18727: $outgoing =~ s{/}{/}g;
18728: $outgoing =~ s/=/=/g;
18729: $outgoing =~ s/\\/\/g
18730: }
18731: return $outgoing;
18732: }
18733:
1.1190 musolffc 18734: # Checks for critical messages and returns a redirect url if one exists.
18735: # $interval indicates how often to check for messages.
1.1282 raeburn 18736: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 18737: sub critical_redirect {
1.1282 raeburn 18738: my ($interval,$context) = @_;
1.1356 raeburn 18739: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
18740: return ();
18741: }
1.1190 musolffc 18742: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 18743: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
18744: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18745: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 18746: my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 18747: if ($blocked) {
18748: my $checkrole = "cm./$cdom/$cnum";
18749: if ($env{'request.course.sec'} ne '') {
18750: $checkrole .= "/$env{'request.course.sec'}";
18751: }
18752: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
18753: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
18754: return;
18755: }
18756: }
18757: }
1.1190 musolffc 18758: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
18759: $env{'user.name'});
18760: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 18761: my $redirecturl;
1.1190 musolffc 18762: if ($what[0]) {
1.1356 raeburn 18763: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1190 musolffc 18764: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 18765: my $url=&Apache::lonnet::absolute_url().$redirecturl;
18766: return (1, $url);
1.1190 musolffc 18767: }
1.1191 raeburn 18768: }
18769: }
18770: return ();
1.1190 musolffc 18771: }
18772:
1.1174 raeburn 18773: # Use:
18774: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
18775: #
18776: ##################################################
18777: # password associated functions #
18778: ##################################################
18779: sub des_keys {
18780: # Make a new key for DES encryption.
18781: # Each key has two parts which are returned separately.
18782: # Please note: Each key must be passed through the &hex function
18783: # before it is output to the web browser. The hex versions cannot
18784: # be used to decrypt.
18785: my @hexstr=('0','1','2','3','4','5','6','7',
18786: '8','9','a','b','c','d','e','f');
18787: my $lkey='';
18788: for (0..7) {
18789: $lkey.=$hexstr[rand(15)];
18790: }
18791: my $ukey='';
18792: for (0..7) {
18793: $ukey.=$hexstr[rand(15)];
18794: }
18795: return ($lkey,$ukey);
18796: }
18797:
18798: sub des_decrypt {
18799: my ($key,$cyphertext) = @_;
18800: my $keybin=pack("H16",$key);
18801: my $cypher;
18802: if ($Crypt::DES::VERSION>=2.03) {
18803: $cypher=new Crypt::DES $keybin;
18804: } else {
18805: $cypher=new DES $keybin;
18806: }
1.1233 raeburn 18807: my $plaintext='';
18808: my $cypherlength = length($cyphertext);
18809: my $numchunks = int($cypherlength/32);
18810: for (my $j=0; $j<$numchunks; $j++) {
18811: my $start = $j*32;
18812: my $cypherblock = substr($cyphertext,$start,32);
18813: my $chunk =
18814: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
18815: $chunk .=
18816: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
18817: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
18818: $plaintext .= $chunk;
18819: }
1.1174 raeburn 18820: return $plaintext;
18821: }
18822:
1.1344 raeburn 18823: sub get_requested_shorturls {
1.1309 raeburn 18824: my ($cdom,$cnum,$navmap) = @_;
18825: return unless (ref($navmap));
1.1344 raeburn 18826: my ($numnew,$errors);
1.1309 raeburn 18827: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
18828: if (@toshorten) {
18829: my (%maps,%resources,%titles);
18830: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
18831: 'shorturls',$cdom,$cnum);
18832: if (keys(%resources)) {
1.1344 raeburn 18833: my %tocreate;
1.1309 raeburn 18834: foreach my $item (sort {$a <=> $b} (@toshorten)) {
18835: my $symb = $resources{$item};
18836: if ($symb) {
18837: $tocreate{$cnum.'&'.$symb} = 1;
18838: }
18839: }
1.1344 raeburn 18840: if (keys(%tocreate)) {
18841: ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
18842: \%tocreate);
18843: }
1.1309 raeburn 18844: }
1.1344 raeburn 18845: }
18846: return ($numnew,$errors);
18847: }
18848:
18849: sub make_short_symbs {
18850: my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
18851: my ($numnew,@errors);
18852: if (ref($tocreateref) eq 'HASH') {
18853: my %tocreate = %{$tocreateref};
1.1309 raeburn 18854: if (keys(%tocreate)) {
18855: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
18856: my $su = Short::URL->new(no_vowels => 1);
18857: my $init = '';
18858: my (%newunique,%addcourse,%courseonly,%failed);
18859: # get lock on tiny db
18860: my $now = time;
1.1344 raeburn 18861: if ($lockuser eq '') {
18862: $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
18863: }
1.1309 raeburn 18864: my $lockhash = {
1.1344 raeburn 18865: "lock\0$now" => $lockuser,
1.1309 raeburn 18866: };
18867: my $tries = 0;
18868: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
18869: my ($code,$error);
18870: while (($gotlock ne 'ok') && ($tries<3)) {
18871: $tries ++;
18872: sleep 1;
1.1319 raeburn 18873: $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309 raeburn 18874: }
18875: if ($gotlock eq 'ok') {
18876: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
18877: \%addcourse,\%courseonly,\%failed);
18878: if (keys(%failed)) {
18879: my $numfailed = scalar(keys(%failed));
18880: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
18881: }
18882: if (keys(%newunique)) {
18883: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
18884: if ($putres eq 'ok') {
18885: $numnew = scalar(keys(%newunique));
18886: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
18887: unless ($newputres eq 'ok') {
18888: push(@errors,&mt('error: could not store course look-up of short URLs'));
18889: }
18890: } else {
18891: push(@errors,&mt('error: could not store unique six character URLs'));
18892: }
18893: }
18894: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
18895: unless ($dellockres eq 'ok') {
18896: push(@errors,&mt('error: could not release lockfile'));
18897: }
18898: } else {
18899: push(@errors,&mt('error: could not obtain lockfile'));
18900: }
18901: if (keys(%courseonly)) {
18902: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
18903: if ($result ne 'ok') {
18904: push(@errors,&mt('error: could not update course look-up of short URLs'));
18905: }
18906: }
18907: }
18908: }
18909: return ($numnew,\@errors);
18910: }
18911:
18912: sub shorten_symbs {
18913: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
18914: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
18915: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
18916: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
18917: my (%possibles,%collisions);
18918: foreach my $key (keys(%{$tocreate})) {
18919: my $num = String::CRC32::crc32($key);
18920: my $tiny = $su->encode($num,$init);
18921: if ($tiny) {
18922: $possibles{$tiny} = $key;
18923: }
18924: }
18925: if (!$init) {
18926: $init = 1;
18927: } else {
18928: $init ++;
18929: }
18930: if (keys(%possibles)) {
18931: my @posstiny = keys(%possibles);
18932: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
18933: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
18934: if (keys(%currtiny)) {
18935: foreach my $key (keys(%currtiny)) {
18936: next if ($currtiny{$key} eq '');
18937: if ($currtiny{$key} eq $possibles{$key}) {
18938: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
18939: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18940: $courseonly->{$tsymb} = $key;
18941: }
18942: } else {
18943: $collisions{$possibles{$key}} = 1;
18944: }
18945: delete($possibles{$key});
18946: }
18947: }
18948: foreach my $key (keys(%possibles)) {
18949: $newunique->{$key} = $possibles{$key};
18950: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
18951: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
18952: $addcourse->{$tsymb} = $key;
18953: }
18954: }
18955: }
18956: if (keys(%collisions)) {
18957: if ($init <5) {
18958: if (!$init) {
18959: $init = 1;
18960: } else {
18961: $init ++;
18962: }
18963: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
18964: $newunique,$addcourse,$courseonly,$failed);
18965: } else {
18966: foreach my $key (keys(%collisions)) {
18967: $failed->{$key} = 1;
18968: }
18969: }
18970: }
18971: return $init;
18972: }
18973:
1.1328 raeburn 18974: sub is_nonframeable {
1.1329 raeburn 18975: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
18976: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330 raeburn 18977: return if (($remprotocol eq '') || ($remhost eq ''));
1.1329 raeburn 18978:
18979: $remprotocol = lc($remprotocol);
18980: $remhost = lc($remhost);
18981: my $remport = 80;
18982: if ($remprotocol eq 'https') {
18983: $remport = 443;
18984: }
1.1330 raeburn 18985: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329 raeburn 18986: if ($cached) {
18987: unless ($nocache) {
18988: if ($result) {
18989: return 1;
18990: } else {
18991: return 0;
18992: }
18993: }
18994: }
1.1328 raeburn 18995: my $uselink;
18996: my $request = new HTTP::Request('HEAD',$url);
18997: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
18998: if ($response->is_success()) {
18999: my $secpolicy = lc($response->header('content-security-policy'));
19000: my $xframeop = lc($response->header('x-frame-options'));
19001: $secpolicy =~ s/^\s+|\s+$//g;
19002: $xframeop =~ s/^\s+|\s+$//g;
19003: if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329 raeburn 19004: my $remotehost = $remprotocol.'://'.$remhost;
1.1328 raeburn 19005: my ($origin,$protocol,$port);
19006: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
19007: $port = $ENV{'SERVER_PORT'};
19008: } else {
19009: $port = 80;
19010: }
19011: if ($absolute eq '') {
19012: $protocol = 'http:';
19013: if ($port == 443) {
19014: $protocol = 'https:';
19015: }
19016: $origin = $protocol.'//'.lc($hostname);
19017: } else {
19018: $origin = lc($absolute);
19019: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
19020: }
19021: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
19022: my $framepolicy = $1;
19023: $framepolicy =~ s/^\s+|\s+$//g;
19024: my @policies = split(/\s+/,$framepolicy);
19025: if (@policies) {
19026: if (grep(/^\Q'none'\E$/,@policies)) {
19027: $uselink = 1;
19028: } else {
19029: $uselink = 1;
19030: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
19031: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
19032: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
19033: undef($uselink);
19034: }
19035: if ($uselink) {
19036: if (grep(/^\Q'self'\E$/,@policies)) {
19037: if (($origin ne '') && ($remotehost eq $origin)) {
19038: undef($uselink);
19039: }
19040: }
19041: }
19042: if ($uselink) {
19043: my @possok;
19044: if ($ip ne '') {
19045: push(@possok,$ip);
19046: }
19047: my $hoststr = '';
19048: foreach my $part (reverse(split(/\./,$hostname))) {
19049: if ($hoststr eq '') {
19050: $hoststr = $part;
19051: } else {
19052: $hoststr = "$part.$hoststr";
19053: }
19054: if ($hoststr eq $hostname) {
19055: push(@possok,$hostname);
19056: } else {
19057: push(@possok,"*.$hoststr");
19058: }
19059: }
19060: if (@possok) {
19061: foreach my $poss (@possok) {
19062: last if (!$uselink);
19063: foreach my $policy (@policies) {
19064: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
19065: undef($uselink);
19066: last;
19067: }
19068: }
19069: }
19070: }
19071: }
19072: }
19073: }
19074: } elsif ($xframeop ne '') {
19075: $uselink = 1;
19076: my @policies = split(/\s*,\s*/,$xframeop);
19077: if (@policies) {
19078: unless (grep(/^deny$/,@policies)) {
19079: if ($origin ne '') {
19080: if (grep(/^sameorigin$/,@policies)) {
19081: if ($remotehost eq $origin) {
19082: undef($uselink);
19083: }
19084: }
19085: if ($uselink) {
19086: foreach my $policy (@policies) {
19087: if ($policy =~ /^allow-from\s*(.+)$/) {
19088: my $allowfrom = $1;
19089: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
19090: undef($uselink);
19091: last;
19092: }
19093: }
19094: }
19095: }
19096: }
19097: }
19098: }
19099: }
19100: }
19101: }
1.1329 raeburn 19102: if ($nocache) {
19103: if ($cached) {
19104: my $devalidate;
19105: if ($uselink && !$result) {
19106: $devalidate = 1;
19107: } elsif (!$uselink && $result) {
19108: $devalidate = 1;
19109: }
19110: if ($devalidate) {
19111: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
19112: }
19113: }
19114: } else {
19115: if ($uselink) {
19116: $result = 1;
19117: } else {
19118: $result = 0;
19119: }
19120: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
19121: }
1.1328 raeburn 19122: return $uselink;
19123: }
19124:
1.1359 raeburn 19125: sub page_menu {
19126: my ($menucolls,$menunum) = @_;
19127: my %menu;
19128: foreach my $item (split(/;/,$menucolls)) {
19129: my ($num,$value) = split(/\%/,$item);
19130: if ($num eq $menunum) {
19131: my @entries = split(/\&/,$value);
19132: foreach my $entry (@entries) {
19133: my ($name,$fields) = split(/=/,$entry);
1.1368 raeburn 19134: if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
1.1359 raeburn 19135: $menu{$name} = $fields;
19136: } else {
19137: my @shown;
19138: if ($fields =~ /,/) {
19139: @shown = split(/,/,$fields);
19140: } else {
19141: @shown = ($fields);
19142: }
19143: if (@shown) {
19144: foreach my $field (@shown) {
19145: next if ($field eq '');
19146: $menu{$field} = 1;
19147: }
19148: }
19149: }
19150: }
19151: }
19152: }
19153: return %menu;
19154: }
19155:
1.112 bowersj2 19156: 1;
19157: __END__;
1.41 ng 19158:
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