Annotation of loncom/interface/loncommon.pm, revision 1.1399
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1399 ! raeburn 4: # $Id: loncommon.pm,v 1.1398 2022/11/24 00:49:48 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.1383 raeburn 64: use Apache::lonnavmaps();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.1108 raeburn 70: use Apache::lonuserutils();
1.1110 raeburn 71: use Apache::lonuserstate();
1.1182 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.1280 raeburn 74: use LONCAPA::LWPReq;
1.1395 raeburn 75: use LONCAPA::map();
1.1328 raeburn 76: use HTTP::Request;
1.657 raeburn 77: use DateTime::TimeZone;
1.1241 raeburn 78: use DateTime::Locale;
1.1220 raeburn 79: use Encode();
1.1091 foxr 80: use Text::Aspell;
1.1094 raeburn 81: use Authen::Captcha;
82: use Captcha::reCAPTCHA;
1.1234 raeburn 83: use JSON::DWIW;
1.1174 raeburn 84: use Crypt::DES;
85: use DynaLoader; # for Crypt::DES version
1.1223 musolffc 86: use MIME::Lite;
87: use MIME::Types;
1.1292 raeburn 88: use File::Copy();
1.1300 raeburn 89: use File::Path();
1.1309 raeburn 90: use String::CRC32();
91: use Short::URL();
1.117 www 92:
1.517 raeburn 93: # ---------------------------------------------- Designs
94: use vars qw(%defaultdesign);
95:
1.22 www 96: my $readit;
97:
1.517 raeburn 98:
1.157 matthew 99: ##
100: ## Global Variables
101: ##
1.46 matthew 102:
1.643 foxr 103:
104: # ----------------------------------------------- SSI with retries:
105: #
106:
107: =pod
108:
1.648 raeburn 109: =head1 Server Side include with retries:
1.643 foxr 110:
111: =over 4
112:
1.648 raeburn 113: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 114:
115: Performs an ssi with some number of retries. Retries continue either
116: until the result is ok or until the retry count supplied by the
117: caller is exhausted.
118:
119: Inputs:
1.648 raeburn 120:
121: =over 4
122:
1.643 foxr 123: resource - Identifies the resource to insert.
1.648 raeburn 124:
1.643 foxr 125: retries - Count of the number of retries allowed.
1.648 raeburn 126:
1.643 foxr 127: form - Hash that identifies the rendering options.
128:
1.648 raeburn 129: =back
130:
131: Returns:
132:
133: =over 4
134:
1.643 foxr 135: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 136:
1.643 foxr 137: response - The response from the last attempt (which may or may not have been successful.
138:
1.648 raeburn 139: =back
140:
141: =back
142:
1.643 foxr 143: =cut
144:
145: sub ssi_with_retries {
146: my ($resource, $retries, %form) = @_;
147:
148:
149: my $ok = 0; # True if we got a good response.
150: my $content;
151: my $response;
152:
153: # Try to get the ssi done. within the retries count:
154:
155: do {
156: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
157: $ok = $response->is_success;
1.650 www 158: if (!$ok) {
159: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
160: }
1.643 foxr 161: $retries--;
162: } while (!$ok && ($retries > 0));
163:
164: if (!$ok) {
165: $content = ''; # On error return an empty content.
166: }
167: return ($content, $response);
168:
169: }
170:
171:
172:
1.20 www 173: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 174: my %language;
1.124 www 175: my %supported_language;
1.1088 foxr 176: my %supported_codes;
1.1048 foxr 177: my %latex_language; # For choosing hyphenation in <transl..>
178: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 179: my %cprtag;
1.192 taceyjo1 180: my %scprtag;
1.351 www 181: my %fe; my %fd; my %fm;
1.41 ng 182: my %category_extensions;
1.12 harris41 183:
1.46 matthew 184: # ---------------------------------------------- Thesaurus variables
1.144 matthew 185: #
186: # %Keywords:
187: # A hash used by &keyword to determine if a word is considered a keyword.
188: # $thesaurus_db_file
189: # Scalar containing the full path to the thesaurus database.
1.46 matthew 190:
191: my %Keywords;
192: my $thesaurus_db_file;
193:
1.144 matthew 194: #
195: # Initialize values from language.tab, copyright.tab, filetypes.tab,
196: # thesaurus.tab, and filecategories.tab.
197: #
1.18 www 198: BEGIN {
1.46 matthew 199: # Variable initialization
200: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
201: #
1.22 www 202: unless ($readit) {
1.12 harris41 203: # ------------------------------------------------------------------- languages
204: {
1.158 raeburn 205: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
206: '/language.tab';
1.1317 raeburn 207: if ( open(my $fh,'<',$langtabfile) ) {
1.356 albertel 208: while (my $line = <$fh>) {
209: next if ($line=~/^\#/);
210: chomp($line);
1.1088 foxr 211: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 212: $language{$key}=$val.' - '.$enc;
213: if ($sup) {
214: $supported_language{$key}=$sup;
1.1088 foxr 215: $supported_codes{$key} = $code;
1.158 raeburn 216: }
1.1048 foxr 217: if ($latex) {
218: $latex_language_bykey{$key} = $latex;
1.1088 foxr 219: $latex_language{$code} = $latex;
1.1048 foxr 220: }
1.158 raeburn 221: }
222: close($fh);
223: }
1.12 harris41 224: }
225: # ------------------------------------------------------------------ copyrights
226: {
1.158 raeburn 227: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
228: '/copyright.tab';
1.1317 raeburn 229: if ( open (my $fh,'<',$copyrightfile) ) {
1.356 albertel 230: while (my $line = <$fh>) {
231: next if ($line=~/^\#/);
232: chomp($line);
233: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 234: $cprtag{$key}=$val;
235: }
236: close($fh);
237: }
1.12 harris41 238: }
1.351 www 239: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 240: {
241: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
242: '/source_copyright.tab';
1.1317 raeburn 243: if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356 albertel 244: while (my $line = <$fh>) {
245: next if ($line =~ /^\#/);
246: chomp($line);
247: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 248: $scprtag{$key}=$val;
249: }
250: close($fh);
251: }
252: }
1.63 www 253:
1.517 raeburn 254: # -------------------------------------------------------------- default domain designs
1.63 www 255: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 256: my $designfile = $designdir.'/default.tab';
1.1317 raeburn 257: if ( open (my $fh,'<',$designfile) ) {
1.517 raeburn 258: while (my $line = <$fh>) {
259: next if ($line =~ /^\#/);
260: chomp($line);
261: my ($key,$val)=(split(/\=/,$line));
262: if ($val) { $defaultdesign{$key}=$val; }
263: }
264: close($fh);
1.63 www 265: }
266:
1.15 harris41 267: # ------------------------------------------------------------- file categories
268: {
1.158 raeburn 269: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
270: '/filecategories.tab';
1.1317 raeburn 271: if ( open (my $fh,'<',$categoryfile) ) {
1.356 albertel 272: while (my $line = <$fh>) {
273: next if ($line =~ /^\#/);
274: chomp($line);
275: my ($extension,$category)=(split(/\s+/,$line,2));
1.1263 raeburn 276: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 277: }
278: close($fh);
279: }
280:
1.15 harris41 281: }
1.12 harris41 282: # ------------------------------------------------------------------ file types
283: {
1.158 raeburn 284: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
285: '/filetypes.tab';
1.1317 raeburn 286: if ( open (my $fh,'<',$typesfile) ) {
1.356 albertel 287: while (my $line = <$fh>) {
288: next if ($line =~ /^\#/);
289: chomp($line);
290: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 291: if ($descr ne '') {
292: $fe{$ending}=lc($emb);
293: $fd{$ending}=$descr;
1.351 www 294: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 295: }
296: }
297: close($fh);
298: }
1.12 harris41 299: }
1.22 www 300: &Apache::lonnet::logthis(
1.705 tempelho 301: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 302: $readit=1;
1.46 matthew 303: } # end of unless($readit)
1.32 matthew 304:
305: }
1.112 bowersj2 306:
1.42 matthew 307: ###############################################################
308: ## HTML and Javascript Helper Functions ##
309: ###############################################################
310:
311: =pod
312:
1.112 bowersj2 313: =head1 HTML and Javascript Functions
1.42 matthew 314:
1.112 bowersj2 315: =over 4
316:
1.648 raeburn 317: =item * &browser_and_searcher_javascript()
1.112 bowersj2 318:
319: X<browsing, javascript>X<searching, javascript>Returns a string
320: containing javascript with two functions, C<openbrowser> and
321: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
322: tags.
1.42 matthew 323:
1.648 raeburn 324: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 325:
326: inputs: formname, elementname, only, omit
327:
328: formname and elementname indicate the name of the html form and name of
329: the element that the results of the browsing selection are to be placed in.
330:
331: Specifying 'only' will restrict the browser to displaying only files
1.185 www 332: with the given extension. Can be a comma separated list.
1.42 matthew 333:
334: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 335: with the given extension. Can be a comma separated list.
1.42 matthew 336:
1.648 raeburn 337: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 338:
339: Inputs: formname, elementname
340:
341: formname and elementname specify the name of the html form and the name
342: of the element the selection from the search results will be placed in.
1.542 raeburn 343:
1.42 matthew 344: =cut
345:
346: sub browser_and_searcher_javascript {
1.199 albertel 347: my ($mode)=@_;
348: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 349: my $resurl=&escape_single(&lastresurl());
1.42 matthew 350: return <<END;
1.219 albertel 351: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 352: var editbrowser = null;
1.135 albertel 353: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 354: var url = '$resurl/?';
1.42 matthew 355: if (editbrowser == null) {
356: url += 'launch=1&';
357: }
358: url += 'catalogmode=interactive&';
1.199 albertel 359: url += 'mode=$mode&';
1.611 albertel 360: url += 'inhibitmenu=yes&';
1.42 matthew 361: url += 'form=' + formname + '&';
362: if (only != null) {
363: url += 'only=' + only + '&';
1.217 albertel 364: } else {
365: url += 'only=&';
366: }
1.42 matthew 367: if (omit != null) {
368: url += 'omit=' + omit + '&';
1.217 albertel 369: } else {
370: url += 'omit=&';
371: }
1.135 albertel 372: if (titleelement != null) {
373: url += 'titleelement=' + titleelement + '&';
1.217 albertel 374: } else {
375: url += 'titleelement=&';
376: }
1.42 matthew 377: url += 'element=' + elementname + '';
378: var title = 'Browser';
1.435 albertel 379: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 380: options += ',width=700,height=600';
381: editbrowser = open(url,title,options,'1');
382: editbrowser.focus();
383: }
384: var editsearcher;
1.135 albertel 385: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 386: var url = '/adm/searchcat?';
387: if (editsearcher == null) {
388: url += 'launch=1&';
389: }
390: url += 'catalogmode=interactive&';
1.199 albertel 391: url += 'mode=$mode&';
1.42 matthew 392: url += 'form=' + formname + '&';
1.135 albertel 393: if (titleelement != null) {
394: url += 'titleelement=' + titleelement + '&';
1.217 albertel 395: } else {
396: url += 'titleelement=&';
397: }
1.42 matthew 398: url += 'element=' + elementname + '';
399: var title = 'Search';
1.435 albertel 400: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 401: options += ',width=700,height=600';
402: editsearcher = open(url,title,options,'1');
403: editsearcher.focus();
404: }
1.219 albertel 405: // END LON-CAPA Internal -->
1.42 matthew 406: END
1.170 www 407: }
408:
409: sub lastresurl {
1.258 albertel 410: if ($env{'environment.lastresurl'}) {
411: return $env{'environment.lastresurl'}
1.170 www 412: } else {
413: return '/res';
414: }
415: }
416:
417: sub storeresurl {
418: my $resurl=&Apache::lonnet::clutter(shift);
419: unless ($resurl=~/^\/res/) { return 0; }
420: $resurl=~s/\/$//;
421: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 422: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 423: return 1;
1.42 matthew 424: }
425:
1.74 www 426: sub studentbrowser_javascript {
1.111 www 427: unless (
1.258 albertel 428: (($env{'request.course.id'}) &&
1.302 albertel 429: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
430: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
431: '/'.$env{'request.course.sec'})
432: ))
1.258 albertel 433: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 434: ) { return ''; }
1.74 www 435: return (<<'ENDSTDBRW');
1.776 bisitz 436: <script type="text/javascript" language="Javascript">
1.824 bisitz 437: // <![CDATA[
1.74 www 438: var stdeditbrowser;
1.1337 raeburn 439: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
1.74 www 440: var url = '/adm/pickstudent?';
441: var filter;
1.558 albertel 442: if (!ignorefilter) {
443: eval('filter=document.'+formname+'.'+uname+'.value;');
444: }
1.74 www 445: if (filter != null) {
446: if (filter != '') {
447: url += 'filter='+filter+'&';
448: }
449: }
450: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 451: '&udomelement='+udom+
452: '&clicker='+clicker;
1.111 www 453: if (roleflag) { url+="&roles=1"; }
1.1337 raeburn 454: if (courseadv == 'condition') {
455: if (document.getElementById('courseadv')) {
456: courseadv = document.getElementById('courseadv').value;
457: }
458: }
459: if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.102 www 460: var title = 'Student_Browser';
1.74 www 461: var options = 'scrollbars=1,resizable=1,menubar=0';
462: options += ',width=700,height=600';
463: stdeditbrowser = open(url,title,options,'1');
464: stdeditbrowser.focus();
465: }
1.824 bisitz 466: // ]]>
1.74 www 467: </script>
468: ENDSTDBRW
469: }
1.42 matthew 470:
1.1003 www 471: sub resourcebrowser_javascript {
472: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 473: return (<<'ENDRESBRW');
1.1003 www 474: <script type="text/javascript" language="Javascript">
475: // <![CDATA[
476: var reseditbrowser;
1.1004 www 477: function openresbrowser(formname,reslink) {
1.1005 www 478: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 479: var title = 'Resource_Browser';
480: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 481: options += ',width=700,height=500';
1.1004 www 482: reseditbrowser = open(url,title,options,'1');
483: reseditbrowser.focus();
1.1003 www 484: }
485: // ]]>
486: </script>
1.1004 www 487: ENDRESBRW
1.1003 www 488: }
489:
1.74 www 490: sub selectstudent_link {
1.1337 raeburn 491: my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
1.999 www 492: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
493: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
494: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 495: if ($env{'request.course.id'}) {
1.302 albertel 496: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
497: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
498: '/'.$env{'request.course.sec'})) {
1.111 www 499: return '';
500: }
1.999 www 501: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1337 raeburn 502: if ($courseadv eq 'only') {
503: $callargs .= ",'',1,'$courseadv'";
504: } elsif ($courseadv eq 'none') {
505: $callargs .= ",'','','$courseadv'";
506: } elsif ($courseadv eq 'condition') {
507: $callargs .= ",'','','$courseadv'";
1.793 raeburn 508: }
509: return '<span class="LC_nobreak">'.
510: '<a href="javascript:openstdbrowser('.$callargs.');">'.
511: &mt('Select User').'</a></span>';
1.74 www 512: }
1.258 albertel 513: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 514: $callargs .= ",'',1";
1.793 raeburn 515: return '<span class="LC_nobreak">'.
516: '<a href="javascript:openstdbrowser('.$callargs.');">'.
517: &mt('Select User').'</a></span>';
1.111 www 518: }
519: return '';
1.91 www 520: }
521:
1.1004 www 522: sub selectresource_link {
523: my ($form,$reslink,$arg)=@_;
524:
525: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
526: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
527: unless ($env{'request.course.id'}) { return $arg; }
528: return '<span class="LC_nobreak">'.
529: '<a href="javascript:openresbrowser('.$callargs.');">'.
530: $arg.'</a></span>';
531: }
532:
533:
534:
1.653 raeburn 535: sub authorbrowser_javascript {
536: return <<"ENDAUTHORBRW";
1.776 bisitz 537: <script type="text/javascript" language="JavaScript">
1.824 bisitz 538: // <![CDATA[
1.653 raeburn 539: var stdeditbrowser;
540:
541: function openauthorbrowser(formname,udom) {
542: var url = '/adm/pickauthor?';
543: url += 'form='+formname+'&roledom='+udom;
544: var title = 'Author_Browser';
545: var options = 'scrollbars=1,resizable=1,menubar=0';
546: options += ',width=700,height=600';
547: stdeditbrowser = open(url,title,options,'1');
548: stdeditbrowser.focus();
549: }
550:
1.824 bisitz 551: // ]]>
1.653 raeburn 552: </script>
553: ENDAUTHORBRW
554: }
555:
1.91 www 556: sub coursebrowser_javascript {
1.1116 raeburn 557: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1221 raeburn 558: $credits_element,$instcode) = @_;
1.932 raeburn 559: my $wintitle = 'Course_Browser';
1.931 raeburn 560: if ($crstype eq 'Community') {
1.932 raeburn 561: $wintitle = 'Community_Browser';
1.909 raeburn 562: }
1.876 raeburn 563: my $id_functions = &javascript_index_functions();
564: my $output = '
1.776 bisitz 565: <script type="text/javascript" language="JavaScript">
1.824 bisitz 566: // <![CDATA[
1.468 raeburn 567: var stdeditbrowser;'."\n";
1.876 raeburn 568:
569: $output .= <<"ENDSTDBRW";
1.909 raeburn 570: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 571: var url = '/adm/pickcourse?';
1.895 raeburn 572: var formid = getFormIdByName(formname);
1.876 raeburn 573: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 574: if (domainfilter != null) {
575: if (domainfilter != '') {
576: url += 'domainfilter='+domainfilter+'&';
577: }
578: }
1.91 www 579: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 580: '&cdomelement='+udom+
581: '&cnameelement='+desc;
1.468 raeburn 582: if (extra_element !=null && extra_element != '') {
1.594 raeburn 583: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 584: url += '&roleelement='+extra_element;
585: if (domainfilter == null || domainfilter == '') {
586: url += '&domainfilter='+extra_element;
587: }
1.234 raeburn 588: }
1.468 raeburn 589: else {
590: if (formname == 'portform') {
591: url += '&setroles='+extra_element;
1.800 raeburn 592: } else {
593: if (formname == 'rules') {
594: url += '&fixeddom='+extra_element;
595: }
1.468 raeburn 596: }
597: }
1.230 raeburn 598: }
1.909 raeburn 599: if (type != null && type != '') {
600: url += '&type='+type;
601: }
602: if (type_elem != null && type_elem != '') {
603: url += '&typeelement='+type_elem;
604: }
1.872 raeburn 605: if (formname == 'ccrs') {
606: var ownername = document.forms[formid].ccuname.value;
607: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1238 raeburn 608: url += '&cloner='+ownername+':'+ownerdom;
609: if (type == 'Course') {
610: url += '&crscode='+document.forms[formid].crscode.value;
611: }
1.1221 raeburn 612: }
613: if (formname == 'requestcrs') {
614: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 615: }
1.293 raeburn 616: if (multflag !=null && multflag != '') {
617: url += '&multiple='+multflag;
618: }
1.909 raeburn 619: var title = '$wintitle';
1.91 www 620: var options = 'scrollbars=1,resizable=1,menubar=0';
621: options += ',width=700,height=600';
622: stdeditbrowser = open(url,title,options,'1');
623: stdeditbrowser.focus();
624: }
1.876 raeburn 625: $id_functions
626: ENDSTDBRW
1.1116 raeburn 627: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
628: $output .= &setsec_javascript($sec_element,$formname,$role_element,
629: $credits_element);
1.876 raeburn 630: }
631: $output .= '
632: // ]]>
633: </script>';
634: return $output;
635: }
636:
637: sub javascript_index_functions {
638: return <<"ENDJS";
639:
640: function getFormIdByName(formname) {
641: for (var i=0;i<document.forms.length;i++) {
642: if (document.forms[i].name == formname) {
643: return i;
644: }
645: }
646: return -1;
647: }
648:
649: function getIndexByName(formid,item) {
650: for (var i=0;i<document.forms[formid].elements.length;i++) {
651: if (document.forms[formid].elements[i].name == item) {
652: return i;
653: }
654: }
655: return -1;
656: }
1.468 raeburn 657:
1.876 raeburn 658: function getDomainFromSelectbox(formname,udom) {
659: var userdom;
660: var formid = getFormIdByName(formname);
661: if (formid > -1) {
662: var domid = getIndexByName(formid,udom);
663: if (domid > -1) {
664: if (document.forms[formid].elements[domid].type == 'select-one') {
665: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
666: }
667: if (document.forms[formid].elements[domid].type == 'hidden') {
668: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 669: }
670: }
671: }
1.876 raeburn 672: return userdom;
673: }
674:
675: ENDJS
1.468 raeburn 676:
1.876 raeburn 677: }
678:
1.1017 raeburn 679: sub javascript_array_indexof {
1.1018 raeburn 680: return <<ENDJS;
1.1017 raeburn 681: <script type="text/javascript" language="JavaScript">
682: // <![CDATA[
683:
684: if (!Array.prototype.indexOf) {
685: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
686: "use strict";
687: if (this === void 0 || this === null) {
688: throw new TypeError();
689: }
690: var t = Object(this);
691: var len = t.length >>> 0;
692: if (len === 0) {
693: return -1;
694: }
695: var n = 0;
696: if (arguments.length > 0) {
697: n = Number(arguments[1]);
1.1088 foxr 698: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 699: n = 0;
700: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
701: n = (n > 0 || -1) * Math.floor(Math.abs(n));
702: }
703: }
704: if (n >= len) {
705: return -1;
706: }
707: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
708: for (; k < len; k++) {
709: if (k in t && t[k] === searchElement) {
710: return k;
711: }
712: }
713: return -1;
714: }
715: }
716:
717: // ]]>
718: </script>
719:
720: ENDJS
721:
722: }
723:
1.876 raeburn 724: sub userbrowser_javascript {
725: my $id_functions = &javascript_index_functions();
726: return <<"ENDUSERBRW";
727:
1.888 raeburn 728: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 729: var url = '/adm/pickuser?';
730: var userdom = getDomainFromSelectbox(formname,udom);
731: if (userdom != null) {
732: if (userdom != '') {
733: url += 'srchdom='+userdom+'&';
734: }
735: }
736: url += 'form=' + formname + '&unameelement='+uname+
737: '&udomelement='+udom+
738: '&ulastelement='+ulast+
739: '&ufirstelement='+ufirst+
740: '&uemailelement='+uemail+
1.881 raeburn 741: '&hideudomelement='+hideudom+
742: '&coursedom='+crsdom;
1.888 raeburn 743: if ((caller != null) && (caller != undefined)) {
744: url += '&caller='+caller;
745: }
1.876 raeburn 746: var title = 'User_Browser';
747: var options = 'scrollbars=1,resizable=1,menubar=0';
748: options += ',width=700,height=600';
749: var stdeditbrowser = open(url,title,options,'1');
750: stdeditbrowser.focus();
751: }
752:
1.888 raeburn 753: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 754: var formid = getFormIdByName(formname);
755: if (formid > -1) {
1.888 raeburn 756: var unameid = getIndexByName(formid,uname);
1.876 raeburn 757: var domid = getIndexByName(formid,udom);
758: var hidedomid = getIndexByName(formid,origdom);
759: if (hidedomid > -1) {
760: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 761: var unameval = document.forms[formid].elements[unameid].value;
762: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
763: if (domid > -1) {
764: var slct = document.forms[formid].elements[domid];
765: if (slct.type == 'select-one') {
766: var i;
767: for (i=0;i<slct.length;i++) {
768: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
769: }
770: }
771: if (slct.type == 'hidden') {
772: slct.value = fixeddom;
1.876 raeburn 773: }
774: }
1.468 raeburn 775: }
776: }
777: }
1.876 raeburn 778: return;
779: }
780:
781: $id_functions
782: ENDUSERBRW
1.468 raeburn 783: }
784:
785: sub setsec_javascript {
1.1116 raeburn 786: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 787: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
788: $communityrolestr);
789: if ($role_element ne '') {
790: my @allroles = ('st','ta','ep','in','ad');
791: foreach my $crstype ('Course','Community') {
792: if ($crstype eq 'Community') {
793: foreach my $role (@allroles) {
794: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
795: }
796: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
797: } else {
798: foreach my $role (@allroles) {
799: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
800: }
801: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
802: }
803: }
804: $rolestr = '"'.join('","',@allroles).'"';
805: $courserolestr = '"'.join('","',@courserolenames).'"';
806: $communityrolestr = '"'.join('","',@communityrolenames).'"';
807: }
1.468 raeburn 808: my $setsections = qq|
809: function setSect(sectionlist) {
1.629 raeburn 810: var sectionsArray = new Array();
811: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
812: sectionsArray = sectionlist.split(",");
813: }
1.468 raeburn 814: var numSections = sectionsArray.length;
815: document.$formname.$sec_element.length = 0;
816: if (numSections == 0) {
817: document.$formname.$sec_element.multiple=false;
818: document.$formname.$sec_element.size=1;
819: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
820: } else {
821: if (numSections == 1) {
822: document.$formname.$sec_element.multiple=false;
823: document.$formname.$sec_element.size=1;
824: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
825: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
826: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
827: } else {
828: for (var i=0; i<numSections; i++) {
829: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
830: }
831: document.$formname.$sec_element.multiple=true
832: if (numSections < 3) {
833: document.$formname.$sec_element.size=numSections;
834: } else {
835: document.$formname.$sec_element.size=3;
836: }
837: document.$formname.$sec_element.options[0].selected = false
838: }
839: }
1.91 www 840: }
1.905 raeburn 841:
842: function setRole(crstype) {
1.468 raeburn 843: |;
1.905 raeburn 844: if ($role_element eq '') {
845: $setsections .= ' return;
846: }
847: ';
848: } else {
849: $setsections .= qq|
850: var elementLength = document.$formname.$role_element.length;
851: var allroles = Array($rolestr);
852: var courserolenames = Array($courserolestr);
853: var communityrolenames = Array($communityrolestr);
854: if (elementLength != undefined) {
855: if (document.$formname.$role_element.options[5].value == 'cc') {
856: if (crstype == 'Course') {
857: return;
858: } else {
859: allroles[5] = 'co';
860: for (var i=0; i<6; i++) {
861: document.$formname.$role_element.options[i].value = allroles[i];
862: document.$formname.$role_element.options[i].text = communityrolenames[i];
863: }
864: }
865: } else {
866: if (crstype == 'Community') {
867: return;
868: } else {
869: allroles[5] = 'cc';
870: for (var i=0; i<6; i++) {
871: document.$formname.$role_element.options[i].value = allroles[i];
872: document.$formname.$role_element.options[i].text = courserolenames[i];
873: }
874: }
875: }
876: }
877: return;
878: }
879: |;
880: }
1.1116 raeburn 881: if ($credits_element) {
882: $setsections .= qq|
883: function setCredits(defaultcredits) {
884: document.$formname.$credits_element.value = defaultcredits;
885: return;
886: }
887: |;
888: }
1.468 raeburn 889: return $setsections;
890: }
891:
1.91 www 892: sub selectcourse_link {
1.909 raeburn 893: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
894: $typeelement) = @_;
895: my $type = $selecttype;
1.871 raeburn 896: my $linktext = &mt('Select Course');
897: if ($selecttype eq 'Community') {
1.909 raeburn 898: $linktext = &mt('Select Community');
1.1239 raeburn 899: } elsif ($selecttype eq 'Placement') {
900: $linktext = &mt('Select Placement Test');
1.906 raeburn 901: } elsif ($selecttype eq 'Course/Community') {
902: $linktext = &mt('Select Course/Community');
1.909 raeburn 903: $type = '';
1.1019 raeburn 904: } elsif ($selecttype eq 'Select') {
905: $linktext = &mt('Select');
906: $type = '';
1.871 raeburn 907: }
1.787 bisitz 908: return '<span class="LC_nobreak">'
909: ."<a href='"
910: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
911: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 912: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 913: ."'>".$linktext.'</a>'
1.787 bisitz 914: .'</span>';
1.74 www 915: }
1.42 matthew 916:
1.653 raeburn 917: sub selectauthor_link {
918: my ($form,$udom)=@_;
919: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
920: &mt('Select Author').'</a>';
921: }
922:
1.876 raeburn 923: sub selectuser_link {
1.881 raeburn 924: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 925: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 926: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 927: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 928: ');">'.$linktext.'</a>';
1.876 raeburn 929: }
930:
1.273 raeburn 931: sub check_uncheck_jscript {
932: my $jscript = <<"ENDSCRT";
933: function checkAll(field) {
934: if (field.length > 0) {
935: for (i = 0; i < field.length; i++) {
1.1093 raeburn 936: if (!field[i].disabled) {
937: field[i].checked = true;
938: }
1.273 raeburn 939: }
940: } else {
1.1093 raeburn 941: if (!field.disabled) {
942: field.checked = true;
943: }
1.273 raeburn 944: }
945: }
946:
947: function uncheckAll(field) {
948: if (field.length > 0) {
949: for (i = 0; i < field.length; i++) {
950: field[i].checked = false ;
1.543 albertel 951: }
952: } else {
1.273 raeburn 953: field.checked = false ;
954: }
955: }
956: ENDSCRT
957: return $jscript;
958: }
959:
1.656 www 960: sub select_timezone {
1.1387 raeburn 961: my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_;
962: my $output='<select name="'.$name.'" '.$id.$onchange.$disabled.'>'."\n";
1.659 raeburn 963: if ($includeempty) {
964: $output .= '<option value=""';
965: if (($selected eq '') || ($selected eq 'local')) {
966: $output .= ' selected="selected" ';
967: }
968: $output .= '> </option>';
969: }
1.657 raeburn 970: my @timezones = DateTime::TimeZone->all_names;
971: foreach my $tzone (@timezones) {
972: $output.= '<option value="'.$tzone.'"';
973: if ($tzone eq $selected) {
974: $output.=' selected="selected"';
975: }
976: $output.=">$tzone</option>\n";
1.656 www 977: }
978: $output.="</select>";
979: return $output;
980: }
1.273 raeburn 981:
1.687 raeburn 982: sub select_datelocale {
1.1256 raeburn 983: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
984: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 985: if ($includeempty) {
986: $output .= '<option value=""';
987: if ($selected eq '') {
988: $output .= ' selected="selected" ';
989: }
990: $output .= '> </option>';
991: }
1.1241 raeburn 992: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 993: my (@possibles,%locale_names);
1.1241 raeburn 994: my @locales = DateTime::Locale->ids();
995: foreach my $id (@locales) {
996: if ($id ne '') {
997: my ($en_terr,$native_terr);
998: my $loc = DateTime::Locale->load($id);
999: if (ref($loc)) {
1000: $en_terr = $loc->name();
1001: $native_terr = $loc->native_name();
1.687 raeburn 1002: if (grep(/^en$/,@languages) || !@languages) {
1003: if ($en_terr ne '') {
1004: $locale_names{$id} = '('.$en_terr.')';
1005: } elsif ($native_terr ne '') {
1006: $locale_names{$id} = $native_terr;
1007: }
1008: } else {
1009: if ($native_terr ne '') {
1010: $locale_names{$id} = $native_terr.' ';
1011: } elsif ($en_terr ne '') {
1012: $locale_names{$id} = '('.$en_terr.')';
1013: }
1014: }
1.1220 raeburn 1015: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1241 raeburn 1016: push(@possibles,$id);
1017: }
1.687 raeburn 1018: }
1019: }
1020: foreach my $item (sort(@possibles)) {
1021: $output.= '<option value="'.$item.'"';
1022: if ($item eq $selected) {
1023: $output.=' selected="selected"';
1024: }
1025: $output.=">$item";
1026: if ($locale_names{$item} ne '') {
1.1220 raeburn 1027: $output.=' '.$locale_names{$item};
1.687 raeburn 1028: }
1029: $output.="</option>\n";
1030: }
1031: $output.="</select>";
1032: return $output;
1033: }
1034:
1.792 raeburn 1035: sub select_language {
1.1256 raeburn 1036: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1037: my %langchoices;
1038: if ($includeempty) {
1.1117 raeburn 1039: %langchoices = ('' => 'No language preference');
1.792 raeburn 1040: }
1041: foreach my $id (&languageids()) {
1042: my $code = &supportedlanguagecode($id);
1043: if ($code) {
1044: $langchoices{$code} = &plainlanguagedescription($id);
1045: }
1046: }
1.1117 raeburn 1047: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1256 raeburn 1048: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1049: }
1050:
1.42 matthew 1051: =pod
1.36 matthew 1052:
1.1088 foxr 1053:
1054: =item * &list_languages()
1055:
1056: Returns an array reference that is suitable for use in language prompters.
1057: Each array element is itself a two element array. The first element
1058: is the language code. The second element a descsriptiuon of the
1059: language itself. This is suitable for use in e.g.
1060: &Apache::edit::select_arg (once dereferenced that is).
1061:
1062: =cut
1063:
1064: sub list_languages {
1065: my @lang_choices;
1066:
1067: foreach my $id (&languageids()) {
1068: my $code = &supportedlanguagecode($id);
1069: if ($code) {
1070: my $selector = $supported_codes{$id};
1071: my $description = &plainlanguagedescription($id);
1.1263 raeburn 1072: push(@lang_choices, [$selector, $description]);
1.1088 foxr 1073: }
1074: }
1075: return \@lang_choices;
1076: }
1077:
1078: =pod
1079:
1.648 raeburn 1080: =item * &linked_select_forms(...)
1.36 matthew 1081:
1082: linked_select_forms returns a string containing a <script></script> block
1083: and html for two <select> menus. The select menus will be linked in that
1084: changing the value of the first menu will result in new values being placed
1085: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1086: order unless a defined order is provided.
1.36 matthew 1087:
1088: linked_select_forms takes the following ordered inputs:
1089:
1090: =over 4
1091:
1.112 bowersj2 1092: =item * $formname, the name of the <form> tag
1.36 matthew 1093:
1.112 bowersj2 1094: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1095:
1.112 bowersj2 1096: =item * $firstdefault, the default value for the first menu
1.36 matthew 1097:
1.112 bowersj2 1098: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1099:
1.112 bowersj2 1100: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1101:
1.112 bowersj2 1102: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1103:
1.609 raeburn 1104: =item * $menuorder, the order of values in the first menu
1105:
1.1115 raeburn 1106: =item * $onchangefirst, additional javascript call to execute for an onchange
1107: event for the first <select> tag
1108:
1109: =item * $onchangesecond, additional javascript call to execute for an onchange
1110: event for the second <select> tag
1111:
1.1245 raeburn 1112: =item * $suffix, to differentiate separate uses of select2data javascript
1113: objects in a page.
1114:
1.41 ng 1115: =back
1116:
1.36 matthew 1117: Below is an example of such a hash. Only the 'text', 'default', and
1118: 'select2' keys must appear as stated. keys(%menu) are the possible
1119: values for the first select menu. The text that coincides with the
1.41 ng 1120: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1121: and text for the second menu are given in the hash pointed to by
1122: $menu{$choice1}->{'select2'}.
1123:
1.112 bowersj2 1124: my %menu = ( A1 => { text =>"Choice A1" ,
1125: default => "B3",
1126: select2 => {
1127: B1 => "Choice B1",
1128: B2 => "Choice B2",
1129: B3 => "Choice B3",
1130: B4 => "Choice B4"
1.609 raeburn 1131: },
1132: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1133: },
1134: A2 => { text =>"Choice A2" ,
1135: default => "C2",
1136: select2 => {
1137: C1 => "Choice C1",
1138: C2 => "Choice C2",
1139: C3 => "Choice C3"
1.609 raeburn 1140: },
1141: order => ['C2','C1','C3'],
1.112 bowersj2 1142: },
1143: A3 => { text =>"Choice A3" ,
1144: default => "D6",
1145: select2 => {
1146: D1 => "Choice D1",
1147: D2 => "Choice D2",
1148: D3 => "Choice D3",
1149: D4 => "Choice D4",
1150: D5 => "Choice D5",
1151: D6 => "Choice D6",
1152: D7 => "Choice D7"
1.609 raeburn 1153: },
1154: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1155: }
1156: );
1.36 matthew 1157:
1158: =cut
1159:
1160: sub linked_select_forms {
1161: my ($formname,
1162: $middletext,
1163: $firstdefault,
1164: $firstselectname,
1165: $secondselectname,
1.609 raeburn 1166: $hashref,
1167: $menuorder,
1.1115 raeburn 1168: $onchangefirst,
1.1245 raeburn 1169: $onchangesecond,
1170: $suffix
1.36 matthew 1171: ) = @_;
1172: my $second = "document.$formname.$secondselectname";
1173: my $first = "document.$formname.$firstselectname";
1174: # output the javascript to do the changing
1175: my $result = '';
1.776 bisitz 1176: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1177: $result.="// <![CDATA[\n";
1.1245 raeburn 1178: $result.="var select2data${suffix} = new Object();\n";
1.36 matthew 1179: $" = '","';
1180: my $debug = '';
1181: foreach my $s1 (sort(keys(%$hashref))) {
1.1245 raeburn 1182: $result.="select2data${suffix}['d_$s1'] = new Object();\n";
1183: $result.="select2data${suffix}['d_$s1'].def = new String('".
1.36 matthew 1184: $hashref->{$s1}->{'default'}."');\n";
1.1245 raeburn 1185: $result.="select2data${suffix}['d_$s1'].values = new Array(";
1.36 matthew 1186: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1187: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1188: @s2values = @{$hashref->{$s1}->{'order'}};
1189: }
1.36 matthew 1190: $result.="\"@s2values\");\n";
1.1245 raeburn 1191: $result.="select2data${suffix}['d_$s1'].texts = new Array(";
1.36 matthew 1192: my @s2texts;
1193: foreach my $value (@s2values) {
1.1263 raeburn 1194: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1195: }
1196: $result.="\"@s2texts\");\n";
1197: }
1198: $"=' ';
1199: $result.= <<"END";
1200:
1.1245 raeburn 1201: function select1${suffix}_changed() {
1.36 matthew 1202: // Determine new choice
1.1245 raeburn 1203: var newvalue = "d_" + $first.options[$first.selectedIndex].value;
1.36 matthew 1204: // update select2
1.1245 raeburn 1205: var values = select2data${suffix}[newvalue].values;
1206: var texts = select2data${suffix}[newvalue].texts;
1207: var select2def = select2data${suffix}[newvalue].def;
1.36 matthew 1208: var i;
1209: // out with the old
1.1245 raeburn 1210: $second.options.length = 0;
1211: // in with the new
1.36 matthew 1212: for (i=0;i<values.length; i++) {
1213: $second.options[i] = new Option(values[i]);
1.143 matthew 1214: $second.options[i].value = values[i];
1.36 matthew 1215: $second.options[i].text = texts[i];
1216: if (values[i] == select2def) {
1217: $second.options[i].selected = true;
1218: }
1219: }
1220: }
1.824 bisitz 1221: // ]]>
1.36 matthew 1222: </script>
1223: END
1224: # output the initial values for the selection lists
1.1245 raeburn 1225: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1${suffix}_changed();$onchangefirst\">\n";
1.609 raeburn 1226: my @order = sort(keys(%{$hashref}));
1227: if (ref($menuorder) eq 'ARRAY') {
1228: @order = @{$menuorder};
1229: }
1230: foreach my $value (@order) {
1.36 matthew 1231: $result.=" <option value=\"$value\" ";
1.253 albertel 1232: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1233: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1234: }
1235: $result .= "</select>\n";
1236: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1237: $result .= $middletext;
1.1115 raeburn 1238: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1239: if ($onchangesecond) {
1240: $result .= ' onchange="'.$onchangesecond.'"';
1241: }
1242: $result .= ">\n";
1.36 matthew 1243: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1244:
1245: my @secondorder = sort(keys(%select2));
1246: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1247: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1248: }
1249: foreach my $value (@secondorder) {
1.36 matthew 1250: $result.=" <option value=\"$value\" ";
1.253 albertel 1251: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1252: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1253: }
1254: $result .= "</select>\n";
1255: # return $debug;
1256: return $result;
1257: } # end of sub linked_select_forms {
1258:
1.45 matthew 1259: =pod
1.44 bowersj2 1260:
1.1381 raeburn 1261: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
1.44 bowersj2 1262:
1.112 bowersj2 1263: Returns a string corresponding to an HTML link to the given help
1264: $topic, where $topic corresponds to the name of a .tex file in
1265: /home/httpd/html/adm/help/tex, with underscores replaced by
1266: spaces.
1267:
1268: $text will optionally be linked to the same topic, allowing you to
1269: link text in addition to the graphic. If you do not want to link
1270: text, but wish to specify one of the later parameters, pass an
1271: empty string.
1272:
1273: $stayOnPage is a value that will be interpreted as a boolean. If true,
1274: the link will not open a new window. If false, the link will open
1275: a new window using Javascript. (Default is false.)
1276:
1277: $width and $height are optional numerical parameters that will
1278: override the width and height of the popped up window, which may
1.973 raeburn 1279: be useful for certain help topics with big pictures included.
1280:
1281: $imgid is the id of the img tag used for the help icon. This may be
1282: used in a javascript call to switch the image src. See
1283: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1284:
1.1381 raeburn 1285: $links_target will optionally be set to a target (_top, _parent or _self).
1286:
1.44 bowersj2 1287: =cut
1288:
1289: sub help_open_topic {
1.1381 raeburn 1290: my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
1.48 bowersj2 1291: $text = "" if (not defined $text);
1.44 bowersj2 1292: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1293: $width = 500 if (not defined $width);
1.44 bowersj2 1294: $height = 400 if (not defined $height);
1295: my $filename = $topic;
1296: $filename =~ s/ /_/g;
1297:
1.48 bowersj2 1298: my $template = "";
1299: my $link;
1.572 banghart 1300:
1.159 www 1301: $topic=~s/\W/\_/g;
1.44 bowersj2 1302:
1.572 banghart 1303: if (!$stayOnPage) {
1.1033 www 1304: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1305: } elsif ($stayOnPage eq 'popup') {
1306: $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 1307: } else {
1.48 bowersj2 1308: $link = "/adm/help/${filename}.hlp";
1309: }
1310:
1311: # Add the text
1.1314 raeburn 1312: my $target = ' target="_top"';
1.1381 raeburn 1313: if ($links_target) {
1314: $target = ' target="'.$links_target.'"';
1315: } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
1316: (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
1317: $target = '';
1.1378 raeburn 1318: }
1.1380 raeburn 1319: if ($text ne "") {
1.763 bisitz 1320: $template.='<span class="LC_help_open_topic">'
1.1314 raeburn 1321: .'<a'.$target.' href="'.$link.'">'
1.763 bisitz 1322: .$text.'</a>';
1.48 bowersj2 1323: }
1324:
1.763 bisitz 1325: # (Always) Add the graphic
1.179 matthew 1326: my $title = &mt('Online Help');
1.667 raeburn 1327: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1328: if ($imgid ne '') {
1329: $imgid = ' id="'.$imgid.'"';
1330: }
1.1314 raeburn 1331: $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763 bisitz 1332: .'<img src="'.$helpicon.'" border="0"'
1333: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1334: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1335: .' /></a>';
1336: if ($text ne "") {
1337: $template.='</span>';
1338: }
1.44 bowersj2 1339: return $template;
1340:
1.106 bowersj2 1341: }
1342:
1343: # This is a quicky function for Latex cheatsheet editing, since it
1344: # appears in at least four places
1345: sub helpLatexCheatsheet {
1.1037 www 1346: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1347: my $out;
1.106 bowersj2 1348: my $addOther = '';
1.732 raeburn 1349: if ($topic) {
1.1037 www 1350: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1351: }
1352: $out = '<span>' # Start cheatsheet
1353: .$addOther
1354: .'<span>'
1.1037 www 1355: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1356: .'</span> <span>'
1.1037 www 1357: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1358: .'</span>';
1.732 raeburn 1359: unless ($not_author) {
1.1186 kruse 1360: $out .= '<span>'
1361: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1362: .'</span> <span>'
1363: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1364: .'</span>';
1.732 raeburn 1365: }
1.763 bisitz 1366: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1367: return $out;
1.172 www 1368: }
1369:
1.430 albertel 1370: sub general_help {
1371: my $helptopic='Student_Intro';
1372: if ($env{'request.role'}=~/^(ca|au)/) {
1373: $helptopic='Authoring_Intro';
1.907 raeburn 1374: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1375: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1376: } elsif ($env{'request.role'}=~/^dc/) {
1377: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1378: }
1379: return $helptopic;
1380: }
1381:
1382: sub update_help_link {
1383: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1384: my $origurl = $ENV{'REQUEST_URI'};
1385: $origurl=~s|^/~|/priv/|;
1386: my $timestamp = time;
1387: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1388: $$datum = &escape($$datum);
1389: }
1390:
1391: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1392: my $output .= <<"ENDOUTPUT";
1393: <script type="text/javascript">
1.824 bisitz 1394: // <![CDATA[
1.430 albertel 1395: banner_link = '$banner_link';
1.824 bisitz 1396: // ]]>
1.430 albertel 1397: </script>
1398: ENDOUTPUT
1399: return $output;
1400: }
1401:
1402: # now just updates the help link and generates a blue icon
1.193 raeburn 1403: sub help_open_menu {
1.1381 raeburn 1404: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target)
1.552 banghart 1405: = @_;
1.949 droeschl 1406: $stayOnPage = 1;
1.430 albertel 1407: my $output;
1408: if ($component_help) {
1409: if (!$text) {
1410: $output=&help_open_topic($component_help,undef,$stayOnPage,
1.1381 raeburn 1411: $width,$height,'',$links_target);
1.430 albertel 1412: } else {
1413: my $help_text;
1414: $help_text=&unescape($topic);
1415: $output='<table><tr><td>'.
1416: &help_open_topic($component_help,$help_text,$stayOnPage,
1.1381 raeburn 1417: $width,$height,'',$links_target).'</td></tr></table>';
1.430 albertel 1418: }
1419: }
1420: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1421: return $output.$banner_link;
1422: }
1423:
1424: sub top_nav_help {
1.1369 raeburn 1425: my ($text,$linkattr) = @_;
1.436 albertel 1426: $text = &mt($text);
1.949 droeschl 1427: my $stay_on_page = 1;
1428:
1.1168 raeburn 1429: my ($link,$banner_link);
1430: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1431: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1432: : "javascript:helpMenu('open')";
1433: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1434: }
1.201 raeburn 1435: my $title = &mt('Get help');
1.1168 raeburn 1436: if ($link) {
1437: return <<"END";
1.436 albertel 1438: $banner_link
1.1369 raeburn 1439: <a href="$link" title="$title" $linkattr>$text</a>
1.436 albertel 1440: END
1.1168 raeburn 1441: } else {
1442: return ' '.$text.' ';
1443: }
1.436 albertel 1444: }
1445:
1446: sub help_menu_js {
1.1154 raeburn 1447: my ($httphost) = @_;
1.949 droeschl 1448: my $stayOnPage = 1;
1.436 albertel 1449: my $width = 620;
1450: my $height = 600;
1.430 albertel 1451: my $helptopic=&general_help();
1.1154 raeburn 1452: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1453: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1454: my $start_page =
1455: &Apache::loncommon::start_page('Help Menu', undef,
1456: {'frameset' => 1,
1457: 'js_ready' => 1,
1.1154 raeburn 1458: 'use_absolute' => $httphost,
1.331 albertel 1459: 'add_entries' => {
1.1168 raeburn 1460: 'border' => '0',
1.579 raeburn 1461: 'rows' => "110,*",},});
1.331 albertel 1462: my $end_page =
1463: &Apache::loncommon::end_page({'frameset' => 1,
1464: 'js_ready' => 1,});
1465:
1.436 albertel 1466: my $template .= <<"ENDTEMPLATE";
1467: <script type="text/javascript">
1.877 bisitz 1468: // <![CDATA[
1.253 albertel 1469: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1470: var banner_link = '';
1.243 raeburn 1471: function helpMenu(target) {
1472: var caller = this;
1473: if (target == 'open') {
1474: var newWindow = null;
1475: try {
1.262 albertel 1476: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1477: }
1478: catch(error) {
1479: writeHelp(caller);
1480: return;
1481: }
1482: if (newWindow) {
1483: caller = newWindow;
1484: }
1.193 raeburn 1485: }
1.243 raeburn 1486: writeHelp(caller);
1487: return;
1488: }
1489: function writeHelp(caller) {
1.1168 raeburn 1490: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1491: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1492: caller.document.close();
1493: caller.focus();
1.193 raeburn 1494: }
1.877 bisitz 1495: // END LON-CAPA Internal -->
1.253 albertel 1496: // ]]>
1.436 albertel 1497: </script>
1.193 raeburn 1498: ENDTEMPLATE
1499: return $template;
1500: }
1501:
1.172 www 1502: sub help_open_bug {
1503: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1504: unless ($env{'user.adv'}) { return ''; }
1.172 www 1505: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1506: $text = "" if (not defined $text);
1507: $stayOnPage=1;
1.184 albertel 1508: $width = 600 if (not defined $width);
1509: $height = 600 if (not defined $height);
1.172 www 1510:
1511: $topic=~s/\W+/\+/g;
1512: my $link='';
1513: my $template='';
1.379 albertel 1514: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1515: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1516: if (!$stayOnPage)
1517: {
1518: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1519: }
1520: else
1521: {
1522: $link = $url;
1523: }
1.1314 raeburn 1524:
1.1382 raeburn 1525: my $target = '_top';
1526: if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
1527: (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
1528: $target = '_blank';
1.1378 raeburn 1529: }
1.1382 raeburn 1530:
1.172 www 1531: # Add the text
1532: if ($text ne "")
1533: {
1534: $template .=
1535: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1382 raeburn 1536: "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1537: }
1538:
1539: # Add the graphic
1.179 matthew 1540: my $title = &mt('Report a Bug');
1.215 albertel 1541: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1542: $template .= <<"ENDTEMPLATE";
1.1382 raeburn 1543: <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1544: ENDTEMPLATE
1545: if ($text ne '') { $template.='</td></tr></table>' };
1546: return $template;
1547:
1548: }
1549:
1550: sub help_open_faq {
1551: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1552: unless ($env{'user.adv'}) { return ''; }
1.172 www 1553: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1554: $text = "" if (not defined $text);
1555: $stayOnPage=1;
1556: $width = 350 if (not defined $width);
1557: $height = 400 if (not defined $height);
1558:
1559: $topic=~s/\W+/\+/g;
1560: my $link='';
1561: my $template='';
1562: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1563: if (!$stayOnPage)
1564: {
1565: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1566: }
1567: else
1568: {
1569: $link = $url;
1570: }
1571:
1572: # Add the text
1573: if ($text ne "")
1574: {
1575: $template .=
1.173 www 1576: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1577: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1578: }
1579:
1580: # Add the graphic
1.179 matthew 1581: my $title = &mt('View the FAQ');
1.215 albertel 1582: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1583: $template .= <<"ENDTEMPLATE";
1.436 albertel 1584: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1585: ENDTEMPLATE
1586: if ($text ne '') { $template.='</td></tr></table>' };
1587: return $template;
1588:
1.44 bowersj2 1589: }
1.37 matthew 1590:
1.180 matthew 1591: ###############################################################
1592: ###############################################################
1593:
1.45 matthew 1594: =pod
1595:
1.648 raeburn 1596: =item * &change_content_javascript():
1.256 matthew 1597:
1598: This and the next function allow you to create small sections of an
1599: otherwise static HTML page that you can update on the fly with
1600: Javascript, even in Netscape 4.
1601:
1602: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1603: must be written to the HTML page once. It will prove the Javascript
1604: function "change(name, content)". Calling the change function with the
1605: name of the section
1606: you want to update, matching the name passed to C<changable_area>, and
1607: the new content you want to put in there, will put the content into
1608: that area.
1609:
1610: B<Note>: Netscape 4 only reserves enough space for the changable area
1611: to contain room for the original contents. You need to "make space"
1612: for whatever changes you wish to make, and be B<sure> to check your
1613: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1614: it's adequate for updating a one-line status display, but little more.
1615: This script will set the space to 100% width, so you only need to
1616: worry about height in Netscape 4.
1617:
1618: Modern browsers are much less limiting, and if you can commit to the
1619: user not using Netscape 4, this feature may be used freely with
1620: pretty much any HTML.
1621:
1622: =cut
1623:
1624: sub change_content_javascript {
1625: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1626: if ($env{'browser.type'} eq 'netscape' &&
1627: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1628: return (<<NETSCAPE4);
1629: function change(name, content) {
1630: doc = document.layers[name+"___escape"].layers[0].document;
1631: doc.open();
1632: doc.write(content);
1633: doc.close();
1634: }
1635: NETSCAPE4
1636: } else {
1637: # Otherwise, we need to use semi-standards-compliant code
1638: # (technically, "innerHTML" isn't standard but the equivalent
1639: # is really scary, and every useful browser supports it
1640: return (<<DOMBASED);
1641: function change(name, content) {
1642: element = document.getElementById(name);
1643: element.innerHTML = content;
1644: }
1645: DOMBASED
1646: }
1647: }
1648:
1649: =pod
1650:
1.648 raeburn 1651: =item * &changable_area($name,$origContent):
1.256 matthew 1652:
1653: This provides a "changable area" that can be modified on the fly via
1654: the Javascript code provided in C<change_content_javascript>. $name is
1655: the name you will use to reference the area later; do not repeat the
1656: same name on a given HTML page more then once. $origContent is what
1657: the area will originally contain, which can be left blank.
1658:
1659: =cut
1660:
1661: sub changable_area {
1662: my ($name, $origContent) = @_;
1663:
1.258 albertel 1664: if ($env{'browser.type'} eq 'netscape' &&
1665: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1666: # If this is netscape 4, we need to use the Layer tag
1667: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1668: } else {
1669: return "<span id='$name'>$origContent</span>";
1670: }
1671: }
1672:
1673: =pod
1674:
1.648 raeburn 1675: =item * &viewport_geometry_js
1.590 raeburn 1676:
1677: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1678:
1679: =cut
1680:
1681:
1682: sub viewport_geometry_js {
1683: return <<"GEOMETRY";
1684: var Geometry = {};
1685: function init_geometry() {
1686: if (Geometry.init) { return };
1687: Geometry.init=1;
1688: if (window.innerHeight) {
1689: Geometry.getViewportHeight = function() { return window.innerHeight; };
1690: Geometry.getViewportWidth = function() { return window.innerWidth; };
1691: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1692: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1693: }
1694: else if (document.documentElement && document.documentElement.clientHeight) {
1695: Geometry.getViewportHeight =
1696: function() { return document.documentElement.clientHeight; };
1697: Geometry.getViewportWidth =
1698: function() { return document.documentElement.clientWidth; };
1699:
1700: Geometry.getHorizontalScroll =
1701: function() { return document.documentElement.scrollLeft; };
1702: Geometry.getVerticalScroll =
1703: function() { return document.documentElement.scrollTop; };
1704: }
1705: else if (document.body.clientHeight) {
1706: Geometry.getViewportHeight =
1707: function() { return document.body.clientHeight; };
1708: Geometry.getViewportWidth =
1709: function() { return document.body.clientWidth; };
1710: Geometry.getHorizontalScroll =
1711: function() { return document.body.scrollLeft; };
1712: Geometry.getVerticalScroll =
1713: function() { return document.body.scrollTop; };
1714: }
1715: }
1716:
1717: GEOMETRY
1718: }
1719:
1720: =pod
1721:
1.648 raeburn 1722: =item * &viewport_size_js()
1.590 raeburn 1723:
1724: 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.
1725:
1726: =cut
1727:
1728: sub viewport_size_js {
1729: my $geometry = &viewport_geometry_js();
1730: return <<"DIMS";
1731:
1732: $geometry
1733:
1734: function getViewportDims(width,height) {
1735: init_geometry();
1736: width.value = Geometry.getViewportWidth();
1737: height.value = Geometry.getViewportHeight();
1738: return;
1739: }
1740:
1741: DIMS
1742: }
1743:
1744: =pod
1745:
1.648 raeburn 1746: =item * &resize_textarea_js()
1.565 albertel 1747:
1748: emits the needed javascript to resize a textarea to be as big as possible
1749:
1750: creates a function resize_textrea that takes two IDs first should be
1751: the id of the element to resize, second should be the id of a div that
1752: surrounds everything that comes after the textarea, this routine needs
1753: to be attached to the <body> for the onload and onresize events.
1754:
1.648 raeburn 1755: =back
1.565 albertel 1756:
1757: =cut
1758:
1759: sub resize_textarea_js {
1.590 raeburn 1760: my $geometry = &viewport_geometry_js();
1.565 albertel 1761: return <<"RESIZE";
1762: <script type="text/javascript">
1.824 bisitz 1763: // <![CDATA[
1.590 raeburn 1764: $geometry
1.565 albertel 1765:
1.588 albertel 1766: function getX(element) {
1767: var x = 0;
1768: while (element) {
1769: x += element.offsetLeft;
1770: element = element.offsetParent;
1771: }
1772: return x;
1773: }
1774: function getY(element) {
1775: var y = 0;
1776: while (element) {
1777: y += element.offsetTop;
1778: element = element.offsetParent;
1779: }
1780: return y;
1781: }
1782:
1783:
1.565 albertel 1784: function resize_textarea(textarea_id,bottom_id) {
1785: init_geometry();
1786: var textarea = document.getElementById(textarea_id);
1787: //alert(textarea);
1788:
1.588 albertel 1789: var textarea_top = getY(textarea);
1.565 albertel 1790: var textarea_height = textarea.offsetHeight;
1791: var bottom = document.getElementById(bottom_id);
1.588 albertel 1792: var bottom_top = getY(bottom);
1.565 albertel 1793: var bottom_height = bottom.offsetHeight;
1794: var window_height = Geometry.getViewportHeight();
1.588 albertel 1795: var fudge = 23;
1.565 albertel 1796: var new_height = window_height-fudge-textarea_top-bottom_height;
1797: if (new_height < 300) {
1798: new_height = 300;
1799: }
1800: textarea.style.height=new_height+'px';
1801: }
1.824 bisitz 1802: // ]]>
1.565 albertel 1803: </script>
1804: RESIZE
1805:
1806: }
1807:
1.1205 golterma 1808: sub colorfuleditor_js {
1.1248 raeburn 1809: my $browse_or_search;
1810: my $respath;
1811: my ($cnum,$cdom) = &crsauthor_url();
1812: if ($cnum) {
1813: $respath = "/res/$cdom/$cnum/";
1814: my %js_lt = &Apache::lonlocal::texthash(
1815: sunm => 'Sub-directory name',
1816: save => 'Save page to make this permanent',
1817: );
1818: &js_escape(\%js_lt);
1819: $browse_or_search = <<"END";
1820:
1821: function toggleChooser(form,element,titleid,only,search) {
1822: var disp = 'none';
1823: if (document.getElementById('chooser_'+element)) {
1824: var curr = document.getElementById('chooser_'+element).style.display;
1825: if (curr == 'none') {
1826: disp='inline';
1827: if (form.elements['chooser_'+element].length) {
1828: for (var i=0; i<form.elements['chooser_'+element].length; i++) {
1829: form.elements['chooser_'+element][i].checked = false;
1830: }
1831: }
1832: toggleResImport(form,element);
1833: }
1834: document.getElementById('chooser_'+element).style.display = disp;
1835: }
1836: }
1837:
1838: function toggleCrsFile(form,element,numdirs) {
1839: if (document.getElementById('chooser_'+element+'_crsres')) {
1840: var curr = document.getElementById('chooser_'+element+'_crsres').style.display;
1841: if (curr == 'none') {
1842: if (numdirs) {
1843: form.elements['coursepath_'+element].selectedIndex = 0;
1844: if (numdirs > 1) {
1845: window['select1'+element+'_changed']();
1846: }
1847: }
1848: }
1849: document.getElementById('chooser_'+element+'_crsres').style.display = 'block';
1850:
1851: }
1852: if (document.getElementById('chooser_'+element+'_upload')) {
1853: document.getElementById('chooser_'+element+'_upload').style.display = 'none';
1854: if (document.getElementById('uploadcrsres_'+element)) {
1855: document.getElementById('uploadcrsres_'+element).value = '';
1856: }
1857: }
1858: return;
1859: }
1860:
1861: function toggleCrsUpload(form,element,numcrsdirs) {
1862: if (document.getElementById('chooser_'+element+'_crsres')) {
1863: document.getElementById('chooser_'+element+'_crsres').style.display = 'none';
1864: }
1865: if (document.getElementById('chooser_'+element+'_upload')) {
1866: var curr = document.getElementById('chooser_'+element+'_upload').style.display;
1867: if (curr == 'none') {
1868: if (numcrsdirs) {
1869: form.elements['crsauthorpath_'+element].selectedIndex = 0;
1870: form.elements['newsubdir_'+element][0].checked = true;
1871: toggleNewsubdir(form,element);
1872: }
1873: }
1874: document.getElementById('chooser_'+element+'_upload').style.display = 'block';
1875: }
1876: return;
1877: }
1878:
1879: function toggleResImport(form,element) {
1880: var choices = new Array('crsres','upload');
1881: for (var i=0; i<choices.length; i++) {
1882: if (document.getElementById('chooser_'+element+'_'+choices[i])) {
1883: document.getElementById('chooser_'+element+'_'+choices[i]).style.display = 'none';
1884: }
1885: }
1886: }
1887:
1888: function toggleNewsubdir(form,element) {
1889: var newsub = form.elements['newsubdir_'+element];
1890: if (newsub) {
1891: if (newsub.length) {
1892: for (var j=0; j<newsub.length; j++) {
1893: if (newsub[j].checked) {
1894: if (document.getElementById('newsubdirname_'+element)) {
1895: if (newsub[j].value == '1') {
1896: document.getElementById('newsubdirname_'+element).type = "text";
1897: if (document.getElementById('newsubdir_'+element)) {
1898: document.getElementById('newsubdir_'+element).innerHTML = '<br />$js_lt{sunm}';
1899: }
1900: } else {
1901: document.getElementById('newsubdirname_'+element).type = "hidden";
1902: document.getElementById('newsubdirname_'+element).value = "";
1903: document.getElementById('newsubdir_'+element).innerHTML = "";
1904: }
1905: }
1906: break;
1907: }
1908: }
1909: }
1910: }
1911: }
1912:
1913: function updateCrsFile(form,element) {
1914: var directory = form.elements['coursepath_'+element];
1915: var filename = form.elements['coursefile_'+element];
1916: var path = directory.options[directory.selectedIndex].value;
1917: var file = filename.options[filename.selectedIndex].value;
1918: form.elements[element].value = '$respath';
1919: if (path == '/') {
1920: form.elements[element].value += file;
1921: } else {
1922: form.elements[element].value += path+'/'+file;
1923: }
1924: unClean();
1925: if (document.getElementById('previewimg_'+element)) {
1926: document.getElementById('previewimg_'+element).src = form.elements[element].value;
1927: var newsrc = document.getElementById('previewimg_'+element).src;
1928: }
1929: if (document.getElementById('showimg_'+element)) {
1930: document.getElementById('showimg_'+element).innerHTML = '($js_lt{save})';
1931: }
1932: toggleChooser(form,element);
1933: return;
1934: }
1935:
1936: function uploadDone(suffix,name) {
1937: if (name) {
1938: document.forms["lonhomework"].elements[suffix].value = name;
1939: unClean();
1940: toggleChooser(document.forms["lonhomework"],suffix);
1941: }
1942: }
1943:
1944: \$(document).ready(function(){
1945:
1946: \$(document).delegate('form :submit', 'click', function( event ) {
1947: if ( \$( this ).hasClass( "LC_uploadcrsres" ) ) {
1948: var buttonId = this.id;
1949: var suffix = buttonId.toString();
1950: suffix = suffix.replace(/^crsupload_/,'');
1951: event.preventDefault();
1952: document.lonhomework.target = 'crsupload_target_'+suffix;
1953: document.lonhomework.action = '/adm/coursepub?LC_uploadcrsres='+suffix;
1954: \$(this.form).submit();
1955: document.lonhomework.target = '';
1956: if (document.getElementById('crsuploadto_'+suffix)) {
1957: document.lonhomework.action = document.getElementById('crsuploadto_'+suffix).value;
1958: }
1959: return false;
1960: }
1961: });
1962: });
1963: END
1964: }
1.1205 golterma 1965: return <<"COLORFULEDIT"
1966: <script type="text/javascript">
1967: // <![CDATA[>
1968: function fold_box(curDepth, lastresource){
1969:
1970: // we need a list because there can be several blocks you need to fold in one tag
1971: var block = document.getElementsByName('foldblock_'+curDepth);
1972: // but there is only one folding button per tag
1973: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1974:
1975: if(block.item(0).style.display == 'none'){
1976:
1977: foldbutton.value = '@{[&mt("Hide")]}';
1978: for (i = 0; i < block.length; i++){
1979: block.item(i).style.display = '';
1980: }
1981: }else{
1982:
1983: foldbutton.value = '@{[&mt("Show")]}';
1984: for (i = 0; i < block.length; i++){
1985: // block.item(i).style.visibility = 'collapse';
1986: block.item(i).style.display = 'none';
1987: }
1988: };
1989: saveState(lastresource);
1990: }
1991:
1992: function saveState (lastresource) {
1993:
1994: var tag_list = getTagList();
1995: if(tag_list != null){
1996: var timestamp = new Date().getTime();
1997: var key = lastresource;
1998:
1999: // the value pattern is: 'time;key1,value1;key2,value2; ... '
2000: // starting with timestamp
2001: var value = timestamp+';';
2002:
2003: // building the list of key-value pairs
2004: for(var i = 0; i < tag_list.length; i++){
2005: value += tag_list[i]+',';
2006: value += document.getElementsByName(tag_list[i])[0].style.display+';';
2007: }
2008:
2009: // only iterate whole storage if nothing to override
2010: if(localStorage.getItem(key) == null){
2011:
2012: // prevent storage from growing large
2013: if(localStorage.length > 50){
2014: var regex_getTimestamp = /^(?:\d)+;/;
2015: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
2016: var oldest_key;
2017:
2018: for(var i = 1; i < localStorage.length; i++){
2019: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
2020: oldest_key = localStorage.key(i);
2021: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
2022: }
2023: }
2024: localStorage.removeItem(oldest_key);
2025: }
2026: }
2027: localStorage.setItem(key,value);
2028: }
2029: }
2030:
2031: // restore folding status of blocks (on page load)
2032: function restoreState (lastresource) {
2033: if(localStorage.getItem(lastresource) != null){
2034: var key = lastresource;
2035: var value = localStorage.getItem(key);
2036: var regex_delTimestamp = /^\d+;/;
2037:
2038: value.replace(regex_delTimestamp, '');
2039:
2040: var valueArr = value.split(';');
2041: var pairs;
2042: var elements;
2043: for (var i = 0; i < valueArr.length; i++){
2044: pairs = valueArr[i].split(',');
2045: elements = document.getElementsByName(pairs[0]);
2046:
2047: for (var j = 0; j < elements.length; j++){
2048: elements[j].style.display = pairs[1];
2049: if (pairs[1] == "none"){
2050: var regex_id = /([_\\d]+)\$/;
2051: regex_id.exec(pairs[0]);
2052: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
2053: }
2054: }
2055: }
2056: }
2057: }
2058:
2059: function getTagList () {
2060:
2061: var stringToSearch = document.lonhomework.innerHTML;
2062:
2063: var ret = new Array();
2064: var regex_findBlock = /(foldblock_.*?)"/g;
2065: var tag_list = stringToSearch.match(regex_findBlock);
2066:
2067: if(tag_list != null){
2068: for(var i = 0; i < tag_list.length; i++){
2069: ret.push(tag_list[i].replace(/"/, ''));
2070: }
2071: }
2072: return ret;
2073: }
2074:
2075: function saveScrollPosition (resource) {
2076: var tag_list = getTagList();
2077:
2078: // we dont always want to jump to the first block
2079: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
2080: if(\$(window).scrollTop() > 170){
2081: if(tag_list != null){
2082: var result;
2083: for(var i = 0; i < tag_list.length; i++){
2084: if(isElementInViewport(tag_list[i])){
2085: result += tag_list[i]+';';
2086: }
2087: }
2088: sessionStorage.setItem('anchor_'+resource, result);
2089: }
2090: } else {
2091: // we dont need to save zero, just delete the item to leave everything tidy
2092: sessionStorage.removeItem('anchor_'+resource);
2093: }
2094: }
2095:
2096: function restoreScrollPosition(resource){
2097:
2098: var elem = sessionStorage.getItem('anchor_'+resource);
2099: if(elem != null){
2100: var tag_list = elem.split(';');
2101: var elem_list;
2102:
2103: for(var i = 0; i < tag_list.length; i++){
2104: elem_list = document.getElementsByName(tag_list[i]);
2105:
2106: if(elem_list.length > 0){
2107: elem = elem_list[0];
2108: break;
2109: }
2110: }
2111: elem.scrollIntoView();
2112: }
2113: }
2114:
2115: function isElementInViewport(el) {
2116:
2117: // change to last element instead of first
2118: var elem = document.getElementsByName(el);
2119: var rect = elem[0].getBoundingClientRect();
2120:
2121: return (
2122: rect.top >= 0 &&
2123: rect.left >= 0 &&
2124: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
2125: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
2126: );
2127: }
2128:
2129: function autosize(depth){
2130: var cmInst = window['cm'+depth];
2131: var fitsizeButton = document.getElementById('fitsize'+depth);
2132:
2133: // is fixed size, switching to dynamic
2134: if (sessionStorage.getItem("autosized_"+depth) == null) {
2135: cmInst.setSize("","auto");
2136: fitsizeButton.value = "@{[&mt('Fixed size')]}";
2137: sessionStorage.setItem("autosized_"+depth, "yes");
2138:
2139: // is dynamic size, switching to fixed
2140: } else {
2141: cmInst.setSize("","300px");
2142: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
2143: sessionStorage.removeItem("autosized_"+depth);
2144: }
2145: }
2146:
1.1248 raeburn 2147: $browse_or_search
1.1205 golterma 2148:
2149: // ]]>
2150: </script>
2151: COLORFULEDIT
2152: }
2153:
2154: sub xmleditor_js {
2155: return <<XMLEDIT
2156: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
2157: <script type="text/javascript">
2158: // <![CDATA[>
2159:
2160: function saveScrollPosition (resource) {
2161:
2162: var scrollPos = \$(window).scrollTop();
2163: sessionStorage.setItem(resource,scrollPos);
2164: }
2165:
2166: function restoreScrollPosition(resource){
2167:
2168: var scrollPos = sessionStorage.getItem(resource);
2169: \$(window).scrollTop(scrollPos);
2170: }
2171:
2172: // unless internet explorer
2173: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
2174:
2175: \$(document).ready(function() {
2176: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
2177: });
2178: }
2179:
2180: // inserts text at cursor position into codemirror (xml editor only)
2181: function insertText(text){
2182: cm.focus();
2183: var curPos = cm.getCursor();
2184: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2185: }
2186: // ]]>
2187: </script>
2188: XMLEDIT
2189: }
2190:
2191: sub insert_folding_button {
2192: my $curDepth = $Apache::lonxml::curdepth;
2193: my $lastresource = $env{'request.ambiguous'};
2194:
2195: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2196: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2197: }
2198:
1.1248 raeburn 2199: sub crsauthor_url {
2200: my ($url) = @_;
2201: if ($url eq '') {
2202: $url = $ENV{'REQUEST_URI'};
2203: }
2204: my ($cnum,$cdom);
2205: if ($env{'request.course.id'}) {
2206: my ($audom,$auname) = ($url =~ m{^/priv/($match_domain)/($match_name)/});
2207: if ($audom ne '' && $auname ne '') {
2208: if (($env{'course.'.$env{'request.course.id'}.'.num'} eq $auname) &&
2209: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $audom)) {
2210: $cnum = $auname;
2211: $cdom = $audom;
2212: }
2213: }
2214: }
2215: return ($cnum,$cdom);
2216: }
2217:
2218: sub import_crsauthor_form {
1.1265 raeburn 2219: my ($form,$firstselectname,$secondselectname,$onchangefirst,$only,$suffix,$disabled) = @_;
1.1248 raeburn 2220: return (0) unless ($env{'request.course.id'});
2221: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2222: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2223: my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
2224: return (0) unless (($cnum ne '') && ($cdom ne ''));
2225: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
2226: my @ids=&Apache::lonnet::current_machine_ids();
2227: my ($output,$is_home,$relpath,%subdirs,%files,%selimport_menus);
2228:
2229: if (grep(/^\Q$crshome\E$/,@ids)) {
2230: $is_home = 1;
2231: }
2232: $relpath = "/priv/$cdom/$cnum";
2233: &Apache::lonnet::recursedirs($is_home,'priv',$londocroot,$relpath,'',\%subdirs,\%files);
2234: my %lt = &Apache::lonlocal::texthash (
2235: fnam => 'Filename',
2236: dire => 'Directory',
2237: );
2238: my $numdirs = scalar(keys(%files));
2239: my (%possexts,$singledir,@singledirfiles);
2240: if ($only) {
2241: map { $possexts{$_} = 1; } split(/\s*,\s*/,$only);
2242: }
2243: my (%nonemptydirs,$possdirs);
2244: if ($numdirs > 1) {
2245: my @order;
2246: foreach my $key (sort { lc($a) cmp lc($b) } (keys(%files))) {
2247: if (ref($files{$key}) eq 'HASH') {
2248: my $shown = $key;
2249: if ($key eq '') {
2250: $shown = '/';
2251: }
2252: my @ordered = ();
2253: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
1.1315 raeburn 2254: next if ($file =~ /\.rights$/);
1.1248 raeburn 2255: if ($only) {
2256: my ($ext) = ($file =~ /\.([^.]+)$/);
2257: unless ($possexts{lc($ext)}) {
2258: next;
2259: }
2260: }
2261: $selimport_menus{$key}->{'select2'}->{$file} = $file;
2262: push(@ordered,$file);
2263: }
2264: if (@ordered) {
2265: push(@order,$key);
2266: $nonemptydirs{$key} = 1;
2267: $selimport_menus{$key}->{'text'} = $shown;
2268: $selimport_menus{$key}->{'default'} = '';
2269: $selimport_menus{$key}->{'select2'}->{''} = '';
2270: $selimport_menus{$key}->{'order'} = \@ordered;
2271: }
2272: }
2273: }
2274: $possdirs = scalar(keys(%nonemptydirs));
2275: if ($possdirs > 1) {
2276: my @order = sort { lc($a) cmp lc($b) } (keys(%nonemptydirs));
2277: $output = $lt{'dire'}.
2278: &linked_select_forms($form,'<br />'.
2279: $lt{'fnam'},'',
2280: $firstselectname,$secondselectname,
2281: \%selimport_menus,\@order,
2282: $onchangefirst,'',$suffix).'<br />';
2283: } elsif ($possdirs == 1) {
2284: $singledir = (keys(%nonemptydirs))[0];
2285: if (ref($selimport_menus{$singledir}->{'order'}) eq 'ARRAY') {
2286: @singledirfiles = @{$selimport_menus{$singledir}->{'order'}};
2287: }
2288: delete($selimport_menus{$singledir});
2289: }
2290: } elsif ($numdirs == 1) {
2291: $singledir = (keys(%files))[0];
2292: foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$singledir}}))) {
2293: if ($only) {
2294: my ($ext) = ($file =~ /\.([^.]+)$/);
2295: unless ($possexts{lc($ext)}) {
2296: next;
2297: }
1.1315 raeburn 2298: } else {
2299: next if ($file =~ /\.rights$/);
1.1248 raeburn 2300: }
2301: push(@singledirfiles,$file);
2302: }
2303: if (@singledirfiles) {
1.1315 raeburn 2304: $possdirs = 1;
1.1248 raeburn 2305: }
2306: }
2307: if (($possdirs == 1) && (@singledirfiles)) {
2308: my $showdir = $singledir;
2309: if ($singledir eq '') {
2310: $showdir = '/';
2311: }
2312: $output = $lt{'dire'}.
2313: '<select name="'.$firstselectname.'">'.
2314: '<option value="'.$singledir.'">'.$showdir.'</option>'."\n".
2315: '</select><br />'.
2316: $lt{'fnam'}.'<select name="'.$secondselectname.'">'."\n".
2317: '<option value="" selected="selected">'.$lt{'se'}.'</option>'."\n";
2318: foreach my $file (@singledirfiles) {
2319: $output .= '<option value="'.$file.'">'.$file.'</option>'."\n";
2320: }
2321: $output .= '</select><br />'."\n";
2322: }
2323: return ($possdirs,$output);
2324: }
2325:
1.565 albertel 2326: =pod
2327:
1.256 matthew 2328: =head1 Excel and CSV file utility routines
2329:
2330: =cut
2331:
2332: ###############################################################
2333: ###############################################################
2334:
2335: =pod
2336:
1.1162 raeburn 2337: =over 4
2338:
1.648 raeburn 2339: =item * &csv_translate($text)
1.37 matthew 2340:
1.185 www 2341: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2342: format.
2343:
2344: =cut
2345:
1.180 matthew 2346: ###############################################################
2347: ###############################################################
1.37 matthew 2348: sub csv_translate {
2349: my $text = shift;
2350: $text =~ s/\"/\"\"/g;
1.209 albertel 2351: $text =~ s/\n/ /g;
1.37 matthew 2352: return $text;
2353: }
1.180 matthew 2354:
2355: ###############################################################
2356: ###############################################################
2357:
2358: =pod
2359:
1.648 raeburn 2360: =item * &define_excel_formats()
1.180 matthew 2361:
2362: Define some commonly used Excel cell formats.
2363:
2364: Currently supported formats:
2365:
2366: =over 4
2367:
2368: =item header
2369:
2370: =item bold
2371:
2372: =item h1
2373:
2374: =item h2
2375:
2376: =item h3
2377:
1.256 matthew 2378: =item h4
2379:
2380: =item i
2381:
1.180 matthew 2382: =item date
2383:
2384: =back
2385:
2386: Inputs: $workbook
2387:
2388: Returns: $format, a hash reference.
2389:
1.1057 foxr 2390:
1.180 matthew 2391: =cut
2392:
2393: ###############################################################
2394: ###############################################################
2395: sub define_excel_formats {
2396: my ($workbook) = @_;
2397: my $format;
2398: $format->{'header'} = $workbook->add_format(bold => 1,
2399: bottom => 1,
2400: align => 'center');
2401: $format->{'bold'} = $workbook->add_format(bold=>1);
2402: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2403: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2404: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2405: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2406: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2407: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2408: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2409: return $format;
2410: }
2411:
2412: ###############################################################
2413: ###############################################################
1.113 bowersj2 2414:
2415: =pod
2416:
1.648 raeburn 2417: =item * &create_workbook()
1.255 matthew 2418:
2419: Create an Excel worksheet. If it fails, output message on the
2420: request object and return undefs.
2421:
2422: Inputs: Apache request object
2423:
2424: Returns (undef) on failure,
2425: Excel worksheet object, scalar with filename, and formats
2426: from &Apache::loncommon::define_excel_formats on success
2427:
2428: =cut
2429:
2430: ###############################################################
2431: ###############################################################
2432: sub create_workbook {
2433: my ($r) = @_;
2434: #
2435: # Create the excel spreadsheet
2436: my $filename = '/prtspool/'.
1.258 albertel 2437: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2438: time.'_'.rand(1000000000).'.xls';
2439: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2440: if (! defined($workbook)) {
2441: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2442: $r->print(
2443: '<p class="LC_error">'
2444: .&mt('Problems occurred in creating the new Excel file.')
2445: .' '.&mt('This error has been logged.')
2446: .' '.&mt('Please alert your LON-CAPA administrator.')
2447: .'</p>'
2448: );
1.255 matthew 2449: return (undef);
2450: }
2451: #
1.1014 foxr 2452: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2453: #
2454: my $format = &Apache::loncommon::define_excel_formats($workbook);
2455: return ($workbook,$filename,$format);
2456: }
2457:
2458: ###############################################################
2459: ###############################################################
2460:
2461: =pod
2462:
1.648 raeburn 2463: =item * &create_text_file()
1.113 bowersj2 2464:
1.542 raeburn 2465: Create a file to write to and eventually make available to the user.
1.256 matthew 2466: If file creation fails, outputs an error message on the request object and
2467: return undefs.
1.113 bowersj2 2468:
1.256 matthew 2469: Inputs: Apache request object, and file suffix
1.113 bowersj2 2470:
1.256 matthew 2471: Returns (undef) on failure,
2472: Filehandle and filename on success.
1.113 bowersj2 2473:
2474: =cut
2475:
1.256 matthew 2476: ###############################################################
2477: ###############################################################
2478: sub create_text_file {
2479: my ($r,$suffix) = @_;
2480: if (! defined($suffix)) { $suffix = 'txt'; };
2481: my $fh;
2482: my $filename = '/prtspool/'.
1.258 albertel 2483: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2484: time.'_'.rand(1000000000).'.'.$suffix;
2485: $fh = Apache::File->new('>/home/httpd'.$filename);
2486: if (! defined($fh)) {
2487: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2488: $r->print(
2489: '<p class="LC_error">'
2490: .&mt('Problems occurred in creating the output file.')
2491: .' '.&mt('This error has been logged.')
2492: .' '.&mt('Please alert your LON-CAPA administrator.')
2493: .'</p>'
2494: );
1.113 bowersj2 2495: }
1.256 matthew 2496: return ($fh,$filename)
1.113 bowersj2 2497: }
2498:
2499:
1.256 matthew 2500: =pod
1.113 bowersj2 2501:
2502: =back
2503:
2504: =cut
1.37 matthew 2505:
2506: ###############################################################
1.33 matthew 2507: ## Home server <option> list generating code ##
2508: ###############################################################
1.35 matthew 2509:
1.169 www 2510: # ------------------------------------------
2511:
2512: sub domain_select {
1.1289 raeburn 2513: my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
2514: my @possdoms;
2515: if (ref($incdoms) eq 'ARRAY') {
2516: @possdoms = @{$incdoms};
2517: } else {
2518: @possdoms = &Apache::lonnet::all_domains();
2519: }
2520:
1.169 www 2521: my %domains=map {
1.514 albertel 2522: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.1289 raeburn 2523: } @possdoms;
2524:
2525: if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
2526: foreach my $dom (@{$excdoms}) {
2527: delete($domains{$dom});
2528: }
2529: }
2530:
1.169 www 2531: if ($multiple) {
2532: $domains{''}=&mt('Any domain');
1.550 albertel 2533: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2534: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2535: } else {
1.550 albertel 2536: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2537: return &select_form($name,$value,\%domains);
1.169 www 2538: }
2539: }
2540:
1.282 albertel 2541: #-------------------------------------------
2542:
2543: =pod
2544:
1.519 raeburn 2545: =head1 Routines for form select boxes
2546:
2547: =over 4
2548:
1.648 raeburn 2549: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2550:
2551: Returns a string containing a <select> element int multiple mode
2552:
2553:
2554: Args:
2555: $name - name of the <select> element
1.506 raeburn 2556: $value - scalar or array ref of values that should already be selected
1.282 albertel 2557: $size - number of rows long the select element is
1.283 albertel 2558: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2559: (shown text should already have been &mt())
1.506 raeburn 2560: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2561:
1.282 albertel 2562: =cut
2563:
2564: #-------------------------------------------
1.169 www 2565: sub multiple_select_form {
1.284 albertel 2566: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2567: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2568: my $output='';
1.191 matthew 2569: if (! defined($size)) {
2570: $size = 4;
1.283 albertel 2571: if (scalar(keys(%$hash))<4) {
2572: $size = scalar(keys(%$hash));
1.191 matthew 2573: }
2574: }
1.734 bisitz 2575: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2576: my @order;
1.506 raeburn 2577: if (ref($order) eq 'ARRAY') {
2578: @order = @{$order};
2579: } else {
2580: @order = sort(keys(%$hash));
1.501 banghart 2581: }
2582: if (exists($$hash{'select_form_order'})) {
2583: @order = @{$$hash{'select_form_order'}};
2584: }
2585:
1.284 albertel 2586: foreach my $key (@order) {
1.356 albertel 2587: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2588: $output.='selected="selected" ' if ($selected{$key});
2589: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2590: }
2591: $output.="</select>\n";
2592: return $output;
2593: }
2594:
1.88 www 2595: #-------------------------------------------
2596:
2597: =pod
2598:
1.1254 raeburn 2599: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2600:
2601: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2602: allow a user to select options from a ref to a hash containing:
2603: option_name => displayed text. An optional $onchange can include
1.1254 raeburn 2604: a javascript onchange item, e.g., onchange="this.form.submit();".
2605: An optional arg -- $readonly -- if true will cause the select form
2606: to be disabled, e.g., for the case where an instructor has a section-
2607: specific role, and is viewing/modifying parameters.
1.970 raeburn 2608:
1.88 www 2609: See lonrights.pm for an example invocation and use.
2610:
2611: =cut
2612:
2613: #-------------------------------------------
2614: sub select_form {
1.1228 raeburn 2615: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2616: return unless (ref($hashref) eq 'HASH');
2617: if ($onchange) {
2618: $onchange = ' onchange="'.$onchange.'"';
2619: }
1.1228 raeburn 2620: my $disabled;
2621: if ($readonly) {
2622: $disabled = ' disabled="disabled"';
2623: }
2624: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2625: my @keys;
1.970 raeburn 2626: if (exists($hashref->{'select_form_order'})) {
2627: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2628: } else {
1.970 raeburn 2629: @keys=sort(keys(%{$hashref}));
1.128 albertel 2630: }
1.356 albertel 2631: foreach my $key (@keys) {
2632: $selectform.=
2633: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2634: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2635: ">".$hashref->{$key}."</option>\n";
1.88 www 2636: }
2637: $selectform.="</select>";
2638: return $selectform;
2639: }
2640:
1.475 www 2641: # For display filters
2642:
2643: sub display_filter {
1.1074 raeburn 2644: my ($context) = @_;
1.475 www 2645: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2646: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2647: my $phraseinput = 'hidden';
2648: my $includeinput = 'hidden';
2649: my ($checked,$includetypestext);
2650: if ($env{'form.displayfilter'} eq 'containing') {
2651: $phraseinput = 'text';
2652: if ($context eq 'parmslog') {
2653: $includeinput = 'checkbox';
2654: if ($env{'form.includetypes'}) {
2655: $checked = ' checked="checked"';
2656: }
2657: $includetypestext = &mt('Include parameter types');
2658: }
2659: } else {
2660: $includetypestext = ' ';
2661: }
2662: my ($additional,$secondid,$thirdid);
2663: if ($context eq 'parmslog') {
2664: $additional =
2665: '<label><input type="'.$includeinput.'" name="includetypes"'.
2666: $checked.' name="includetypes" value="1" id="includetypes" />'.
2667: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2668: '</label>';
2669: $secondid = 'includetypes';
2670: $thirdid = 'includetypestext';
2671: }
2672: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2673: '$secondid','$thirdid')";
2674: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2675: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2676: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2677: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2678: &mt('Filter: [_1]',
1.477 www 2679: &select_form($env{'form.displayfilter'},
2680: 'displayfilter',
1.970 raeburn 2681: {'currentfolder' => 'Current folder/page',
1.477 www 2682: 'containing' => 'Containing phrase',
1.1074 raeburn 2683: 'none' => 'None'},$onchange)).' '.
2684: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2685: &HTML::Entities::encode($env{'form.containingphrase'}).
2686: '" />'.$additional;
2687: }
2688:
2689: sub display_filter_js {
2690: my $includetext = &mt('Include parameter types');
2691: return <<"ENDJS";
2692:
2693: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2694: var firstType = 'hidden';
2695: if (setter.options[setter.selectedIndex].value == 'containing') {
2696: firstType = 'text';
2697: }
2698: firstObject = document.getElementById(firstid);
2699: if (typeof(firstObject) == 'object') {
2700: if (firstObject.type != firstType) {
2701: changeInputType(firstObject,firstType);
2702: }
2703: }
2704: if (context == 'parmslog') {
2705: var secondType = 'hidden';
2706: if (firstType == 'text') {
2707: secondType = 'checkbox';
2708: }
2709: secondObject = document.getElementById(secondid);
2710: if (typeof(secondObject) == 'object') {
2711: if (secondObject.type != secondType) {
2712: changeInputType(secondObject,secondType);
2713: }
2714: }
2715: var textItem = document.getElementById(thirdid);
2716: var currtext = textItem.innerHTML;
2717: var newtext;
2718: if (firstType == 'text') {
2719: newtext = '$includetext';
2720: } else {
2721: newtext = ' ';
2722: }
2723: if (currtext != newtext) {
2724: textItem.innerHTML = newtext;
2725: }
2726: }
2727: return;
2728: }
2729:
2730: function changeInputType(oldObject,newType) {
2731: var newObject = document.createElement('input');
2732: newObject.type = newType;
2733: if (oldObject.size) {
2734: newObject.size = oldObject.size;
2735: }
2736: if (oldObject.value) {
2737: newObject.value = oldObject.value;
2738: }
2739: if (oldObject.name) {
2740: newObject.name = oldObject.name;
2741: }
2742: if (oldObject.id) {
2743: newObject.id = oldObject.id;
2744: }
2745: oldObject.parentNode.replaceChild(newObject,oldObject);
2746: return;
2747: }
2748:
2749: ENDJS
1.475 www 2750: }
2751:
1.167 www 2752: sub gradeleveldescription {
2753: my $gradelevel=shift;
2754: my %gradelevels=(0 => 'Not specified',
2755: 1 => 'Grade 1',
2756: 2 => 'Grade 2',
2757: 3 => 'Grade 3',
2758: 4 => 'Grade 4',
2759: 5 => 'Grade 5',
2760: 6 => 'Grade 6',
2761: 7 => 'Grade 7',
2762: 8 => 'Grade 8',
2763: 9 => 'Grade 9',
2764: 10 => 'Grade 10',
2765: 11 => 'Grade 11',
2766: 12 => 'Grade 12',
2767: 13 => 'Grade 13',
2768: 14 => '100 Level',
2769: 15 => '200 Level',
2770: 16 => '300 Level',
2771: 17 => '400 Level',
2772: 18 => 'Graduate Level');
2773: return &mt($gradelevels{$gradelevel});
2774: }
2775:
1.163 www 2776: sub select_level_form {
2777: my ($deflevel,$name)=@_;
2778: unless ($deflevel) { $deflevel=0; }
1.167 www 2779: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2780: for (my $i=0; $i<=18; $i++) {
2781: $selectform.="<option value=\"$i\" ".
1.253 albertel 2782: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2783: ">".&gradeleveldescription($i)."</option>\n";
2784: }
2785: $selectform.="</select>";
2786: return $selectform;
1.163 www 2787: }
1.167 www 2788:
1.35 matthew 2789: #-------------------------------------------
2790:
1.45 matthew 2791: =pod
2792:
1.1256 raeburn 2793: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2794:
2795: Returns a string containing a <select name='$name' size='1'> form to
2796: allow a user to select the domain to preform an operation in.
2797: See loncreateuser.pm for an example invocation and use.
2798:
1.90 www 2799: If the $includeempty flag is set, it also includes an empty choice ("no domain
2800: selected");
2801:
1.743 raeburn 2802: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2803:
1.910 raeburn 2804: 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.
2805:
1.1121 raeburn 2806: The optional $incdoms is a reference to an array of domains which will be the only available options.
2807:
2808: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2809:
1.1256 raeburn 2810: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
2811:
1.35 matthew 2812: =cut
2813:
2814: #-------------------------------------------
1.34 matthew 2815: sub select_dom_form {
1.1256 raeburn 2816: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2817: if ($onchange) {
1.874 raeburn 2818: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2819: }
1.1256 raeburn 2820: if ($disabled) {
2821: $disabled = ' disabled="disabled"';
2822: }
1.1121 raeburn 2823: my (@domains,%exclude);
1.910 raeburn 2824: if (ref($incdoms) eq 'ARRAY') {
2825: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2826: } else {
2827: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2828: }
1.90 www 2829: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2830: if (ref($excdoms) eq 'ARRAY') {
2831: map { $exclude{$_} = 1; } @{$excdoms};
2832: }
1.1256 raeburn 2833: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2834: foreach my $dom (@domains) {
1.1121 raeburn 2835: next if ($exclude{$dom});
1.356 albertel 2836: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2837: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2838: if ($showdomdesc) {
2839: if ($dom ne '') {
2840: my $domdesc = &Apache::lonnet::domain($dom,'description');
2841: if ($domdesc ne '') {
2842: $selectdomain .= ' ('.$domdesc.')';
2843: }
2844: }
2845: }
2846: $selectdomain .= "</option>\n";
1.34 matthew 2847: }
2848: $selectdomain.="</select>";
2849: return $selectdomain;
2850: }
2851:
1.35 matthew 2852: #-------------------------------------------
2853:
1.45 matthew 2854: =pod
2855:
1.648 raeburn 2856: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2857:
1.586 raeburn 2858: input: 4 arguments (two required, two optional) -
2859: $domain - domain of new user
2860: $name - name of form element
2861: $default - Value of 'default' causes a default item to be first
2862: option, and selected by default.
2863: $hide - Value of 'hide' causes hiding of the name of the server,
2864: if 1 server found, or default, if 0 found.
1.594 raeburn 2865: output: returns 2 items:
1.586 raeburn 2866: (a) form element which contains either:
2867: (i) <select name="$name">
2868: <option value="$hostid1">$hostid $servers{$hostid}</option>
2869: <option value="$hostid2">$hostid $servers{$hostid}</option>
2870: </select>
2871: form item if there are multiple library servers in $domain, or
2872: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2873: if there is only one library server in $domain.
2874:
2875: (b) number of library servers found.
2876:
2877: See loncreateuser.pm for example of use.
1.35 matthew 2878:
2879: =cut
2880:
2881: #-------------------------------------------
1.586 raeburn 2882: sub home_server_form_item {
2883: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2884: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2885: my $result;
2886: my $numlib = keys(%servers);
2887: if ($numlib > 1) {
2888: $result .= '<select name="'.$name.'" />'."\n";
2889: if ($default) {
1.804 bisitz 2890: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2891: '</option>'."\n";
2892: }
2893: foreach my $hostid (sort(keys(%servers))) {
2894: $result.= '<option value="'.$hostid.'">'.
2895: $hostid.' '.$servers{$hostid}."</option>\n";
2896: }
2897: $result .= '</select>'."\n";
2898: } elsif ($numlib == 1) {
2899: my $hostid;
2900: foreach my $item (keys(%servers)) {
2901: $hostid = $item;
2902: }
2903: $result .= '<input type="hidden" name="'.$name.'" value="'.
2904: $hostid.'" />';
2905: if (!$hide) {
2906: $result .= $hostid.' '.$servers{$hostid};
2907: }
2908: $result .= "\n";
2909: } elsif ($default) {
2910: $result .= '<input type="hidden" name="'.$name.
2911: '" value="default" />';
2912: if (!$hide) {
2913: $result .= &mt('default');
2914: }
2915: $result .= "\n";
1.33 matthew 2916: }
1.586 raeburn 2917: return ($result,$numlib);
1.33 matthew 2918: }
1.112 bowersj2 2919:
2920: =pod
2921:
1.534 albertel 2922: =back
2923:
1.112 bowersj2 2924: =cut
1.87 matthew 2925:
2926: ###############################################################
1.112 bowersj2 2927: ## Decoding User Agent ##
1.87 matthew 2928: ###############################################################
2929:
2930: =pod
2931:
1.112 bowersj2 2932: =head1 Decoding the User Agent
2933:
2934: =over 4
2935:
2936: =item * &decode_user_agent()
1.87 matthew 2937:
2938: Inputs: $r
2939:
2940: Outputs:
2941:
2942: =over 4
2943:
1.112 bowersj2 2944: =item * $httpbrowser
1.87 matthew 2945:
1.112 bowersj2 2946: =item * $clientbrowser
1.87 matthew 2947:
1.112 bowersj2 2948: =item * $clientversion
1.87 matthew 2949:
1.112 bowersj2 2950: =item * $clientmathml
1.87 matthew 2951:
1.112 bowersj2 2952: =item * $clientunicode
1.87 matthew 2953:
1.112 bowersj2 2954: =item * $clientos
1.87 matthew 2955:
1.1137 raeburn 2956: =item * $clientmobile
2957:
1.1141 raeburn 2958: =item * $clientinfo
2959:
1.1194 raeburn 2960: =item * $clientosversion
2961:
1.87 matthew 2962: =back
2963:
1.157 matthew 2964: =back
2965:
1.87 matthew 2966: =cut
2967:
2968: ###############################################################
2969: ###############################################################
2970: sub decode_user_agent {
1.247 albertel 2971: my ($r)=@_;
1.87 matthew 2972: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2973: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2974: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2975: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2976: my $clientbrowser='unknown';
2977: my $clientversion='0';
2978: my $clientmathml='';
2979: my $clientunicode='0';
1.1137 raeburn 2980: my $clientmobile=0;
1.1194 raeburn 2981: my $clientosversion='';
1.87 matthew 2982: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2983: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2984: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2985: $clientbrowser=$bname;
2986: $httpbrowser=~/$vreg/i;
2987: $clientversion=$1;
2988: $clientmathml=($clientversion>=$minv);
2989: $clientunicode=($clientversion>=$univ);
2990: }
2991: }
2992: my $clientos='unknown';
1.1141 raeburn 2993: my $clientinfo;
1.87 matthew 2994: if (($httpbrowser=~/linux/i) ||
2995: ($httpbrowser=~/unix/i) ||
2996: ($httpbrowser=~/ux/i) ||
2997: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2998: if (($httpbrowser=~/vax/i) ||
2999: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
3000: if ($httpbrowser=~/next/i) { $clientos='next'; }
3001: if (($httpbrowser=~/mac/i) ||
3002: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 3003: if ($httpbrowser=~/win/i) {
3004: $clientos='win';
3005: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
3006: $clientosversion = $1;
3007: }
3008: }
1.87 matthew 3009: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 3010: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
3011: $clientmobile=lc($1);
3012: }
1.1141 raeburn 3013: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
3014: $clientinfo = 'firefox-'.$1;
3015: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
3016: $clientinfo = 'chromeframe-'.$1;
3017: }
1.87 matthew 3018: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 3019: $clientunicode,$clientos,$clientmobile,$clientinfo,
3020: $clientosversion);
1.87 matthew 3021: }
3022:
1.32 matthew 3023: ###############################################################
3024: ## Authentication changing form generation subroutines ##
3025: ###############################################################
3026: ##
3027: ## All of the authform_xxxxxxx subroutines take their inputs in a
3028: ## hash, and have reasonable default values.
3029: ##
3030: ## formname = the name given in the <form> tag.
1.35 matthew 3031: #-------------------------------------------
3032:
1.45 matthew 3033: =pod
3034:
1.112 bowersj2 3035: =head1 Authentication Routines
3036:
3037: =over 4
3038:
1.648 raeburn 3039: =item * &authform_xxxxxx()
1.35 matthew 3040:
3041: The authform_xxxxxx subroutines provide javascript and html forms which
3042: handle some of the conveniences required for authentication forms.
3043: This is not an optimal method, but it works.
3044:
3045: =over 4
3046:
1.112 bowersj2 3047: =item * authform_header
1.35 matthew 3048:
1.112 bowersj2 3049: =item * authform_authorwarning
1.35 matthew 3050:
1.112 bowersj2 3051: =item * authform_nochange
1.35 matthew 3052:
1.112 bowersj2 3053: =item * authform_kerberos
1.35 matthew 3054:
1.112 bowersj2 3055: =item * authform_internal
1.35 matthew 3056:
1.112 bowersj2 3057: =item * authform_filesystem
1.35 matthew 3058:
1.1310 raeburn 3059: =item * authform_lti
3060:
1.35 matthew 3061: =back
3062:
1.648 raeburn 3063: See loncreateuser.pm for invocation and use examples.
1.157 matthew 3064:
1.35 matthew 3065: =cut
3066:
3067: #-------------------------------------------
1.32 matthew 3068: sub authform_header{
3069: my %in = (
3070: formname => 'cu',
1.80 albertel 3071: kerb_def_dom => '',
1.32 matthew 3072: @_,
3073: );
3074: $in{'formname'} = 'document.' . $in{'formname'};
3075: my $result='';
1.80 albertel 3076:
3077: #---------------------------------------------- Code for upper case translation
3078: my $Javascript_toUpperCase;
3079: unless ($in{kerb_def_dom}) {
3080: $Javascript_toUpperCase =<<"END";
3081: switch (choice) {
3082: case 'krb': currentform.elements[choicearg].value =
3083: currentform.elements[choicearg].value.toUpperCase();
3084: break;
3085: default:
3086: }
3087: END
3088: } else {
3089: $Javascript_toUpperCase = "";
3090: }
3091:
1.165 raeburn 3092: my $radioval = "'nochange'";
1.591 raeburn 3093: if (defined($in{'curr_authtype'})) {
3094: if ($in{'curr_authtype'} ne '') {
3095: $radioval = "'".$in{'curr_authtype'}."arg'";
3096: }
1.174 matthew 3097: }
1.165 raeburn 3098: my $argfield = 'null';
1.591 raeburn 3099: if (defined($in{'mode'})) {
1.165 raeburn 3100: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 3101: if (defined($in{'curr_autharg'})) {
3102: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 3103: $argfield = "'$in{'curr_autharg'}'";
3104: }
3105: }
3106: }
3107: }
3108:
1.32 matthew 3109: $result.=<<"END";
3110: var current = new Object();
1.165 raeburn 3111: current.radiovalue = $radioval;
3112: current.argfield = $argfield;
1.32 matthew 3113:
3114: function changed_radio(choice,currentform) {
3115: var choicearg = choice + 'arg';
3116: // If a radio button in changed, we need to change the argfield
3117: if (current.radiovalue != choice) {
3118: current.radiovalue = choice;
3119: if (current.argfield != null) {
3120: currentform.elements[current.argfield].value = '';
3121: }
3122: if (choice == 'nochange') {
3123: current.argfield = null;
3124: } else {
3125: current.argfield = choicearg;
3126: switch(choice) {
3127: case 'krb':
3128: currentform.elements[current.argfield].value =
3129: "$in{'kerb_def_dom'}";
3130: break;
3131: default:
3132: break;
3133: }
3134: }
3135: }
3136: return;
3137: }
1.22 www 3138:
1.32 matthew 3139: function changed_text(choice,currentform) {
3140: var choicearg = choice + 'arg';
3141: if (currentform.elements[choicearg].value !='') {
1.80 albertel 3142: $Javascript_toUpperCase
1.32 matthew 3143: // clear old field
3144: if ((current.argfield != choicearg) && (current.argfield != null)) {
3145: currentform.elements[current.argfield].value = '';
3146: }
3147: current.argfield = choicearg;
3148: }
3149: set_auth_radio_buttons(choice,currentform);
3150: return;
1.20 www 3151: }
1.32 matthew 3152:
3153: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 3154: var numauthchoices = currentform.login.length;
3155: if (typeof numauthchoices == "undefined") {
3156: return;
3157: }
1.32 matthew 3158: var i=0;
1.986 raeburn 3159: while (i < numauthchoices) {
1.32 matthew 3160: if (currentform.login[i].value == newvalue) { break; }
3161: i++;
3162: }
1.986 raeburn 3163: if (i == numauthchoices) {
1.32 matthew 3164: return;
3165: }
3166: current.radiovalue = newvalue;
3167: currentform.login[i].checked = true;
3168: return;
3169: }
3170: END
3171: return $result;
3172: }
3173:
1.1106 raeburn 3174: sub authform_authorwarning {
1.32 matthew 3175: my $result='';
1.144 matthew 3176: $result='<i>'.
3177: &mt('As a general rule, only authors or co-authors should be '.
3178: 'filesystem authenticated '.
3179: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 3180: return $result;
3181: }
3182:
1.1106 raeburn 3183: sub authform_nochange {
1.32 matthew 3184: my %in = (
3185: formname => 'document.cu',
3186: kerb_def_dom => 'MSU.EDU',
3187: @_,
3188: );
1.1106 raeburn 3189: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 3190: my $result;
1.1104 raeburn 3191: if (!$authnum) {
1.1105 raeburn 3192: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 3193: } else {
3194: $result = '<label>'.&mt('[_1] Do not change login data',
3195: '<input type="radio" name="login" value="nochange" '.
3196: 'checked="checked" onclick="'.
1.281 albertel 3197: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
3198: '</label>';
1.586 raeburn 3199: }
1.32 matthew 3200: return $result;
3201: }
3202:
1.591 raeburn 3203: sub authform_kerberos {
1.32 matthew 3204: my %in = (
3205: formname => 'document.cu',
3206: kerb_def_dom => 'MSU.EDU',
1.80 albertel 3207: kerb_def_auth => 'krb4',
1.32 matthew 3208: @_,
3209: );
1.586 raeburn 3210: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1259 raeburn 3211: $autharg,$jscall,$disabled);
1.1106 raeburn 3212: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 3213: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 3214: $check5 = ' checked="checked"';
1.80 albertel 3215: } else {
1.772 bisitz 3216: $check4 = ' checked="checked"';
1.80 albertel 3217: }
1.1259 raeburn 3218: if ($in{'readonly'}) {
3219: $disabled = ' disabled="disabled"';
3220: }
1.165 raeburn 3221: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3222: if (defined($in{'curr_authtype'})) {
3223: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3224: $krbcheck = ' checked="checked"';
1.623 raeburn 3225: if (defined($in{'mode'})) {
3226: if ($in{'mode'} eq 'modifyuser') {
3227: $krbcheck = '';
3228: }
3229: }
1.591 raeburn 3230: if (defined($in{'curr_kerb_ver'})) {
3231: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3232: $check5 = ' checked="checked"';
1.591 raeburn 3233: $check4 = '';
3234: } else {
1.772 bisitz 3235: $check4 = ' checked="checked"';
1.591 raeburn 3236: $check5 = '';
3237: }
1.586 raeburn 3238: }
1.591 raeburn 3239: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3240: $krbarg = $in{'curr_autharg'};
3241: }
1.586 raeburn 3242: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3243: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3244: $result =
3245: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3246: $in{'curr_autharg'},$krbver);
3247: } else {
3248: $result =
3249: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3250: }
3251: return $result;
3252: }
3253: }
3254: } else {
3255: if ($authnum == 1) {
1.784 bisitz 3256: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3257: }
3258: }
1.586 raeburn 3259: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3260: return;
1.587 raeburn 3261: } elsif ($authtype eq '') {
1.591 raeburn 3262: if (defined($in{'mode'})) {
1.587 raeburn 3263: if ($in{'mode'} eq 'modifycourse') {
3264: if ($authnum == 1) {
1.1259 raeburn 3265: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3266: }
3267: }
3268: }
1.586 raeburn 3269: }
3270: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3271: if ($authtype eq '') {
3272: $authtype = '<input type="radio" name="login" value="krb" '.
3273: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1259 raeburn 3274: $krbcheck.$disabled.' />';
1.586 raeburn 3275: }
3276: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 3277: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3278: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 3279: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3280: $in{'curr_authtype'} eq 'krb4')) {
3281: $result .= &mt
1.144 matthew 3282: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3283: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3284: '<label>'.$authtype,
1.281 albertel 3285: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3286: 'value="'.$krbarg.'" '.
1.1259 raeburn 3287: 'onchange="'.$jscall.'"'.$disabled.' />',
3288: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3289: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3290: '</label>');
1.586 raeburn 3291: } elsif ($can_assign{'krb4'}) {
3292: $result .= &mt
3293: ('[_1] Kerberos authenticated with domain [_2] '.
3294: '[_3] Version 4 [_4]',
3295: '<label>'.$authtype,
3296: '</label><input type="text" size="10" name="krbarg" '.
3297: 'value="'.$krbarg.'" '.
1.1259 raeburn 3298: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3299: '<label><input type="hidden" name="krbver" value="4" />',
3300: '</label>');
3301: } elsif ($can_assign{'krb5'}) {
3302: $result .= &mt
3303: ('[_1] Kerberos authenticated with domain [_2] '.
3304: '[_3] Version 5 [_4]',
3305: '<label>'.$authtype,
3306: '</label><input type="text" size="10" name="krbarg" '.
3307: 'value="'.$krbarg.'" '.
1.1259 raeburn 3308: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3309: '<label><input type="hidden" name="krbver" value="5" />',
3310: '</label>');
3311: }
1.32 matthew 3312: return $result;
3313: }
3314:
1.1106 raeburn 3315: sub authform_internal {
1.586 raeburn 3316: my %in = (
1.32 matthew 3317: formname => 'document.cu',
3318: kerb_def_dom => 'MSU.EDU',
3319: @_,
3320: );
1.1259 raeburn 3321: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3322: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3323: if ($in{'readonly'}) {
3324: $disabled = ' disabled="disabled"';
3325: }
1.591 raeburn 3326: if (defined($in{'curr_authtype'})) {
3327: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3328: if ($can_assign{'int'}) {
1.772 bisitz 3329: $intcheck = 'checked="checked" ';
1.623 raeburn 3330: if (defined($in{'mode'})) {
3331: if ($in{'mode'} eq 'modifyuser') {
3332: $intcheck = '';
3333: }
3334: }
1.591 raeburn 3335: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3336: $intarg = $in{'curr_autharg'};
3337: }
3338: } else {
3339: $result = &mt('Currently internally authenticated.');
3340: return $result;
1.165 raeburn 3341: }
3342: }
1.586 raeburn 3343: } else {
3344: if ($authnum == 1) {
1.784 bisitz 3345: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3346: }
3347: }
3348: if (!$can_assign{'int'}) {
3349: return;
1.587 raeburn 3350: } elsif ($authtype eq '') {
1.591 raeburn 3351: if (defined($in{'mode'})) {
1.587 raeburn 3352: if ($in{'mode'} eq 'modifycourse') {
3353: if ($authnum == 1) {
1.1259 raeburn 3354: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3355: }
3356: }
3357: }
1.165 raeburn 3358: }
1.586 raeburn 3359: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3360: if ($authtype eq '') {
3361: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1259 raeburn 3362: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3363: }
1.605 bisitz 3364: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1259 raeburn 3365: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3366: $result = &mt
1.144 matthew 3367: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3368: '<label>'.$authtype,'</label>'.$autharg);
1.1259 raeburn 3369: $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 3370: return $result;
3371: }
3372:
1.1104 raeburn 3373: sub authform_local {
1.32 matthew 3374: my %in = (
3375: formname => 'document.cu',
3376: kerb_def_dom => 'MSU.EDU',
3377: @_,
3378: );
1.1259 raeburn 3379: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3380: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3381: if ($in{'readonly'}) {
3382: $disabled = ' disabled="disabled"';
3383: }
1.591 raeburn 3384: if (defined($in{'curr_authtype'})) {
3385: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3386: if ($can_assign{'loc'}) {
1.772 bisitz 3387: $loccheck = 'checked="checked" ';
1.623 raeburn 3388: if (defined($in{'mode'})) {
3389: if ($in{'mode'} eq 'modifyuser') {
3390: $loccheck = '';
3391: }
3392: }
1.591 raeburn 3393: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3394: $locarg = $in{'curr_autharg'};
3395: }
3396: } else {
3397: $result = &mt('Currently using local (institutional) authentication.');
3398: return $result;
1.165 raeburn 3399: }
3400: }
1.586 raeburn 3401: } else {
3402: if ($authnum == 1) {
1.784 bisitz 3403: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3404: }
3405: }
3406: if (!$can_assign{'loc'}) {
3407: return;
1.587 raeburn 3408: } elsif ($authtype eq '') {
1.591 raeburn 3409: if (defined($in{'mode'})) {
1.587 raeburn 3410: if ($in{'mode'} eq 'modifycourse') {
3411: if ($authnum == 1) {
1.1259 raeburn 3412: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3413: }
3414: }
3415: }
1.165 raeburn 3416: }
1.586 raeburn 3417: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3418: if ($authtype eq '') {
3419: $authtype = '<input type="radio" name="login" value="loc" '.
3420: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3421: $jscall.'"'.$disabled.' />';
1.586 raeburn 3422: }
3423: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1259 raeburn 3424: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3425: $result = &mt('[_1] Local Authentication with argument [_2]',
3426: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3427: return $result;
3428: }
3429:
1.1106 raeburn 3430: sub authform_filesystem {
1.32 matthew 3431: my %in = (
3432: formname => 'document.cu',
3433: kerb_def_dom => 'MSU.EDU',
3434: @_,
3435: );
1.1259 raeburn 3436: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1106 raeburn 3437: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1259 raeburn 3438: if ($in{'readonly'}) {
3439: $disabled = ' disabled="disabled"';
3440: }
1.591 raeburn 3441: if (defined($in{'curr_authtype'})) {
3442: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3443: if ($can_assign{'fsys'}) {
1.772 bisitz 3444: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3445: if (defined($in{'mode'})) {
3446: if ($in{'mode'} eq 'modifyuser') {
3447: $fsyscheck = '';
3448: }
3449: }
1.586 raeburn 3450: } else {
3451: $result = &mt('Currently Filesystem Authenticated.');
3452: return $result;
1.1259 raeburn 3453: }
1.586 raeburn 3454: }
3455: } else {
3456: if ($authnum == 1) {
1.784 bisitz 3457: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3458: }
3459: }
3460: if (!$can_assign{'fsys'}) {
3461: return;
1.587 raeburn 3462: } elsif ($authtype eq '') {
1.591 raeburn 3463: if (defined($in{'mode'})) {
1.587 raeburn 3464: if ($in{'mode'} eq 'modifycourse') {
3465: if ($authnum == 1) {
1.1259 raeburn 3466: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3467: }
3468: }
3469: }
1.586 raeburn 3470: }
3471: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3472: if ($authtype eq '') {
3473: $authtype = '<input type="radio" name="login" value="fsys" '.
3474: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1259 raeburn 3475: $jscall.'"'.$disabled.' />';
1.586 raeburn 3476: }
1.1310 raeburn 3477: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1259 raeburn 3478: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3479: $result = &mt
1.144 matthew 3480: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1310 raeburn 3481: '<label>'.$authtype,'</label>'.$autharg);
3482: return $result;
3483: }
3484:
3485: sub authform_lti {
3486: my %in = (
3487: formname => 'document.cu',
3488: kerb_def_dom => 'MSU.EDU',
3489: @_,
3490: );
3491: my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
3492: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
3493: if ($in{'readonly'}) {
3494: $disabled = ' disabled="disabled"';
3495: }
3496: if (defined($in{'curr_authtype'})) {
3497: if ($in{'curr_authtype'} eq 'lti') {
3498: if ($can_assign{'lti'}) {
3499: $lticheck = 'checked="checked" ';
3500: if (defined($in{'mode'})) {
3501: if ($in{'mode'} eq 'modifyuser') {
3502: $lticheck = '';
3503: }
3504: }
3505: } else {
3506: $result = &mt('Currently LTI Authenticated.');
3507: return $result;
3508: }
3509: }
3510: } else {
3511: if ($authnum == 1) {
3512: $authtype = '<input type="hidden" name="login" value="lti" />';
3513: }
3514: }
3515: if (!$can_assign{'lti'}) {
3516: return;
3517: } elsif ($authtype eq '') {
3518: if (defined($in{'mode'})) {
3519: if ($in{'mode'} eq 'modifycourse') {
3520: if ($authnum == 1) {
3521: $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
3522: }
3523: }
3524: }
3525: }
3526: $jscall = "javascript:changed_radio('lti',$in{'formname'});";
3527: if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
3528: $authtype = '<input type="radio" name="login" value="lti" '.
3529: $lticheck.' onchange="'.$jscall.'" onclick="'.
3530: $jscall.'"'.$disabled.' />';
3531: }
3532: $autharg = '<input type="hidden" name="ltiarg" value="" />';
3533: if ($authtype) {
3534: $result = &mt('[_1] LTI Authenticated',
3535: '<label>'.$authtype.'</label>'.$autharg);
3536: } else {
3537: $result = '<b>'.&mt('LTI Authenticated').'</b>'.
3538: $autharg;
3539: }
1.32 matthew 3540: return $result;
3541: }
3542:
1.586 raeburn 3543: sub get_assignable_auth {
3544: my ($dom) = @_;
3545: if ($dom eq '') {
3546: $dom = $env{'request.role.domain'};
3547: }
3548: my %can_assign = (
3549: krb4 => 1,
3550: krb5 => 1,
3551: int => 1,
3552: loc => 1,
1.1310 raeburn 3553: lti => 1,
1.586 raeburn 3554: );
3555: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3556: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3557: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3558: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3559: my $context;
3560: if ($env{'request.role'} =~ /^au/) {
3561: $context = 'author';
1.1259 raeburn 3562: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3563: $context = 'domain';
3564: } elsif ($env{'request.course.id'}) {
3565: $context = 'course';
3566: }
3567: if ($context) {
3568: if (ref($authhash->{$context}) eq 'HASH') {
3569: %can_assign = %{$authhash->{$context}};
3570: }
3571: }
3572: }
3573: }
3574: my $authnum = 0;
3575: foreach my $key (keys(%can_assign)) {
3576: if ($can_assign{$key}) {
3577: $authnum ++;
3578: }
3579: }
3580: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3581: $authnum --;
3582: }
3583: return ($authnum,%can_assign);
3584: }
3585:
1.1331 raeburn 3586: sub check_passwd_rules {
3587: my ($domain,$plainpass) = @_;
3588: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3589: my ($min,$max,@chars,@brokerule,$warning);
1.1333 raeburn 3590: $min = $Apache::lonnet::passwdmin;
1.1331 raeburn 3591: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3592: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1333 raeburn 3593: if ($passwdconf{'min'} > $min) {
3594: $min = $passwdconf{'min'};
3595: }
1.1331 raeburn 3596: }
3597: if ($passwdconf{'max'} =~ /^\d+$/) {
3598: $max = $passwdconf{'max'};
3599: }
3600: @chars = @{$passwdconf{'chars'}};
3601: }
3602: if (($min) && (length($plainpass) < $min)) {
3603: push(@brokerule,'min');
3604: }
3605: if (($max) && (length($plainpass) > $max)) {
3606: push(@brokerule,'max');
3607: }
3608: if (@chars) {
3609: my %rules;
3610: map { $rules{$_} = 1; } @chars;
3611: if ($rules{'uc'}) {
3612: unless ($plainpass =~ /[A-Z]/) {
3613: push(@brokerule,'uc');
3614: }
3615: }
3616: if ($rules{'lc'}) {
1.1332 raeburn 3617: unless ($plainpass =~ /[a-z]/) {
1.1331 raeburn 3618: push(@brokerule,'lc');
3619: }
3620: }
3621: if ($rules{'num'}) {
3622: unless ($plainpass =~ /\d/) {
3623: push(@brokerule,'num');
3624: }
3625: }
3626: if ($rules{'spec'}) {
3627: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3628: push(@brokerule,'spec');
3629: }
3630: }
3631: }
3632: if (@brokerule) {
3633: my %rulenames = &Apache::lonlocal::texthash(
3634: uc => 'At least one upper case letter',
3635: lc => 'At least one lower case letter',
3636: num => 'At least one number',
3637: spec => 'At least one non-alphanumeric',
3638: );
3639: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3640: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3641: $rulenames{'num'} .= ': 0123456789';
3642: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3643: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3644: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3645: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1336 raeburn 3646: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1331 raeburn 3647: if (grep(/^$rule$/,@brokerule)) {
3648: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3649: }
3650: }
3651: $warning .= '</ul>';
3652: }
1.1332 raeburn 3653: if (wantarray) {
3654: return @brokerule;
3655: }
1.1331 raeburn 3656: return $warning;
3657: }
3658:
1.1376 raeburn 3659: sub passwd_validation_js {
1.1377 raeburn 3660: my ($currpasswdval,$domain,$context,$id) = @_;
3661: my (%passwdconf,$alertmsg);
3662: if ($context eq 'linkprot') {
3663: my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
3664: if (ref($domconfig{'ltisec'}) eq 'HASH') {
3665: if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
3666: %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
3667: }
3668: }
3669: if ($id eq 'add') {
3670: $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
3671: } elsif ($id =~ /^\d+$/) {
3672: my $pos = $id+1;
3673: $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3674: } else {
3675: $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3676: }
3677: } else {
3678: %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3679: $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
3680: }
1.1376 raeburn 3681: my ($min,$max,@chars,$numrules,$intargjs,%alert);
3682: $numrules = 0;
3683: $min = $Apache::lonnet::passwdmin;
3684: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3685: if ($passwdconf{'min'} =~ /^\d+$/) {
3686: if ($passwdconf{'min'} > $min) {
3687: $min = $passwdconf{'min'};
3688: }
3689: }
3690: if ($passwdconf{'max'} =~ /^\d+$/) {
3691: $max = $passwdconf{'max'};
3692: $numrules ++;
3693: }
3694: @chars = @{$passwdconf{'chars'}};
3695: if (@chars) {
3696: $numrules ++;
3697: }
3698: }
3699: if ($min > 0) {
3700: $numrules ++;
3701: }
3702: if (($min > 0) || ($max ne '') || (@chars > 0)) {
3703: if ($min) {
3704: $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
3705: }
3706: if ($max) {
3707: $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
3708: }
3709: my (@charalerts,@charrules);
3710: if (@chars) {
3711: if (grep(/^uc$/,@chars)) {
3712: push(@charalerts,&mt('contain at least one upper case letter'));
3713: push(@charrules,'uc');
3714: }
3715: if (grep(/^lc$/,@chars)) {
3716: push(@charalerts,&mt('contain at least one lower case letter'));
3717: push(@charrules,'lc');
3718: }
3719: if (grep(/^num$/,@chars)) {
3720: push(@charalerts,&mt('contain at least one number'));
3721: push(@charrules,'num');
3722: }
3723: if (grep(/^spec$/,@chars)) {
3724: push(@charalerts,&mt('contain at least one non-alphanumeric'));
3725: push(@charrules,'spec');
3726: }
3727: }
3728: $intargjs = qq| var rulesmsg = '';\n|.
3729: qq| var currpwval = $currpasswdval;\n|;
3730: if ($min) {
3731: $intargjs .= qq|
3732: if (currpwval.length < $min) {
3733: rulesmsg += ' - $alert{min}';
3734: }
3735: |;
3736: }
3737: if ($max) {
3738: $intargjs .= qq|
3739: if (currpwval.length > $max) {
3740: rulesmsg += ' - $alert{max}';
3741: }
3742: |;
3743: }
3744: if (@chars > 0) {
3745: my $charrulestr = '"'.join('","',@charrules).'"';
3746: my $charalertstr = '"'.join('","',@charalerts).'"';
3747: $intargjs .= qq| var brokerules = new Array();\n|.
3748: qq| var charrules = new Array($charrulestr);\n|.
3749: qq| var charalerts = new Array($charalertstr);\n|;
3750: my %rules;
3751: map { $rules{$_} = 1; } @chars;
3752: if ($rules{'uc'}) {
3753: $intargjs .= qq|
3754: var ucRegExp = /[A-Z]/;
3755: if (!ucRegExp.test(currpwval)) {
3756: brokerules.push('uc');
3757: }
3758: |;
3759: }
3760: if ($rules{'lc'}) {
3761: $intargjs .= qq|
3762: var lcRegExp = /[a-z]/;
3763: if (!lcRegExp.test(currpwval)) {
3764: brokerules.push('lc');
3765: }
3766: |;
3767: }
3768: if ($rules{'num'}) {
3769: $intargjs .= qq|
3770: var numRegExp = /[0-9]/;
3771: if (!numRegExp.test(currpwval)) {
3772: brokerules.push('num');
3773: }
3774: |;
3775: }
3776: if ($rules{'spec'}) {
3777: $intargjs .= q|
3778: var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
3779: if (!specRegExp.test(currpwval)) {
3780: brokerules.push('spec');
3781: }
3782: |;
3783: }
3784: $intargjs .= qq|
3785: if (brokerules.length > 0) {
3786: for (var i=0; i<brokerules.length; i++) {
3787: for (var j=0; j<charrules.length; j++) {
3788: if (brokerules[i] == charrules[j]) {
3789: rulesmsg += ' - '+charalerts[j]+'\\n';
3790: break;
3791: }
3792: }
3793: }
3794: }
3795: |;
3796: }
3797: $intargjs .= qq|
3798: if (rulesmsg != '') {
3799: rulesmsg = '$alertmsg'+rulesmsg;
3800: alert(rulesmsg);
3801: return false;
3802: }
3803: |;
3804: }
3805: return ($numrules,$intargjs);
3806: }
3807:
1.80 albertel 3808: ###############################################################
3809: ## Get Kerberos Defaults for Domain ##
3810: ###############################################################
3811: ##
3812: ## Returns default kerberos version and an associated argument
3813: ## as listed in file domain.tab. If not listed, provides
3814: ## appropriate default domain and kerberos version.
3815: ##
3816: #-------------------------------------------
3817:
3818: =pod
3819:
1.648 raeburn 3820: =item * &get_kerberos_defaults()
1.80 albertel 3821:
3822: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3823: version and domain. If not found, it defaults to version 4 and the
3824: domain of the server.
1.80 albertel 3825:
1.648 raeburn 3826: =over 4
3827:
1.80 albertel 3828: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3829:
1.648 raeburn 3830: =back
3831:
3832: =back
3833:
1.80 albertel 3834: =cut
3835:
3836: #-------------------------------------------
3837: sub get_kerberos_defaults {
3838: my $domain=shift;
1.641 raeburn 3839: my ($krbdef,$krbdefdom);
3840: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3841: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3842: $krbdef = $domdefaults{'auth_def'};
3843: $krbdefdom = $domdefaults{'auth_arg_def'};
3844: } else {
1.80 albertel 3845: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3846: my $krbdefdom=$1;
3847: $krbdefdom=~tr/a-z/A-Z/;
3848: $krbdef = "krb4";
3849: }
3850: return ($krbdef,$krbdefdom);
3851: }
1.112 bowersj2 3852:
1.32 matthew 3853:
1.46 matthew 3854: ###############################################################
3855: ## Thesaurus Functions ##
3856: ###############################################################
1.20 www 3857:
1.46 matthew 3858: =pod
1.20 www 3859:
1.112 bowersj2 3860: =head1 Thesaurus Functions
3861:
3862: =over 4
3863:
1.648 raeburn 3864: =item * &initialize_keywords()
1.46 matthew 3865:
3866: Initializes the package variable %Keywords if it is empty. Uses the
3867: package variable $thesaurus_db_file.
3868:
3869: =cut
3870:
3871: ###################################################
3872:
3873: sub initialize_keywords {
3874: return 1 if (scalar keys(%Keywords));
3875: # If we are here, %Keywords is empty, so fill it up
3876: # Make sure the file we need exists...
3877: if (! -e $thesaurus_db_file) {
3878: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3879: " failed because it does not exist");
3880: return 0;
3881: }
3882: # Set up the hash as a database
3883: my %thesaurus_db;
3884: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3885: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3886: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3887: $thesaurus_db_file);
3888: return 0;
3889: }
3890: # Get the average number of appearances of a word.
3891: my $avecount = $thesaurus_db{'average.count'};
3892: # Put keywords (those that appear > average) into %Keywords
3893: while (my ($word,$data)=each (%thesaurus_db)) {
3894: my ($count,undef) = split /:/,$data;
3895: $Keywords{$word}++ if ($count > $avecount);
3896: }
3897: untie %thesaurus_db;
3898: # Remove special values from %Keywords.
1.356 albertel 3899: foreach my $value ('total.count','average.count') {
3900: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3901: }
1.46 matthew 3902: return 1;
3903: }
3904:
3905: ###################################################
3906:
3907: =pod
3908:
1.648 raeburn 3909: =item * &keyword($word)
1.46 matthew 3910:
3911: Returns true if $word is a keyword. A keyword is a word that appears more
3912: than the average number of times in the thesaurus database. Calls
3913: &initialize_keywords
3914:
3915: =cut
3916:
3917: ###################################################
1.20 www 3918:
3919: sub keyword {
1.46 matthew 3920: return if (!&initialize_keywords());
3921: my $word=lc(shift());
3922: $word=~s/\W//g;
3923: return exists($Keywords{$word});
1.20 www 3924: }
1.46 matthew 3925:
3926: ###############################################################
3927:
3928: =pod
1.20 www 3929:
1.648 raeburn 3930: =item * &get_related_words()
1.46 matthew 3931:
1.160 matthew 3932: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3933: an array of words. If the keyword is not in the thesaurus, an empty array
3934: will be returned. The order of the words returned is determined by the
3935: database which holds them.
3936:
3937: Uses global $thesaurus_db_file.
3938:
1.1057 foxr 3939:
1.46 matthew 3940: =cut
3941:
3942: ###############################################################
3943: sub get_related_words {
3944: my $keyword = shift;
3945: my %thesaurus_db;
3946: if (! -e $thesaurus_db_file) {
3947: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3948: "failed because the file does not exist");
3949: return ();
3950: }
3951: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3952: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3953: return ();
3954: }
3955: my @Words=();
1.429 www 3956: my $count=0;
1.46 matthew 3957: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3958: # The first element is the number of times
3959: # the word appears. We do not need it now.
1.429 www 3960: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3961: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3962: my $threshold=$mostfrequentcount/10;
3963: foreach my $possibleword (@RelatedWords) {
3964: my ($word,$wordcount)=split(/\,/,$possibleword);
3965: if ($wordcount>$threshold) {
3966: push(@Words,$word);
3967: $count++;
3968: if ($count>10) { last; }
3969: }
1.20 www 3970: }
3971: }
1.46 matthew 3972: untie %thesaurus_db;
3973: return @Words;
1.14 harris41 3974: }
1.1090 foxr 3975: ###############################################################
3976: #
3977: # Spell checking
3978: #
3979:
3980: =pod
3981:
1.1142 raeburn 3982: =back
3983:
1.1090 foxr 3984: =head1 Spell checking
3985:
3986: =over 4
3987:
3988: =item * &check_spelling($wordlist $language)
3989:
3990: Takes a string containing words and feeds it to an external
3991: spellcheck program via a pipeline. Returns a string containing
3992: them mis-spelled words.
3993:
3994: Parameters:
3995:
3996: =over 4
3997:
3998: =item - $wordlist
3999:
4000: String that will be fed into the spellcheck program.
4001:
4002: =item - $language
4003:
4004: Language string that specifies the language for which the spell
4005: check will be performed.
4006:
4007: =back
4008:
4009: =back
4010:
4011: Note: This sub assumes that aspell is installed.
4012:
4013:
4014: =cut
4015:
1.46 matthew 4016:
1.1090 foxr 4017: sub check_spelling {
4018: my ($wordlist, $language) = @_;
1.1091 foxr 4019: my @misspellings;
4020:
4021: # Generate the speller and set the langauge.
4022: # if explicitly selected:
1.1090 foxr 4023:
1.1091 foxr 4024: my $speller = Text::Aspell->new;
1.1090 foxr 4025: if ($language) {
1.1091 foxr 4026: $speller->set_option('lang', $language);
1.1090 foxr 4027: }
4028:
1.1091 foxr 4029: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 4030:
1.1091 foxr 4031: my @words = split(/\s+/, $wordlist);
1.1090 foxr 4032:
1.1091 foxr 4033: foreach my $word (@words) {
4034: if(! $speller->check($word)) {
4035: push(@misspellings, $word);
1.1090 foxr 4036: }
4037: }
1.1091 foxr 4038: return join(' ', @misspellings);
4039:
1.1090 foxr 4040: }
4041:
1.61 www 4042: # -------------------------------------------------------------- Plaintext name
1.81 albertel 4043: =pod
4044:
1.112 bowersj2 4045: =head1 User Name Functions
4046:
4047: =over 4
4048:
1.648 raeburn 4049: =item * &plainname($uname,$udom,$first)
1.81 albertel 4050:
1.112 bowersj2 4051: Takes a users logon name and returns it as a string in
1.226 albertel 4052: "first middle last generation" form
4053: if $first is set to 'lastname' then it returns it as
4054: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 4055:
4056: =cut
1.61 www 4057:
1.295 www 4058:
1.81 albertel 4059: ###############################################################
1.61 www 4060: sub plainname {
1.226 albertel 4061: my ($uname,$udom,$first)=@_;
1.537 albertel 4062: return if (!defined($uname) || !defined($udom));
1.295 www 4063: my %names=&getnames($uname,$udom);
1.226 albertel 4064: my $name=&Apache::lonnet::format_name($names{'firstname'},
4065: $names{'middlename'},
4066: $names{'lastname'},
4067: $names{'generation'},$first);
4068: $name=~s/^\s+//;
1.62 www 4069: $name=~s/\s+$//;
4070: $name=~s/\s+/ /g;
1.353 albertel 4071: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 4072: return $name;
1.61 www 4073: }
1.66 www 4074:
4075: # -------------------------------------------------------------------- Nickname
1.81 albertel 4076: =pod
4077:
1.648 raeburn 4078: =item * &nickname($uname,$udom)
1.81 albertel 4079:
4080: Gets a users name and returns it as a string as
4081:
4082: ""nickname""
1.66 www 4083:
1.81 albertel 4084: if the user has a nickname or
4085:
4086: "first middle last generation"
4087:
4088: if the user does not
4089:
4090: =cut
1.66 www 4091:
4092: sub nickname {
4093: my ($uname,$udom)=@_;
1.537 albertel 4094: return if (!defined($uname) || !defined($udom));
1.295 www 4095: my %names=&getnames($uname,$udom);
1.68 albertel 4096: my $name=$names{'nickname'};
1.66 www 4097: if ($name) {
4098: $name='"'.$name.'"';
4099: } else {
4100: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
4101: $names{'lastname'}.' '.$names{'generation'};
4102: $name=~s/\s+$//;
4103: $name=~s/\s+/ /g;
4104: }
4105: return $name;
4106: }
4107:
1.295 www 4108: sub getnames {
4109: my ($uname,$udom)=@_;
1.537 albertel 4110: return if (!defined($uname) || !defined($udom));
1.433 albertel 4111: if ($udom eq 'public' && $uname eq 'public') {
4112: return ('lastname' => &mt('Public'));
4113: }
1.295 www 4114: my $id=$uname.':'.$udom;
4115: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
4116: if ($cached) {
4117: return %{$names};
4118: } else {
4119: my %loadnames=&Apache::lonnet::get('environment',
4120: ['firstname','middlename','lastname','generation','nickname'],
4121: $udom,$uname);
4122: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
4123: return %loadnames;
4124: }
4125: }
1.61 www 4126:
1.542 raeburn 4127: # -------------------------------------------------------------------- getemails
1.648 raeburn 4128:
1.542 raeburn 4129: =pod
4130:
1.648 raeburn 4131: =item * &getemails($uname,$udom)
1.542 raeburn 4132:
4133: Gets a user's email information and returns it as a hash with keys:
4134: notification, critnotification, permanentemail
4135:
4136: For notification and critnotification, values are comma-separated lists
1.648 raeburn 4137: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 4138:
1.648 raeburn 4139:
1.542 raeburn 4140: =cut
4141:
1.648 raeburn 4142:
1.466 albertel 4143: sub getemails {
4144: my ($uname,$udom)=@_;
4145: if ($udom eq 'public' && $uname eq 'public') {
4146: return;
4147: }
1.467 www 4148: if (!$udom) { $udom=$env{'user.domain'}; }
4149: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 4150: my $id=$uname.':'.$udom;
4151: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
4152: if ($cached) {
4153: return %{$names};
4154: } else {
4155: my %loadnames=&Apache::lonnet::get('environment',
4156: ['notification','critnotification',
4157: 'permanentemail'],
4158: $udom,$uname);
4159: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
4160: return %loadnames;
4161: }
4162: }
4163:
1.551 albertel 4164: sub flush_email_cache {
4165: my ($uname,$udom)=@_;
4166: if (!$udom) { $udom =$env{'user.domain'}; }
4167: if (!$uname) { $uname=$env{'user.name'}; }
4168: return if ($udom eq 'public' && $uname eq 'public');
4169: my $id=$uname.':'.$udom;
4170: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
4171: }
4172:
1.728 raeburn 4173: # -------------------------------------------------------------------- getlangs
4174:
4175: =pod
4176:
4177: =item * &getlangs($uname,$udom)
4178:
4179: Gets a user's language preference and returns it as a hash with key:
4180: language.
4181:
4182: =cut
4183:
4184:
4185: sub getlangs {
4186: my ($uname,$udom) = @_;
4187: if (!$udom) { $udom =$env{'user.domain'}; }
4188: if (!$uname) { $uname=$env{'user.name'}; }
4189: my $id=$uname.':'.$udom;
4190: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
4191: if ($cached) {
4192: return %{$langs};
4193: } else {
4194: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
4195: $udom,$uname);
4196: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
4197: return %loadlangs;
4198: }
4199: }
4200:
4201: sub flush_langs_cache {
4202: my ($uname,$udom)=@_;
4203: if (!$udom) { $udom =$env{'user.domain'}; }
4204: if (!$uname) { $uname=$env{'user.name'}; }
4205: return if ($udom eq 'public' && $uname eq 'public');
4206: my $id=$uname.':'.$udom;
4207: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
4208: }
4209:
1.61 www 4210: # ------------------------------------------------------------------ Screenname
1.81 albertel 4211:
4212: =pod
4213:
1.648 raeburn 4214: =item * &screenname($uname,$udom)
1.81 albertel 4215:
4216: Gets a users screenname and returns it as a string
4217:
4218: =cut
1.61 www 4219:
4220: sub screenname {
4221: my ($uname,$udom)=@_;
1.258 albertel 4222: if ($uname eq $env{'user.name'} &&
4223: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 4224: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 4225: return $names{'screenname'};
1.62 www 4226: }
4227:
1.212 albertel 4228:
1.802 bisitz 4229: # ------------------------------------------------------------- Confirm Wrapper
4230: =pod
4231:
1.1142 raeburn 4232: =item * &confirmwrapper($message)
1.802 bisitz 4233:
4234: Wrap messages about completion of operation in box
4235:
4236: =cut
4237:
4238: sub confirmwrapper {
4239: my ($message)=@_;
4240: if ($message) {
4241: return "\n".'<div class="LC_confirm_box">'."\n"
4242: .$message."\n"
4243: .'</div>'."\n";
4244: } else {
4245: return $message;
4246: }
4247: }
4248:
1.62 www 4249: # ------------------------------------------------------------- Message Wrapper
4250:
4251: sub messagewrapper {
1.369 www 4252: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 4253: return
1.441 albertel 4254: '<a href="/adm/email?compose=individual&'.
4255: 'recname='.$username.'&recdom='.$domain.
4256: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 4257: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 4258: }
1.802 bisitz 4259:
1.74 www 4260: # --------------------------------------------------------------- Notes Wrapper
4261:
4262: sub noteswrapper {
4263: my ($link,$un,$do)=@_;
4264: return
1.896 amueller 4265: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 4266: }
1.802 bisitz 4267:
1.62 www 4268: # ------------------------------------------------------------- Aboutme Wrapper
4269:
4270: sub aboutmewrapper {
1.1070 raeburn 4271: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 4272: if (!defined($username) && !defined($domain)) {
4273: return;
4274: }
1.1096 raeburn 4275: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 4276: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 4277: }
4278:
4279: # ------------------------------------------------------------ Syllabus Wrapper
4280:
4281: sub syllabuswrapper {
1.707 bisitz 4282: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 4283: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 4284: }
1.14 harris41 4285:
1.1397 raeburn 4286: # -----------------------------------------------------------------------------
4287:
1.1396 raeburn 4288: sub aboutme_on {
4289: my ($uname,$udom)=@_;
4290: unless ($uname) { $uname=$env{'user.name'}; }
4291: unless ($udom) { $udom=$env{'user.domain'}; }
4292: return if ($udom eq 'public' && $uname eq 'public');
4293: my $hashkey=$uname.':'.$udom;
4294: my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
4295: if ($cached) {
4296: return $aboutme;
4297: }
4298: $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
4299: &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
4300: return $aboutme;
4301: }
4302:
4303: sub devalidate_aboutme_cache {
4304: my ($uname,$udom)=@_;
4305: if (!$udom) { $udom =$env{'user.domain'}; }
4306: if (!$uname) { $uname=$env{'user.name'}; }
4307: return if ($udom eq 'public' && $uname eq 'public');
4308: my $id=$uname.':'.$udom;
4309: &Apache::lonnet::devalidate_cache_new('aboutme',$id);
4310: }
4311:
1.208 matthew 4312: sub track_student_link {
1.887 raeburn 4313: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 4314: my $link ="/adm/trackstudent?";
1.208 matthew 4315: my $title = 'View recent activity';
4316: if (defined($sname) && $sname !~ /^\s*$/ &&
4317: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 4318: $link .= "selected_student=$sname:$sdom";
1.208 matthew 4319: $title .= ' of this student';
1.268 albertel 4320: }
1.208 matthew 4321: if (defined($target) && $target !~ /^\s*$/) {
4322: $target = qq{target="$target"};
4323: } else {
4324: $target = '';
4325: }
1.268 albertel 4326: if ($start) { $link.='&start='.$start; }
1.887 raeburn 4327: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 4328: $title = &mt($title);
4329: $linktext = &mt($linktext);
1.448 albertel 4330: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
4331: &help_open_topic('View_recent_activity');
1.208 matthew 4332: }
4333:
1.781 raeburn 4334: sub slot_reservations_link {
4335: my ($linktext,$sname,$sdom,$target) = @_;
4336: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4337: my $title = 'View slot reservation history';
4338: if (defined($sname) && $sname !~ /^\s*$/ &&
4339: defined($sdom) && $sdom !~ /^\s*$/) {
4340: $link .= "&uname=$sname&udom=$sdom";
4341: $title .= ' of this student';
4342: }
4343: if (defined($target) && $target !~ /^\s*$/) {
4344: $target = qq{target="$target"};
4345: } else {
4346: $target = '';
4347: }
4348: $title = &mt($title);
4349: $linktext = &mt($linktext);
4350: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4351: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4352:
4353: }
4354:
1.508 www 4355: # ===================================================== Display a student photo
4356:
4357:
1.509 albertel 4358: sub student_image_tag {
1.508 www 4359: my ($domain,$user)=@_;
4360: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4361: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4362: return '<img src="'.$imgsrc.'" align="right" />';
4363: } else {
4364: return '';
4365: }
4366: }
4367:
1.112 bowersj2 4368: =pod
4369:
4370: =back
4371:
4372: =head1 Access .tab File Data
4373:
4374: =over 4
4375:
1.648 raeburn 4376: =item * &languageids()
1.112 bowersj2 4377:
4378: returns list of all language ids
4379:
4380: =cut
4381:
1.14 harris41 4382: sub languageids {
1.16 harris41 4383: return sort(keys(%language));
1.14 harris41 4384: }
4385:
1.112 bowersj2 4386: =pod
4387:
1.648 raeburn 4388: =item * &languagedescription()
1.112 bowersj2 4389:
4390: returns description of a specified language id
4391:
4392: =cut
4393:
1.14 harris41 4394: sub languagedescription {
1.125 www 4395: my $code=shift;
4396: return ($supported_language{$code}?'* ':'').
4397: $language{$code}.
1.126 www 4398: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4399: }
4400:
1.1048 foxr 4401: =pod
4402:
4403: =item * &plainlanguagedescription
4404:
4405: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4406: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4407:
4408: =cut
4409:
1.145 www 4410: sub plainlanguagedescription {
4411: my $code=shift;
4412: return $language{$code};
4413: }
4414:
1.1048 foxr 4415: =pod
4416:
4417: =item * &supportedlanguagecode
4418:
4419: Returns the supported language code (e.g. sptutf maps to pt) given a language
4420: code.
4421:
4422: =cut
4423:
1.145 www 4424: sub supportedlanguagecode {
4425: my $code=shift;
4426: return $supported_language{$code};
1.97 www 4427: }
4428:
1.112 bowersj2 4429: =pod
4430:
1.1048 foxr 4431: =item * &latexlanguage()
4432:
4433: Given a language key code returns the correspondnig language to use
4434: to select the correct hyphenation on LaTeX printouts. This is undef if there
4435: is no supported hyphenation for the language code.
4436:
4437: =cut
4438:
4439: sub latexlanguage {
4440: my $code = shift;
4441: return $latex_language{$code};
4442: }
4443:
4444: =pod
4445:
4446: =item * &latexhyphenation()
4447:
4448: Same as above but what's supplied is the language as it might be stored
4449: in the metadata.
4450:
4451: =cut
4452:
4453: sub latexhyphenation {
4454: my $key = shift;
4455: return $latex_language_bykey{$key};
4456: }
4457:
4458: =pod
4459:
1.648 raeburn 4460: =item * ©rightids()
1.112 bowersj2 4461:
4462: returns list of all copyrights
4463:
4464: =cut
4465:
4466: sub copyrightids {
4467: return sort(keys(%cprtag));
4468: }
4469:
4470: =pod
4471:
1.648 raeburn 4472: =item * ©rightdescription()
1.112 bowersj2 4473:
4474: returns description of a specified copyright id
4475:
4476: =cut
4477:
4478: sub copyrightdescription {
1.166 www 4479: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4480: }
1.197 matthew 4481:
4482: =pod
4483:
1.648 raeburn 4484: =item * &source_copyrightids()
1.192 taceyjo1 4485:
4486: returns list of all source copyrights
4487:
4488: =cut
4489:
4490: sub source_copyrightids {
4491: return sort(keys(%scprtag));
4492: }
4493:
4494: =pod
4495:
1.648 raeburn 4496: =item * &source_copyrightdescription()
1.192 taceyjo1 4497:
4498: returns description of a specified source copyright id
4499:
4500: =cut
4501:
4502: sub source_copyrightdescription {
4503: return &mt($scprtag{shift(@_)});
4504: }
1.112 bowersj2 4505:
4506: =pod
4507:
1.648 raeburn 4508: =item * &filecategories()
1.112 bowersj2 4509:
4510: returns list of all file categories
4511:
4512: =cut
4513:
4514: sub filecategories {
4515: return sort(keys(%category_extensions));
4516: }
4517:
4518: =pod
4519:
1.648 raeburn 4520: =item * &filecategorytypes()
1.112 bowersj2 4521:
4522: returns list of file types belonging to a given file
4523: category
4524:
4525: =cut
4526:
4527: sub filecategorytypes {
1.356 albertel 4528: my ($cat) = @_;
1.1248 raeburn 4529: if (ref($category_extensions{lc($cat)}) eq 'ARRAY') {
4530: return @{$category_extensions{lc($cat)}};
4531: } else {
4532: return ();
4533: }
1.112 bowersj2 4534: }
4535:
4536: =pod
4537:
1.648 raeburn 4538: =item * &fileembstyle()
1.112 bowersj2 4539:
4540: returns embedding style for a specified file type
4541:
4542: =cut
4543:
4544: sub fileembstyle {
4545: return $fe{lc(shift(@_))};
1.169 www 4546: }
4547:
1.351 www 4548: sub filemimetype {
4549: return $fm{lc(shift(@_))};
4550: }
4551:
1.169 www 4552:
4553: sub filecategoryselect {
4554: my ($name,$value)=@_;
1.189 matthew 4555: return &select_form($value,$name,
1.970 raeburn 4556: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4557: }
4558:
4559: =pod
4560:
1.648 raeburn 4561: =item * &filedescription()
1.112 bowersj2 4562:
4563: returns description for a specified file type
4564:
4565: =cut
4566:
4567: sub filedescription {
1.188 matthew 4568: my $file_description = $fd{lc(shift())};
4569: $file_description =~ s:([\[\]]):~$1:g;
4570: return &mt($file_description);
1.112 bowersj2 4571: }
4572:
4573: =pod
4574:
1.648 raeburn 4575: =item * &filedescriptionex()
1.112 bowersj2 4576:
4577: returns description for a specified file type with
4578: extra formatting
4579:
4580: =cut
4581:
4582: sub filedescriptionex {
4583: my $ex=shift;
1.188 matthew 4584: my $file_description = $fd{lc($ex)};
4585: $file_description =~ s:([\[\]]):~$1:g;
4586: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4587: }
4588:
4589: # End of .tab access
4590: =pod
4591:
4592: =back
4593:
4594: =cut
4595:
4596: # ------------------------------------------------------------------ File Types
4597: sub fileextensions {
4598: return sort(keys(%fe));
4599: }
4600:
1.97 www 4601: # ----------------------------------------------------------- Display Languages
4602: # returns a hash with all desired display languages
4603: #
4604:
4605: sub display_languages {
4606: my %languages=();
1.695 raeburn 4607: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4608: $languages{$lang}=1;
1.97 www 4609: }
4610: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4611: if ($env{'form.displaylanguage'}) {
1.356 albertel 4612: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4613: $languages{$lang}=1;
1.97 www 4614: }
4615: }
4616: return %languages;
1.14 harris41 4617: }
4618:
1.582 albertel 4619: sub languages {
4620: my ($possible_langs) = @_;
1.695 raeburn 4621: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4622: if (!ref($possible_langs)) {
4623: if( wantarray ) {
4624: return @preferred_langs;
4625: } else {
4626: return $preferred_langs[0];
4627: }
4628: }
4629: my %possibilities = map { $_ => 1 } (@$possible_langs);
4630: my @preferred_possibilities;
4631: foreach my $preferred_lang (@preferred_langs) {
4632: if (exists($possibilities{$preferred_lang})) {
4633: push(@preferred_possibilities, $preferred_lang);
4634: }
4635: }
4636: if( wantarray ) {
4637: return @preferred_possibilities;
4638: }
4639: return $preferred_possibilities[0];
4640: }
4641:
1.742 raeburn 4642: sub user_lang {
4643: my ($touname,$toudom,$fromcid) = @_;
4644: my @userlangs;
4645: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4646: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4647: $env{'course.'.$fromcid.'.languages'}));
4648: } else {
4649: my %langhash = &getlangs($touname,$toudom);
4650: if ($langhash{'languages'} ne '') {
4651: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4652: } else {
4653: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4654: if ($domdefs{'lang_def'} ne '') {
4655: @userlangs = ($domdefs{'lang_def'});
4656: }
4657: }
4658: }
4659: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4660: my $user_lh = Apache::localize->get_handle(@languages);
4661: return $user_lh;
4662: }
4663:
4664:
1.112 bowersj2 4665: ###############################################################
4666: ## Student Answer Attempts ##
4667: ###############################################################
4668:
4669: =pod
4670:
4671: =head1 Alternate Problem Views
4672:
4673: =over 4
4674:
1.648 raeburn 4675: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 raeburn 4676: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4677:
4678: Return string with previous attempt on problem. Arguments:
4679:
4680: =over 4
4681:
4682: =item * $symb: Problem, including path
4683:
4684: =item * $username: username of the desired student
4685:
4686: =item * $domain: domain of the desired student
1.14 harris41 4687:
1.112 bowersj2 4688: =item * $course: Course ID
1.14 harris41 4689:
1.112 bowersj2 4690: =item * $getattempt: Leave blank for all attempts, otherwise put
4691: something
1.14 harris41 4692:
1.112 bowersj2 4693: =item * $regexp: if string matches this regexp, the string will be
4694: sent to $gradesub
1.14 harris41 4695:
1.112 bowersj2 4696: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4697:
1.1199 raeburn 4698: =item * $usec: section of the desired student
4699:
4700: =item * $identifier: counter for student (multiple students one problem) or
4701: problem (one student; whole sequence).
4702:
1.112 bowersj2 4703: =back
1.14 harris41 4704:
1.112 bowersj2 4705: The output string is a table containing all desired attempts, if any.
1.16 harris41 4706:
1.112 bowersj2 4707: =cut
1.1 albertel 4708:
4709: sub get_previous_attempt {
1.1199 raeburn 4710: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4711: my $prevattempts='';
1.43 ng 4712: no strict 'refs';
1.1 albertel 4713: if ($symb) {
1.3 albertel 4714: my (%returnhash)=
4715: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4716: if ($returnhash{'version'}) {
4717: my %lasthash=();
4718: my $version;
4719: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1212 raeburn 4720: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4721: if ($key =~ /\.rawrndseed$/) {
4722: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4723: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4724: } else {
4725: $lasthash{$key}=$returnhash{$version.':'.$key};
4726: }
1.19 harris41 4727: }
1.1 albertel 4728: }
1.596 albertel 4729: $prevattempts=&start_data_table().&start_data_table_header_row();
4730: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 raeburn 4731: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4732: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4733: foreach my $key (sort(keys(%lasthash))) {
4734: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4735: if ($#parts > 0) {
1.31 albertel 4736: my $data=$parts[-1];
1.989 raeburn 4737: next if ($data eq 'foilorder');
1.31 albertel 4738: pop(@parts);
1.1010 www 4739: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4740: if ($data eq 'type') {
4741: unless ($showsurv) {
4742: my $id = join(',',@parts);
4743: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4744: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4745: $lasthidden{$ign.'.'.$id} = 1;
4746: }
1.945 raeburn 4747: }
1.1199 raeburn 4748: if ($identifier ne '') {
4749: my $id = join(',',@parts);
4750: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4751: $domain,$username,$usec,undef,$course) =~ /^no/) {
4752: $hidestatus{$ign.'.'.$id} = 1;
4753: }
4754: }
4755: } elsif ($data eq 'regrader') {
4756: if (($identifier ne '') && (@parts)) {
1.1200 raeburn 4757: my $id = join(',',@parts);
4758: $regraded{$ign.'.'.$id} = 1;
1.1199 raeburn 4759: }
1.1010 www 4760: }
1.31 albertel 4761: } else {
1.41 ng 4762: if ($#parts == 0) {
4763: $prevattempts.='<th>'.$parts[0].'</th>';
4764: } else {
4765: $prevattempts.='<th>'.$ign.'</th>';
4766: }
1.31 albertel 4767: }
1.16 harris41 4768: }
1.596 albertel 4769: $prevattempts.=&end_data_table_header_row();
1.40 ng 4770: if ($getattempt eq '') {
1.1199 raeburn 4771: my (%solved,%resets,%probstatus);
1.1200 raeburn 4772: if (($identifier ne '') && (keys(%regraded) > 0)) {
4773: for ($version=1;$version<=$returnhash{'version'};$version++) {
4774: foreach my $id (keys(%regraded)) {
4775: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4776: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4777: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4778: push(@{$resets{$id}},$version);
1.1199 raeburn 4779: }
4780: }
4781: }
1.1200 raeburn 4782: }
4783: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 raeburn 4784: my (@hidden,@unsolved);
1.945 raeburn 4785: if (%typeparts) {
4786: foreach my $id (keys(%typeparts)) {
1.1199 raeburn 4787: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4788: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4789: push(@hidden,$id);
1.1199 raeburn 4790: } elsif ($identifier ne '') {
4791: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4792: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4793: ($hidestatus{$id})) {
1.1200 raeburn 4794: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
1.1199 raeburn 4795: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4796: push(@{$solved{$id}},$version);
4797: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4798: (ref($solved{$id}) eq 'ARRAY')) {
4799: my $skip;
4800: if (ref($resets{$id}) eq 'ARRAY') {
4801: foreach my $reset (@{$resets{$id}}) {
4802: if ($reset > $solved{$id}[-1]) {
4803: $skip=1;
4804: last;
4805: }
4806: }
4807: }
4808: unless ($skip) {
4809: my ($ign,$partslist) = split(/\./,$id,2);
4810: push(@unsolved,$partslist);
4811: }
4812: }
4813: }
1.945 raeburn 4814: }
4815: }
4816: }
4817: $prevattempts.=&start_data_table_row().
1.1199 raeburn 4818: '<td>'.&mt('Transaction [_1]',$version);
4819: if (@unsolved) {
4820: $prevattempts .= '<span class="LC_nobreak"><label>'.
4821: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4822: &mt('Hide').'</label></span>';
4823: }
4824: $prevattempts .= '</td>';
1.945 raeburn 4825: if (@hidden) {
4826: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4827: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4828: my $hide;
4829: foreach my $id (@hidden) {
4830: if ($key =~ /^\Q$id\E/) {
4831: $hide = 1;
4832: last;
4833: }
4834: }
4835: if ($hide) {
4836: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4837: if (($data eq 'award') || ($data eq 'awarddetail')) {
4838: my $value = &format_previous_attempt_value($key,
4839: $returnhash{$version.':'.$key});
1.1173 kruse 4840: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4841: } else {
4842: $prevattempts.='<td> </td>';
4843: }
4844: } else {
4845: if ($key =~ /\./) {
1.1212 raeburn 4846: my $value = $returnhash{$version.':'.$key};
4847: if ($key =~ /\.rndseed$/) {
4848: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4849: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4850: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4851: }
4852: }
4853: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4854: ' </td>';
1.945 raeburn 4855: } else {
4856: $prevattempts.='<td> </td>';
4857: }
4858: }
4859: }
4860: } else {
4861: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4862: next if ($key =~ /\.foilorder$/);
1.1212 raeburn 4863: my $value = $returnhash{$version.':'.$key};
4864: if ($key =~ /\.rndseed$/) {
4865: my ($id) = ($key =~ /^(.+)\.[^.]+$/);
4866: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4867: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4868: }
4869: }
4870: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4871: ' </td>';
1.945 raeburn 4872: }
4873: }
4874: $prevattempts.=&end_data_table_row();
1.40 ng 4875: }
1.1 albertel 4876: }
1.945 raeburn 4877: my @currhidden = keys(%lasthidden);
1.596 albertel 4878: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4879: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4880: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4881: if (%typeparts) {
4882: my $hidden;
4883: foreach my $id (@currhidden) {
4884: if ($key =~ /^\Q$id\E/) {
4885: $hidden = 1;
4886: last;
4887: }
4888: }
4889: if ($hidden) {
4890: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4891: if (($data eq 'award') || ($data eq 'awarddetail')) {
4892: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4893: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4894: $value = &$gradesub($value);
4895: }
1.1173 kruse 4896: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 4897: } else {
4898: $prevattempts.='<td> </td>';
4899: }
4900: } else {
4901: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4902: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4903: $value = &$gradesub($value);
4904: }
1.1173 kruse 4905: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4906: }
4907: } else {
4908: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4909: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4910: $value = &$gradesub($value);
4911: }
1.1173 kruse 4912: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 4913: }
1.16 harris41 4914: }
1.596 albertel 4915: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4916: } else {
1.1305 raeburn 4917: my $msg;
4918: if ($symb =~ /ext\.tool$/) {
4919: $msg = &mt('No grade passed back.');
4920: } else {
4921: $msg = &mt('Nothing submitted - no attempts.');
4922: }
1.596 albertel 4923: $prevattempts=
4924: &start_data_table().&start_data_table_row().
1.1305 raeburn 4925: '<td>'.$msg.'</td>'.
1.596 albertel 4926: &end_data_table_row().&end_data_table();
1.1 albertel 4927: }
4928: } else {
1.596 albertel 4929: $prevattempts=
4930: &start_data_table().&start_data_table_row().
4931: '<td>'.&mt('No data.').'</td>'.
4932: &end_data_table_row().&end_data_table();
1.1 albertel 4933: }
1.10 albertel 4934: }
4935:
1.581 albertel 4936: sub format_previous_attempt_value {
4937: my ($key,$value) = @_;
1.1011 www 4938: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4939: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4940: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4941: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4942: } elsif ($key =~ /answerstring$/) {
4943: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4944: my @answer = %answers;
4945: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4946: my @anskeys = sort(keys(%answers));
4947: if (@anskeys == 1) {
4948: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4949: if ($answer =~ m{\0}) {
4950: $answer =~ s{\0}{,}g;
1.988 raeburn 4951: }
4952: my $tag_internal_answer_name = 'INTERNAL';
4953: if ($anskeys[0] eq $tag_internal_answer_name) {
4954: $value = $answer;
4955: } else {
4956: $value = $anskeys[0].'='.$answer;
4957: }
4958: } else {
4959: foreach my $ans (@anskeys) {
4960: my $answer = $answers{$ans};
1.1001 raeburn 4961: if ($answer =~ m{\0}) {
4962: $answer =~ s{\0}{,}g;
1.988 raeburn 4963: }
4964: $value .= $ans.'='.$answer.'<br />';;
4965: }
4966: }
1.581 albertel 4967: } else {
1.1173 kruse 4968: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4969: }
4970: return $value;
4971: }
4972:
4973:
1.107 albertel 4974: sub relative_to_absolute {
4975: my ($url,$output)=@_;
4976: my $parser=HTML::TokeParser->new(\$output);
4977: my $token;
4978: my $thisdir=$url;
4979: my @rlinks=();
4980: while ($token=$parser->get_token) {
4981: if ($token->[0] eq 'S') {
4982: if ($token->[1] eq 'a') {
4983: if ($token->[2]->{'href'}) {
4984: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4985: }
4986: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4987: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4988: } elsif ($token->[1] eq 'base') {
4989: $thisdir=$token->[2]->{'href'};
4990: }
4991: }
4992: }
4993: $thisdir=~s-/[^/]*$--;
1.356 albertel 4994: foreach my $link (@rlinks) {
1.726 raeburn 4995: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4996: ($link=~/^\//) ||
4997: ($link=~/^javascript:/i) ||
4998: ($link=~/^mailto:/i) ||
4999: ($link=~/^\#/)) {
5000: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
5001: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 5002: }
5003: }
5004: # -------------------------------------------------- Deal with Applet codebases
5005: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
5006: return $output;
5007: }
5008:
1.112 bowersj2 5009: =pod
5010:
1.648 raeburn 5011: =item * &get_student_view()
1.112 bowersj2 5012:
5013: show a snapshot of what student was looking at
5014:
5015: =cut
5016:
1.10 albertel 5017: sub get_student_view {
1.186 albertel 5018: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 5019: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5020: my (%form);
1.10 albertel 5021: my @elements=('symb','courseid','domain','username');
5022: foreach my $element (@elements) {
1.186 albertel 5023: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5024: }
1.186 albertel 5025: if (defined($moreenv)) {
5026: %form=(%form,%{$moreenv});
5027: }
1.236 albertel 5028: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 5029: $feedurl=&Apache::lonnet::clutter($feedurl);
1.1306 raeburn 5030: if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
5031: $feedurl =~ s{^/adm/wrapper}{};
5032: }
1.650 www 5033: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 5034: $userview=~s/\<body[^\>]*\>//gi;
5035: $userview=~s/\<\/body\>//gi;
5036: $userview=~s/\<html\>//gi;
5037: $userview=~s/\<\/html\>//gi;
5038: $userview=~s/\<head\>//gi;
5039: $userview=~s/\<\/head\>//gi;
5040: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 5041: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 5042: if (wantarray) {
5043: return ($userview,$response);
5044: } else {
5045: return $userview;
5046: }
5047: }
5048:
5049: sub get_student_view_with_retries {
5050: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
5051:
5052: my $ok = 0; # True if we got a good response.
5053: my $content;
5054: my $response;
5055:
5056: # Try to get the student_view done. within the retries count:
5057:
5058: do {
5059: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
5060: $ok = $response->is_success;
5061: if (!$ok) {
5062: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
5063: }
5064: $retries--;
5065: } while (!$ok && ($retries > 0));
5066:
5067: if (!$ok) {
5068: $content = ''; # On error return an empty content.
5069: }
1.651 www 5070: if (wantarray) {
5071: return ($content, $response);
5072: } else {
5073: return $content;
5074: }
1.11 albertel 5075: }
5076:
1.1349 raeburn 5077: sub css_links {
5078: my ($currsymb,$level) = @_;
5079: my ($links,@symbs,%cssrefs,%httpref);
5080: if ($level eq 'map') {
5081: my $navmap = Apache::lonnavmaps::navmap->new();
5082: if (ref($navmap)) {
5083: my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
5084: my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
5085: foreach my $res (@resources) {
5086: if (ref($res) && $res->symb()) {
5087: push(@symbs,$res->symb());
5088: }
5089: }
5090: }
5091: } else {
5092: @symbs = ($currsymb);
5093: }
5094: foreach my $symb (@symbs) {
5095: my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
5096: if ($css_href =~ /\S/) {
5097: unless ($css_href =~ m{https?://}) {
5098: my $url = (&Apache::lonnet::decode_symb($symb))[-1];
5099: my $proburl = &Apache::lonnet::clutter($url);
5100: my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
5101: unless ($css_href =~ m{^/}) {
5102: $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
5103: }
5104: if ($css_href =~ m{^/(res|uploaded)/}) {
5105: unless (($httpref{'httpref.'.$css_href}) ||
5106: (&Apache::lonnet::is_on_map($css_href))) {
5107: my $thisurl = $proburl;
5108: if ($env{'httpref.'.$proburl}) {
5109: $thisurl = $env{'httpref.'.$proburl};
5110: }
5111: $httpref{'httpref.'.$css_href} = $thisurl;
5112: }
5113: }
5114: }
5115: $cssrefs{$css_href} = 1;
5116: }
5117: }
5118: if (keys(%httpref)) {
5119: &Apache::lonnet::appenv(\%httpref);
5120: }
5121: if (keys(%cssrefs)) {
5122: foreach my $css_href (keys(%cssrefs)) {
5123: next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
5124: $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
5125: }
5126: }
5127: return $links;
5128: }
5129:
1.112 bowersj2 5130: =pod
5131:
1.648 raeburn 5132: =item * &get_student_answers()
1.112 bowersj2 5133:
5134: show a snapshot of how student was answering problem
5135:
5136: =cut
5137:
1.11 albertel 5138: sub get_student_answers {
1.100 sakharuk 5139: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 5140: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 5141: my (%moreenv);
1.11 albertel 5142: my @elements=('symb','courseid','domain','username');
5143: foreach my $element (@elements) {
1.186 albertel 5144: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 5145: }
1.186 albertel 5146: $moreenv{'grade_target'}='answer';
5147: %moreenv=(%form,%moreenv);
1.497 raeburn 5148: $feedurl = &Apache::lonnet::clutter($feedurl);
5149: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 5150: return $userview;
1.1 albertel 5151: }
1.116 albertel 5152:
5153: =pod
5154:
5155: =item * &submlink()
5156:
1.242 albertel 5157: Inputs: $text $uname $udom $symb $target
1.116 albertel 5158:
5159: Returns: A link to grades.pm such as to see the SUBM view of a student
5160:
5161: =cut
5162:
5163: ###############################################
5164: sub submlink {
1.242 albertel 5165: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 5166: if (!($uname && $udom)) {
5167: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5168: &Apache::lonnet::whichuser($symb);
1.116 albertel 5169: if (!$symb) { $symb=$cursymb; }
5170: }
1.254 matthew 5171: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5172: $symb=&escape($symb);
1.960 bisitz 5173: if ($target) { $target=" target=\"$target\""; }
5174: return
5175: '<a href="/adm/grades?command=submission'.
5176: '&symb='.$symb.
5177: '&student='.$uname.
5178: '&userdom='.$udom.'"'.
5179: $target.'>'.$text.'</a>';
1.242 albertel 5180: }
5181: ##############################################
5182:
5183: =pod
5184:
5185: =item * &pgrdlink()
5186:
5187: Inputs: $text $uname $udom $symb $target
5188:
5189: Returns: A link to grades.pm such as to see the PGRD view of a student
5190:
5191: =cut
5192:
5193: ###############################################
5194: sub pgrdlink {
5195: my $link=&submlink(@_);
5196: $link=~s/(&command=submission)/$1&showgrading=yes/;
5197: return $link;
5198: }
5199: ##############################################
5200:
5201: =pod
5202:
5203: =item * &pprmlink()
5204:
5205: Inputs: $text $uname $udom $symb $target
5206:
5207: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 5208: student and a specific resource
1.242 albertel 5209:
5210: =cut
5211:
5212: ###############################################
5213: sub pprmlink {
5214: my ($text,$uname,$udom,$symb,$target)=@_;
5215: if (!($uname && $udom)) {
5216: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 5217: &Apache::lonnet::whichuser($symb);
1.242 albertel 5218: if (!$symb) { $symb=$cursymb; }
5219: }
1.254 matthew 5220: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 5221: $symb=&escape($symb);
1.242 albertel 5222: if ($target) { $target="target=\"$target\""; }
1.595 albertel 5223: return '<a href="/adm/parmset?command=set&'.
5224: 'symb='.$symb.'&uname='.$uname.
5225: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 5226: }
5227: ##############################################
1.37 matthew 5228:
1.112 bowersj2 5229: =pod
5230:
5231: =back
5232:
5233: =cut
5234:
1.37 matthew 5235: ###############################################
1.51 www 5236:
5237:
5238: sub timehash {
1.687 raeburn 5239: my ($thistime) = @_;
5240: my $timezone = &Apache::lonlocal::gettimezone();
5241: my $dt = DateTime->from_epoch(epoch => $thistime)
5242: ->set_time_zone($timezone);
5243: my $wday = $dt->day_of_week();
5244: if ($wday == 7) { $wday = 0; }
5245: return ( 'second' => $dt->second(),
5246: 'minute' => $dt->minute(),
5247: 'hour' => $dt->hour(),
5248: 'day' => $dt->day_of_month(),
5249: 'month' => $dt->month(),
5250: 'year' => $dt->year(),
5251: 'weekday' => $wday,
5252: 'dayyear' => $dt->day_of_year(),
5253: 'dlsav' => $dt->is_dst() );
1.51 www 5254: }
5255:
1.370 www 5256: sub utc_string {
5257: my ($date)=@_;
1.371 www 5258: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 5259: }
5260:
1.51 www 5261: sub maketime {
5262: my %th=@_;
1.687 raeburn 5263: my ($epoch_time,$timezone,$dt);
5264: $timezone = &Apache::lonlocal::gettimezone();
5265: eval {
5266: $dt = DateTime->new( year => $th{'year'},
5267: month => $th{'month'},
5268: day => $th{'day'},
5269: hour => $th{'hour'},
5270: minute => $th{'minute'},
5271: second => $th{'second'},
5272: time_zone => $timezone,
5273: );
5274: };
5275: if (!$@) {
5276: $epoch_time = $dt->epoch;
5277: if ($epoch_time) {
5278: return $epoch_time;
5279: }
5280: }
1.51 www 5281: return POSIX::mktime(
5282: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 5283: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 5284: }
5285:
5286: #########################################
1.51 www 5287:
5288: sub findallcourses {
1.482 raeburn 5289: my ($roles,$uname,$udom) = @_;
1.355 albertel 5290: my %roles;
5291: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 5292: my %courses;
1.51 www 5293: my $now=time;
1.482 raeburn 5294: if (!defined($uname)) {
5295: $uname = $env{'user.name'};
5296: }
5297: if (!defined($udom)) {
5298: $udom = $env{'user.domain'};
5299: }
5300: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 5301: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 5302: if (!%roles) {
5303: %roles = (
5304: cc => 1,
1.907 raeburn 5305: co => 1,
1.482 raeburn 5306: in => 1,
5307: ep => 1,
5308: ta => 1,
5309: cr => 1,
5310: st => 1,
5311: );
5312: }
5313: foreach my $entry (keys(%roleshash)) {
5314: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
5315: if ($trole =~ /^cr/) {
5316: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
5317: } else {
5318: next if (!exists($roles{$trole}));
5319: }
5320: if ($tend) {
5321: next if ($tend < $now);
5322: }
5323: if ($tstart) {
5324: next if ($tstart > $now);
5325: }
1.1058 raeburn 5326: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 5327: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 5328: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 5329: if ($secpart eq '') {
5330: ($cnum,$role) = split(/_/,$cnumpart);
5331: $sec = 'none';
1.1058 raeburn 5332: $value .= $cnum.'/';
1.482 raeburn 5333: } else {
5334: $cnum = $cnumpart;
5335: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 5336: $value .= $cnum.'/'.$sec;
5337: }
5338: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5339: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5340: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5341: }
5342: } else {
5343: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 5344: }
1.482 raeburn 5345: }
5346: } else {
5347: foreach my $key (keys(%env)) {
1.483 albertel 5348: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
5349: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 5350: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
5351: next if ($role eq 'ca' || $role eq 'aa');
5352: next if (%roles && !exists($roles{$role}));
5353: my ($starttime,$endtime)=split(/\./,$env{$key});
5354: my $active=1;
5355: if ($starttime) {
5356: if ($now<$starttime) { $active=0; }
5357: }
5358: if ($endtime) {
5359: if ($now>$endtime) { $active=0; }
5360: }
5361: if ($active) {
1.1058 raeburn 5362: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 5363: if ($sec eq '') {
5364: $sec = 'none';
1.1058 raeburn 5365: } else {
5366: $value .= $sec;
5367: }
5368: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5369: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5370: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5371: }
5372: } else {
5373: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 5374: }
1.474 raeburn 5375: }
5376: }
1.51 www 5377: }
5378: }
1.474 raeburn 5379: return %courses;
1.51 www 5380: }
1.37 matthew 5381:
1.54 www 5382: ###############################################
1.474 raeburn 5383:
5384: sub blockcheck {
1.1372 raeburn 5385: my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
5386: unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
5387: my ($has_evb,$check_ipaccess);
5388: my $dom = $env{'user.domain'};
5389: if ($env{'request.course.id'}) {
5390: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5391: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
5392: my $checkrole = "cm./$cdom/$cnum";
5393: my $sec = $env{'request.course.sec'};
5394: if ($sec ne '') {
5395: $checkrole .= "/$sec";
5396: }
5397: if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
5398: ($env{'request.role'} !~ /^st/)) {
5399: $has_evb = 1;
5400: }
5401: unless ($has_evb) {
5402: if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
5403: ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
5404: if ($udom eq $cdom) {
5405: $check_ipaccess = 1;
5406: }
5407: }
5408: }
1.1375 raeburn 5409: } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
5410: ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
5411: my $checkrole;
5412: if ($env{'request.role.domain'} eq '') {
5413: $checkrole = "cm./$env{'user.domain'}/";
5414: } else {
5415: $checkrole = "cm./$env{'request.role.domain'}/";
5416: }
5417: if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
5418: $has_evb = 1;
5419: }
1.1372 raeburn 5420: }
5421: unless ($has_evb || $check_ipaccess) {
5422: my @machinedoms = &Apache::lonnet::current_machine_domains();
5423: if (($dom eq 'public') && ($activity eq 'port')) {
5424: $dom = $udom;
5425: }
5426: if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
5427: $check_ipaccess = 1;
5428: } else {
5429: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
5430: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
5431: my $prim = &Apache::lonnet::domain($dom,'primary');
5432: my $intdom = &Apache::lonnet::internet_dom($prim);
5433: if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
5434: if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
5435: $check_ipaccess = 1;
5436: }
5437: }
5438: }
5439: }
5440: if ($check_ipaccess) {
5441: my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
5442: unless (defined($cached)) {
5443: my %domconfig =
5444: &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
5445: $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
5446: }
5447: if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
5448: foreach my $id (keys(%{$ipaccessref})) {
5449: if (ref($ipaccessref->{$id}) eq 'HASH') {
5450: my $range = $ipaccessref->{$id}->{'ip'};
5451: if ($range) {
5452: if (&Apache::lonnet::ip_match($clientip,$range)) {
5453: if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
5454: if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
5455: return ('','','',$id,$dom);
5456: last;
5457: }
5458: }
5459: }
5460: }
5461: }
5462: }
5463: }
5464: }
1.1373 raeburn 5465: if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5466: return ();
5467: }
1.1372 raeburn 5468: }
1.1189 raeburn 5469: if (defined($udom) && defined($uname)) {
5470: # If uname and udom are for a course, check for blocks in the course.
5471: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5472: my ($startblock,$endblock,$triggerblock) =
1.1347 raeburn 5473: &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1189 raeburn 5474: return ($startblock,$endblock,$triggerblock);
5475: }
5476: } else {
1.490 raeburn 5477: $udom = $env{'user.domain'};
5478: $uname = $env{'user.name'};
5479: }
5480:
1.502 raeburn 5481: my $startblock = 0;
5482: my $endblock = 0;
1.1062 raeburn 5483: my $triggerblock = '';
1.1373 raeburn 5484: my %live_courses;
5485: unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5486: %live_courses = &findallcourses(undef,$uname,$udom);
5487: }
1.474 raeburn 5488:
1.490 raeburn 5489: # If uname is for a user, and activity is course-specific, i.e.,
5490: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5491:
1.490 raeburn 5492: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1282 raeburn 5493: $activity eq 'groups' || $activity eq 'printout' ||
1.1346 raeburn 5494: $activity eq 'search' || $activity eq 'reinit' ||
5495: $activity eq 'alert') &&
1.1189 raeburn 5496: ($env{'request.course.id'})) {
1.490 raeburn 5497: foreach my $key (keys(%live_courses)) {
5498: if ($key ne $env{'request.course.id'}) {
5499: delete($live_courses{$key});
5500: }
5501: }
5502: }
5503:
5504: my $otheruser = 0;
5505: my %own_courses;
5506: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5507: # Resource belongs to user other than current user.
5508: $otheruser = 1;
5509: # Gather courses for current user
5510: %own_courses =
5511: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5512: }
5513:
5514: # Gather active course roles - course coordinator, instructor,
5515: # exam proctor, ta, student, or custom role.
1.474 raeburn 5516:
5517: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5518: my ($cdom,$cnum);
5519: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5520: $cdom = $env{'course.'.$course.'.domain'};
5521: $cnum = $env{'course.'.$course.'.num'};
5522: } else {
1.490 raeburn 5523: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5524: }
5525: my $no_ownblock = 0;
5526: my $no_userblock = 0;
1.533 raeburn 5527: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5528: # Check if current user has 'evb' priv for this
5529: if (defined($own_courses{$course})) {
5530: foreach my $sec (keys(%{$own_courses{$course}})) {
5531: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5532: if ($sec ne 'none') {
5533: $checkrole .= '/'.$sec;
5534: }
5535: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5536: $no_ownblock = 1;
5537: last;
5538: }
5539: }
5540: }
5541: # if they have 'evb' priv and are currently not playing student
5542: next if (($no_ownblock) &&
5543: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5544: }
1.474 raeburn 5545: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5546: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5547: if ($sec ne 'none') {
1.482 raeburn 5548: $checkrole .= '/'.$sec;
1.474 raeburn 5549: }
1.490 raeburn 5550: if ($otheruser) {
5551: # Resource belongs to user other than current user.
5552: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5553: my (%allroles,%userroles);
5554: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5555: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5556: my ($trole,$tdom,$tnum,$tsec);
5557: if ($entry =~ /^cr/) {
5558: ($trole,$tdom,$tnum,$tsec) =
5559: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5560: } else {
5561: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5562: }
5563: my ($spec,$area,$trest);
5564: $area = '/'.$tdom.'/'.$tnum;
5565: $trest = $tnum;
5566: if ($tsec ne '') {
5567: $area .= '/'.$tsec;
5568: $trest .= '/'.$tsec;
5569: }
5570: $spec = $trole.'.'.$area;
5571: if ($trole =~ /^cr/) {
5572: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5573: $tdom,$spec,$trest,$area);
5574: } else {
5575: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5576: $tdom,$spec,$trest,$area);
5577: }
5578: }
1.1276 raeburn 5579: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5580: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5581: if ($1) {
5582: $no_userblock = 1;
5583: last;
5584: }
1.486 raeburn 5585: }
5586: }
1.490 raeburn 5587: } else {
5588: # Resource belongs to current user
5589: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5590: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5591: $no_ownblock = 1;
5592: last;
5593: }
1.474 raeburn 5594: }
5595: }
5596: # if they have the evb priv and are currently not playing student
1.482 raeburn 5597: next if (($no_ownblock) &&
1.491 albertel 5598: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5599: next if ($no_userblock);
1.474 raeburn 5600:
1.1303 raeburn 5601: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5602: # of specified user, unless user has 'evb' privilege.
1.1284 raeburn 5603:
1.1062 raeburn 5604: my ($start,$end,$trigger) =
1.1347 raeburn 5605: &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502 raeburn 5606: if (($start != 0) &&
5607: (($startblock == 0) || ($startblock > $start))) {
5608: $startblock = $start;
1.1062 raeburn 5609: if ($trigger ne '') {
5610: $triggerblock = $trigger;
5611: }
1.502 raeburn 5612: }
5613: if (($end != 0) &&
5614: (($endblock == 0) || ($endblock < $end))) {
5615: $endblock = $end;
1.1062 raeburn 5616: if ($trigger ne '') {
5617: $triggerblock = $trigger;
5618: }
1.502 raeburn 5619: }
1.490 raeburn 5620: }
1.1062 raeburn 5621: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5622: }
5623:
5624: sub get_blocks {
1.1347 raeburn 5625: my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490 raeburn 5626: my $startblock = 0;
5627: my $endblock = 0;
1.1062 raeburn 5628: my $triggerblock = '';
1.490 raeburn 5629: my $course = $cdom.'_'.$cnum;
5630: $setters->{$course} = {};
5631: $setters->{$course}{'staff'} = [];
5632: $setters->{$course}{'times'} = [];
1.1062 raeburn 5633: $setters->{$course}{'triggers'} = [];
5634: my (@blockers,%triggered);
5635: my $now = time;
5636: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5637: if ($activity eq 'docs') {
1.1348 raeburn 5638: my ($blocked,$nosymbcache,$noenccheck);
1.1347 raeburn 5639: if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
5640: $blocked = 1;
5641: $nosymbcache = 1;
1.1348 raeburn 5642: $noenccheck = 1;
1.1347 raeburn 5643: }
1.1348 raeburn 5644: @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062 raeburn 5645: foreach my $block (@blockers) {
5646: if ($block =~ /^firstaccess____(.+)$/) {
5647: my $item = $1;
5648: my $type = 'map';
5649: my $timersymb = $item;
5650: if ($item eq 'course') {
5651: $type = 'course';
5652: } elsif ($item =~ /___\d+___/) {
5653: $type = 'resource';
5654: } else {
5655: $timersymb = &Apache::lonnet::symbread($item);
5656: }
5657: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5658: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5659: $triggered{$block} = {
5660: start => $start,
5661: end => $end,
5662: type => $type,
5663: };
5664: }
5665: }
5666: } else {
5667: foreach my $block (keys(%commblocks)) {
5668: if ($block =~ m/^(\d+)____(\d+)$/) {
5669: my ($start,$end) = ($1,$2);
5670: if ($start <= time && $end >= time) {
5671: if (ref($commblocks{$block}) eq 'HASH') {
5672: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5673: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5674: unless(grep(/^\Q$block\E$/,@blockers)) {
5675: push(@blockers,$block);
5676: }
5677: }
5678: }
5679: }
5680: }
5681: } elsif ($block =~ /^firstaccess____(.+)$/) {
5682: my $item = $1;
5683: my $timersymb = $item;
5684: my $type = 'map';
5685: if ($item eq 'course') {
5686: $type = 'course';
5687: } elsif ($item =~ /___\d+___/) {
5688: $type = 'resource';
5689: } else {
5690: $timersymb = &Apache::lonnet::symbread($item);
5691: }
5692: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5693: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5694: if ($start && $end) {
5695: if (($start <= time) && ($end >= time)) {
1.1281 raeburn 5696: if (ref($commblocks{$block}) eq 'HASH') {
5697: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5698: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5699: unless(grep(/^\Q$block\E$/,@blockers)) {
5700: push(@blockers,$block);
5701: $triggered{$block} = {
5702: start => $start,
5703: end => $end,
5704: type => $type,
5705: };
5706: }
5707: }
5708: }
1.1062 raeburn 5709: }
5710: }
1.490 raeburn 5711: }
1.1062 raeburn 5712: }
5713: }
5714: }
5715: foreach my $blocker (@blockers) {
5716: my ($staff_name,$staff_dom,$title,$blocks) =
5717: &parse_block_record($commblocks{$blocker});
5718: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5719: my ($start,$end,$triggertype);
5720: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5721: ($start,$end) = ($1,$2);
5722: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5723: $start = $triggered{$blocker}{'start'};
5724: $end = $triggered{$blocker}{'end'};
5725: $triggertype = $triggered{$blocker}{'type'};
5726: }
5727: if ($start) {
5728: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5729: if ($triggertype) {
5730: push(@{$$setters{$course}{'triggers'}},$triggertype);
5731: } else {
5732: push(@{$$setters{$course}{'triggers'}},0);
5733: }
5734: if ( ($startblock == 0) || ($startblock > $start) ) {
5735: $startblock = $start;
5736: if ($triggertype) {
5737: $triggerblock = $blocker;
1.474 raeburn 5738: }
5739: }
1.1062 raeburn 5740: if ( ($endblock == 0) || ($endblock < $end) ) {
5741: $endblock = $end;
5742: if ($triggertype) {
5743: $triggerblock = $blocker;
5744: }
5745: }
1.474 raeburn 5746: }
5747: }
1.1062 raeburn 5748: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5749: }
5750:
5751: sub parse_block_record {
5752: my ($record) = @_;
5753: my ($setuname,$setudom,$title,$blocks);
5754: if (ref($record) eq 'HASH') {
5755: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5756: $title = &unescape($record->{'event'});
5757: $blocks = $record->{'blocks'};
5758: } else {
5759: my @data = split(/:/,$record,3);
5760: if (scalar(@data) eq 2) {
5761: $title = $data[1];
5762: ($setuname,$setudom) = split(/@/,$data[0]);
5763: } else {
5764: ($setuname,$setudom,$title) = @data;
5765: }
5766: $blocks = { 'com' => 'on' };
5767: }
5768: return ($setuname,$setudom,$title,$blocks);
5769: }
5770:
1.854 kalberla 5771: sub blocking_status {
1.1372 raeburn 5772: my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061 raeburn 5773: my %setters;
1.890 droeschl 5774:
1.1061 raeburn 5775: # check for active blocking
1.1372 raeburn 5776: if ($clientip eq '') {
5777: $clientip = &Apache::lonnet::get_requestor_ip();
5778: }
5779: my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
5780: &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062 raeburn 5781: my $blocked = 0;
1.1372 raeburn 5782: if (($startblock && $endblock) || ($by_ip)) {
1.1062 raeburn 5783: $blocked = 1;
5784: }
1.890 droeschl 5785:
1.1061 raeburn 5786: # caller just wants to know whether a block is active
5787: if (!wantarray) { return $blocked; }
5788:
5789: # build a link to a popup window containing the details
5790: my $querystring = "?activity=$activity";
1.1351 raeburn 5791: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
5792: if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1232 raeburn 5793: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5794: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5795: } elsif ($activity eq 'docs') {
1.1347 raeburn 5796: my $showurl = &Apache::lonenc::check_encrypt($url);
5797: $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
5798: if ($symb) {
5799: my $showsymb = &Apache::lonenc::check_encrypt($symb);
5800: $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
5801: }
1.1062 raeburn 5802: }
1.1061 raeburn 5803:
5804: my $output .= <<'END_MYBLOCK';
5805: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5806: var options = "width=" + w + ",height=" + h + ",";
5807: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5808: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5809: var newWin = window.open(url, wdwName, options);
5810: newWin.focus();
5811: }
1.890 droeschl 5812: END_MYBLOCK
1.854 kalberla 5813:
1.1061 raeburn 5814: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5815:
1.1061 raeburn 5816: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5817: my $text = &mt('Communication Blocked');
1.1217 raeburn 5818: my $class = 'LC_comblock';
1.1062 raeburn 5819: if ($activity eq 'docs') {
5820: $text = &mt('Content Access Blocked');
1.1217 raeburn 5821: $class = '';
1.1063 raeburn 5822: } elsif ($activity eq 'printout') {
5823: $text = &mt('Printing Blocked');
1.1232 raeburn 5824: } elsif ($activity eq 'passwd') {
5825: $text = &mt('Password Changing Blocked');
1.1345 raeburn 5826: } elsif ($activity eq 'grades') {
5827: $text = &mt('Gradebook Blocked');
1.1346 raeburn 5828: } elsif ($activity eq 'search') {
5829: $text = &mt('Search Blocked');
1.1282 raeburn 5830: } elsif ($activity eq 'alert') {
5831: $text = &mt('Checking Critical Messages Blocked');
5832: } elsif ($activity eq 'reinit') {
5833: $text = &mt('Checking Course Update Blocked');
1.1351 raeburn 5834: } elsif ($activity eq 'about') {
5835: $text = &mt('Access to User Information Pages Blocked');
1.1373 raeburn 5836: } elsif ($activity eq 'wishlist') {
5837: $text = &mt('Access to Stored Links Blocked');
5838: } elsif ($activity eq 'annotate') {
5839: $text = &mt('Access to Annotations Blocked');
1.1062 raeburn 5840: }
1.1061 raeburn 5841: $output .= <<"END_BLOCK";
1.1217 raeburn 5842: <div class='$class'>
1.869 kalberla 5843: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5844: title='$text'>
5845: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5846: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5847: title='$text'>$text</a>
1.867 kalberla 5848: </div>
5849:
5850: END_BLOCK
1.474 raeburn 5851:
1.1061 raeburn 5852: return ($blocked, $output);
1.854 kalberla 5853: }
1.490 raeburn 5854:
1.60 matthew 5855: ###############################################
5856:
1.682 raeburn 5857: sub check_ip_acc {
1.1201 raeburn 5858: my ($acc,$clientip)=@_;
1.682 raeburn 5859: &Apache::lonxml::debug("acc is $acc");
5860: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5861: return 1;
5862: }
1.1339 raeburn 5863: my ($ip,$allowed);
5864: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
5865: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
5866: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
5867: } else {
1.1350 raeburn 5868: my $remote_ip = &Apache::lonnet::get_requestor_ip();
5869: $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1339 raeburn 5870: }
1.682 raeburn 5871:
5872: my $name;
1.1219 raeburn 5873: my %access = (
5874: allowfrom => 1,
5875: denyfrom => 0,
5876: );
5877: my @allows;
5878: my @denies;
5879: foreach my $item (split(',',$acc)) {
5880: $item =~ s/^\s*//;
5881: $item =~ s/\s*$//;
5882: my $pattern;
5883: if ($item =~ /^\!(.+)$/) {
5884: push(@denies,$1);
5885: } else {
5886: push(@allows,$item);
5887: }
5888: }
5889: my $numdenies = scalar(@denies);
5890: my $numallows = scalar(@allows);
5891: my $count = 0;
5892: foreach my $pattern (@denies,@allows) {
5893: $count ++;
5894: my $acctype = 'allowfrom';
5895: if ($count <= $numdenies) {
5896: $acctype = 'denyfrom';
5897: }
1.682 raeburn 5898: if ($pattern =~ /\*$/) {
5899: #35.8.*
5900: $pattern=~s/\*//;
1.1219 raeburn 5901: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5902: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5903: #35.8.3.[34-56]
5904: my $low=$2;
5905: my $high=$3;
5906: $pattern=$1;
5907: if ($ip =~ /^\Q$pattern\E/) {
5908: my $last=(split(/\./,$ip))[3];
1.1219 raeburn 5909: if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5910: }
5911: } elsif ($pattern =~ /^\*/) {
5912: #*.msu.edu
5913: $pattern=~s/\*//;
5914: if (!defined($name)) {
5915: use Socket;
5916: my $netaddr=inet_aton($ip);
5917: ($name)=gethostbyaddr($netaddr,AF_INET);
5918: }
1.1219 raeburn 5919: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5920: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5921: #127.0.0.1
1.1219 raeburn 5922: if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5923: } else {
5924: #some.name.com
5925: if (!defined($name)) {
5926: use Socket;
5927: my $netaddr=inet_aton($ip);
5928: ($name)=gethostbyaddr($netaddr,AF_INET);
5929: }
1.1219 raeburn 5930: if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5931: }
5932: if ($allowed =~ /^(0|1)$/) { last; }
5933: }
5934: if ($allowed eq '') {
5935: if ($numdenies && !$numallows) {
5936: $allowed = 1;
5937: } else {
5938: $allowed = 0;
1.682 raeburn 5939: }
5940: }
5941: return $allowed;
5942: }
5943:
5944: ###############################################
5945:
1.60 matthew 5946: =pod
5947:
1.112 bowersj2 5948: =head1 Domain Template Functions
5949:
5950: =over 4
5951:
5952: =item * &determinedomain()
1.60 matthew 5953:
5954: Inputs: $domain (usually will be undef)
5955:
1.63 www 5956: Returns: Determines which domain should be used for designs
1.60 matthew 5957:
5958: =cut
1.54 www 5959:
1.60 matthew 5960: ###############################################
1.63 www 5961: sub determinedomain {
5962: my $domain=shift;
1.531 albertel 5963: if (! $domain) {
1.60 matthew 5964: # Determine domain if we have not been given one
1.893 raeburn 5965: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5966: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5967: if ($env{'request.role.domain'}) {
5968: $domain=$env{'request.role.domain'};
1.60 matthew 5969: }
5970: }
1.63 www 5971: return $domain;
5972: }
5973: ###############################################
1.517 raeburn 5974:
1.518 albertel 5975: sub devalidate_domconfig_cache {
5976: my ($udom)=@_;
5977: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5978: }
5979:
5980: # ---------------------- Get domain configuration for a domain
5981: sub get_domainconf {
5982: my ($udom) = @_;
5983: my $cachetime=1800;
5984: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5985: if (defined($cached)) { return %{$result}; }
5986:
5987: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5988: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5989: my (%designhash,%legacy);
1.518 albertel 5990: if (keys(%domconfig) > 0) {
5991: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5992: if (keys(%{$domconfig{'login'}})) {
5993: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5994: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1208 raeburn 5995: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5996: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5997: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5998: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5999: if ($key eq 'loginvia') {
6000: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
6001: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
6002: $designhash{$udom.'.login.loginvia'} = $server;
6003: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
6004:
6005: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
6006: } else {
6007: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
6008: }
1.948 raeburn 6009: }
1.1208 raeburn 6010: } elsif ($key eq 'headtag') {
6011: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
6012: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 6013: }
1.946 raeburn 6014: }
1.1208 raeburn 6015: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
6016: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
6017: }
1.946 raeburn 6018: }
6019: }
6020: }
1.1366 raeburn 6021: } elsif ($key eq 'saml') {
6022: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
6023: foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
6024: if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
6025: $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
1.1386 raeburn 6026: foreach my $item ('text','img','alt','url','title','window','notsso') {
1.1366 raeburn 6027: $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
6028: }
6029: }
6030: }
6031: }
1.946 raeburn 6032: } else {
6033: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
6034: $designhash{$udom.'.login.'.$key.'_'.$img} =
6035: $domconfig{'login'}{$key}{$img};
6036: }
1.699 raeburn 6037: }
6038: } else {
6039: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
6040: }
1.632 raeburn 6041: }
6042: } else {
6043: $legacy{'login'} = 1;
1.518 albertel 6044: }
1.632 raeburn 6045: } else {
6046: $legacy{'login'} = 1;
1.518 albertel 6047: }
6048: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 6049: if (keys(%{$domconfig{'rolecolors'}})) {
6050: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
6051: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
6052: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
6053: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
6054: }
1.518 albertel 6055: }
6056: }
1.632 raeburn 6057: } else {
6058: $legacy{'rolecolors'} = 1;
1.518 albertel 6059: }
1.632 raeburn 6060: } else {
6061: $legacy{'rolecolors'} = 1;
1.518 albertel 6062: }
1.948 raeburn 6063: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
6064: if ($domconfig{'autoenroll'}{'co-owners'}) {
6065: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
6066: }
6067: }
1.632 raeburn 6068: if (keys(%legacy) > 0) {
6069: my %legacyhash = &get_legacy_domconf($udom);
6070: foreach my $item (keys(%legacyhash)) {
6071: if ($item =~ /^\Q$udom\E\.login/) {
6072: if ($legacy{'login'}) {
6073: $designhash{$item} = $legacyhash{$item};
6074: }
6075: } else {
6076: if ($legacy{'rolecolors'}) {
6077: $designhash{$item} = $legacyhash{$item};
6078: }
1.518 albertel 6079: }
6080: }
6081: }
1.632 raeburn 6082: } else {
6083: %designhash = &get_legacy_domconf($udom);
1.518 albertel 6084: }
6085: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
6086: $cachetime);
6087: return %designhash;
6088: }
6089:
1.632 raeburn 6090: sub get_legacy_domconf {
6091: my ($udom) = @_;
6092: my %legacyhash;
6093: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
6094: my $designfile = $designdir.'/'.$udom.'.tab';
6095: if (-e $designfile) {
1.1317 raeburn 6096: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 6097: while (my $line = <$fh>) {
6098: next if ($line =~ /^\#/);
6099: chomp($line);
6100: my ($key,$val)=(split(/\=/,$line));
6101: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
6102: }
6103: close($fh);
6104: }
6105: }
1.1026 raeburn 6106: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 6107: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
6108: }
6109: return %legacyhash;
6110: }
6111:
1.63 www 6112: =pod
6113:
1.112 bowersj2 6114: =item * &domainlogo()
1.63 www 6115:
6116: Inputs: $domain (usually will be undef)
6117:
6118: Returns: A link to a domain logo, if the domain logo exists.
6119: If the domain logo does not exist, a description of the domain.
6120:
6121: =cut
1.112 bowersj2 6122:
1.63 www 6123: ###############################################
6124: sub domainlogo {
1.517 raeburn 6125: my $domain = &determinedomain(shift);
1.518 albertel 6126: my %designhash = &get_domainconf($domain);
1.517 raeburn 6127: # See if there is a logo
6128: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 6129: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 6130: if ($imgsrc =~ m{^/(adm|res)/}) {
6131: if ($imgsrc =~ m{^/res/}) {
6132: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
6133: &Apache::lonnet::repcopy($local_name);
6134: }
6135: $imgsrc = &lonhttpdurl($imgsrc);
1.1374 raeburn 6136: }
6137: my $alttext = $domain;
6138: if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
6139: $alttext = $designhash{$domain.'.login.alttext_domlogo'};
6140: }
6141: return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514 albertel 6142: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
6143: return &Apache::lonnet::domain($domain,'description');
1.59 www 6144: } else {
1.60 matthew 6145: return '';
1.59 www 6146: }
6147: }
1.63 www 6148: ##############################################
6149:
6150: =pod
6151:
1.112 bowersj2 6152: =item * &designparm()
1.63 www 6153:
6154: Inputs: $which parameter; $domain (usually will be undef)
6155:
6156: Returns: value of designparamter $which
6157:
6158: =cut
1.112 bowersj2 6159:
1.397 albertel 6160:
1.400 albertel 6161: ##############################################
1.397 albertel 6162: sub designparm {
6163: my ($which,$domain)=@_;
6164: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 6165: return $env{'environment.color.'.$which};
1.96 www 6166: }
1.63 www 6167: $domain=&determinedomain($domain);
1.1016 raeburn 6168: my %domdesign;
6169: unless ($domain eq 'public') {
6170: %domdesign = &get_domainconf($domain);
6171: }
1.520 raeburn 6172: my $output;
1.517 raeburn 6173: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 6174: $output = $domdesign{$domain.'.'.$which};
1.63 www 6175: } else {
1.520 raeburn 6176: $output = $defaultdesign{$which};
6177: }
6178: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 6179: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 6180: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 6181: if ($output =~ m{^/res/}) {
6182: my $local_name = &Apache::lonnet::filelocation('',$output);
6183: &Apache::lonnet::repcopy($local_name);
6184: }
1.520 raeburn 6185: $output = &lonhttpdurl($output);
6186: }
1.63 www 6187: }
1.520 raeburn 6188: return $output;
1.63 www 6189: }
1.59 www 6190:
1.822 bisitz 6191: ##############################################
6192: =pod
6193:
1.832 bisitz 6194: =item * &authorspace()
6195:
1.1028 raeburn 6196: Inputs: $url (usually will be undef).
1.832 bisitz 6197:
1.1132 raeburn 6198: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 6199: directory being viewed (or for which action is being taken).
6200: If $url is provided, and begins /priv/<domain>/<uname>
6201: the path will be that portion of the $context argument.
6202: Otherwise the path will be for the author space of the current
6203: user when the current role is author, or for that of the
6204: co-author/assistant co-author space when the current role
6205: is co-author or assistant co-author.
1.832 bisitz 6206:
6207: =cut
6208:
6209: sub authorspace {
1.1028 raeburn 6210: my ($url) = @_;
6211: if ($url ne '') {
6212: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
6213: return $1;
6214: }
6215: }
1.832 bisitz 6216: my $caname = '';
1.1024 www 6217: my $cadom = '';
1.1028 raeburn 6218: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 6219: ($cadom,$caname) =
1.832 bisitz 6220: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 6221: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 6222: $caname = $env{'user.name'};
1.1024 www 6223: $cadom = $env{'user.domain'};
1.832 bisitz 6224: }
1.1028 raeburn 6225: if (($caname ne '') && ($cadom ne '')) {
6226: return "/priv/$cadom/$caname/";
6227: }
6228: return;
1.832 bisitz 6229: }
6230:
6231: ##############################################
6232: =pod
6233:
1.822 bisitz 6234: =item * &head_subbox()
6235:
6236: Inputs: $content (contains HTML code with page functions, etc.)
6237:
6238: Returns: HTML div with $content
6239: To be included in page header
6240:
6241: =cut
6242:
6243: sub head_subbox {
6244: my ($content)=@_;
6245: my $output =
1.993 raeburn 6246: '<div class="LC_head_subbox">'
1.822 bisitz 6247: .$content
6248: .'</div>'
6249: }
6250:
6251: ##############################################
6252: =pod
6253:
6254: =item * &CSTR_pageheader()
6255:
1.1026 raeburn 6256: Input: (optional) filename from which breadcrumb trail is built.
6257: In most cases no input as needed, as $env{'request.filename'}
6258: is appropriate for use in building the breadcrumb trail.
1.1379 raeburn 6259: frameset flag
6260: If page header is being requested for use in a frameset, then
6261: the second (option) argument -- frameset will be true, and
6262: the target attribute set for links should be target="_parent".
1.822 bisitz 6263:
6264: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 6265: To be included on Authoring Space pages
1.822 bisitz 6266:
6267: =cut
6268:
6269: sub CSTR_pageheader {
1.1379 raeburn 6270: my ($trailfile,$frameset) = @_;
1.1026 raeburn 6271: if ($trailfile eq '') {
6272: $trailfile = $env{'request.filename'};
6273: }
6274:
6275: # this is for resources; directories have customtitle, and crumbs
6276: # and select recent are created in lonpubdir.pm
6277:
6278: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 6279: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 6280: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 6281: my $formaction = "/priv/$udom/$uname/$thisdisfn";
6282: $formaction =~ s{/+}{/}g;
1.822 bisitz 6283:
6284: my $parentpath = '';
6285: my $lastitem = '';
6286: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
6287: $parentpath = $1;
6288: $lastitem = $2;
6289: } else {
6290: $lastitem = $thisdisfn;
6291: }
1.921 bisitz 6292:
1.1246 raeburn 6293: my ($crsauthor,$title);
6294: if (($env{'request.course.id'}) &&
6295: ($env{'course.'.$env{'request.course.id'}.'.num'} eq $uname) &&
1.1247 raeburn 6296: ($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom)) {
1.1246 raeburn 6297: $crsauthor = 1;
6298: $title = &mt('Course Authoring Space');
6299: } else {
6300: $title = &mt('Authoring Space');
6301: }
6302:
1.1379 raeburn 6303: my ($target,$crumbtarget) = (' target="_top"','_top');
6304: if ($frameset) {
6305: $target = ' target="_parent"';
6306: $crumbtarget = '_parent';
6307: } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
1.1314 raeburn 6308: $target = '';
6309: $crumbtarget = '';
1.1379 raeburn 6310: } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
1.1378 raeburn 6311: $target = ' target="'.$env{'request.deeplink.target'}.'"';
6312: $crumbtarget = $env{'request.deeplink.target'};
6313: }
1.1313 raeburn 6314:
1.921 bisitz 6315: my $output =
1.822 bisitz 6316: '<div>'
6317: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1246 raeburn 6318: .'<b>'.$title.'</b> '
1.1314 raeburn 6319: .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
6320: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 6321:
6322: if ($lastitem) {
6323: $output .=
6324: '<span class="LC_filename">'
6325: .$lastitem
6326: .'</span>';
6327: }
1.1245 raeburn 6328:
1.1246 raeburn 6329: if ($crsauthor) {
1.1379 raeburn 6330: $output .= '</form>'.&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6331: } else {
6332: $output .=
6333: '<br />'
1.1314 raeburn 6334: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.1246 raeburn 6335: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
6336: .'</form>'
1.1379 raeburn 6337: .&Apache::lonmenu::constspaceform($frameset);
1.1246 raeburn 6338: }
6339: $output .= '</div>';
1.921 bisitz 6340:
6341: return $output;
1.822 bisitz 6342: }
6343:
1.60 matthew 6344: ###############################################
6345: ###############################################
6346:
6347: =pod
6348:
1.112 bowersj2 6349: =back
6350:
1.549 albertel 6351: =head1 HTML Helpers
1.112 bowersj2 6352:
6353: =over 4
6354:
6355: =item * &bodytag()
1.60 matthew 6356:
6357: Returns a uniform header for LON-CAPA web pages.
6358:
6359: Inputs:
6360:
1.112 bowersj2 6361: =over 4
6362:
6363: =item * $title, A title to be displayed on the page.
6364:
6365: =item * $function, the current role (can be undef).
6366:
6367: =item * $addentries, extra parameters for the <body> tag.
6368:
6369: =item * $bodyonly, if defined, only return the <body> tag.
6370:
6371: =item * $domain, if defined, force a given domain.
6372:
6373: =item * $forcereg, if page should register as content page (relevant for
1.86 www 6374: text interface only)
1.60 matthew 6375:
1.814 bisitz 6376: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
6377: navigational links
1.317 albertel 6378:
1.338 albertel 6379: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
6380:
1.460 albertel 6381: =item * $args, optional argument valid values are
6382: no_auto_mt_title -> prevents &mt()ing the title arg
1.1274 raeburn 6383: use_absolute -> for external resource or syllabus, this will
6384: contain https://<hostname> if server uses
6385: https (as per hosts.tab), but request is for http
6386: hostname -> hostname, from $r->hostname().
1.460 albertel 6387:
1.1096 raeburn 6388: =item * $advtoolsref, optional argument, ref to an array containing
6389: inlineremote items to be added in "Functions" menu below
6390: breadcrumbs.
6391:
1.1316 raeburn 6392: =item * $ltiscope, optional argument, will be one of: resource, map or
6393: course, if LON-CAPA is in LTI Provider context. Value is
6394: the scope of use, i.e., launch was for access to a single, a map
6395: or the entire course.
6396:
6397: =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
6398: context, this will contain the URL for the landing item in
6399: the course, after launch from an LTI Consumer
6400:
1.1318 raeburn 6401: =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
6402: context, this will contain a reference to hash of items
6403: to be included in the page header and/or inline menu.
6404:
1.1385 raeburn 6405: =item * $menucoll, optional argument, if specific menu collection is in
6406: effect, either set as the default for the course, or set for
6407: the deeplink paramater for $env{'request.deeplink.login'}
6408: then $menucoll will be the number of that collection.
6409:
6410: =item * $menuref, optional argument, reference to a hash, containing the
6411: menu options included for the menu in effect, based on the
6412: configuration for the numbered menu collection in use.
6413:
6414: =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
6415: within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
6416: if so, $showncrumbsref is set there to 1, and will propagate back
6417: via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
6418: being called a second time.
6419:
1.112 bowersj2 6420: =back
6421:
1.60 matthew 6422: Returns: A uniform header for LON-CAPA web pages.
6423: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
6424: If $bodyonly is undef or zero, an html string containing a <body> tag and
6425: other decorations will be returned.
6426:
6427: =cut
6428:
1.54 www 6429: sub bodytag {
1.831 bisitz 6430: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1359 raeburn 6431: $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
1.1385 raeburn 6432: $ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
1.339 albertel 6433:
1.954 raeburn 6434: my $public;
6435: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
6436: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
6437: $public = 1;
6438: }
1.460 albertel 6439: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 6440: my $httphost = $args->{'use_absolute'};
1.1274 raeburn 6441: my $hostname = $args->{'hostname'};
1.339 albertel 6442:
1.183 matthew 6443: $function = &get_users_function() if (!$function);
1.339 albertel 6444: my $img = &designparm($function.'.img',$domain);
6445: my $font = &designparm($function.'.font',$domain);
6446: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
6447:
1.803 bisitz 6448: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 6449: 'bgcolor' => $pgbg,
1.339 albertel 6450: 'text' => $font,
6451: 'alink' => &designparm($function.'.alink',$domain),
6452: 'vlink' => &designparm($function.'.vlink',$domain),
6453: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 6454: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 6455:
1.63 www 6456: # role and realm
1.1178 raeburn 6457: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
6458: if ($realm) {
6459: $realm = '/'.$realm;
6460: }
1.1357 raeburn 6461: if ($role eq 'ca') {
1.479 albertel 6462: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 6463: $realm = &plainname($rname,$rdom);
1.378 raeburn 6464: }
1.55 www 6465: # realm
1.1357 raeburn 6466: my ($cid,$sec);
1.258 albertel 6467: if ($env{'request.course.id'}) {
1.1357 raeburn 6468: $cid = $env{'request.course.id'};
6469: if ($env{'request.course.sec'}) {
6470: $sec = $env{'request.course.sec'};
6471: }
6472: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
6473: if (&Apache::lonnet::is_course($1,$2)) {
6474: $cid = $1.'_'.$2;
6475: $sec = $3;
6476: }
6477: }
6478: if ($cid) {
1.378 raeburn 6479: if ($env{'request.role'} !~ /^cr/) {
6480: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1257 raeburn 6481: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1269 raeburn 6482: if ($env{'request.role.desc'}) {
6483: $role = $env{'request.role.desc'};
6484: } else {
6485: $role = &mt('Helpdesk[_1]',' '.$2);
6486: }
1.1257 raeburn 6487: } else {
6488: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 6489: }
1.1357 raeburn 6490: if ($sec) {
6491: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 6492: }
1.1357 raeburn 6493: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 6494: } else {
6495: $role = &Apache::lonnet::plaintext($role);
1.54 www 6496: }
1.433 albertel 6497:
1.359 albertel 6498: if (!$realm) { $realm=' '; }
1.330 albertel 6499:
1.438 albertel 6500: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6501:
1.101 www 6502: # construct main body tag
1.359 albertel 6503: my $bodytag = "<body $extra_body_attr>".
1.1235 raeburn 6504: &Apache::lontexconvert::init_math_support();
1.252 albertel 6505:
1.1131 raeburn 6506: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6507:
1.1130 raeburn 6508: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6509: return $bodytag;
1.1130 raeburn 6510: }
1.359 albertel 6511:
1.954 raeburn 6512: if ($public) {
1.433 albertel 6513: undef($role);
6514: }
1.1318 raeburn 6515:
1.1359 raeburn 6516: my $showcrstitle = 1;
1.1357 raeburn 6517: if (($cid) && ($env{'request.lti.login'})) {
1.1318 raeburn 6518: if (ref($ltimenu) eq 'HASH') {
6519: unless ($ltimenu->{'role'}) {
6520: undef($role);
6521: }
6522: unless ($ltimenu->{'coursetitle'}) {
6523: $realm=' ';
1.1359 raeburn 6524: $showcrstitle = 0;
6525: }
6526: }
6527: } elsif (($cid) && ($menucoll)) {
6528: if (ref($menuref) eq 'HASH') {
6529: unless ($menuref->{'role'}) {
6530: undef($role);
6531: }
6532: unless ($menuref->{'crs'}) {
6533: $realm=' ';
6534: $showcrstitle = 0;
1.1318 raeburn 6535: }
6536: }
6537: }
6538:
1.762 bisitz 6539: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6540: #
6541: # Extra info if you are the DC
6542: my $dc_info = '';
1.1359 raeburn 6543: if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1357 raeburn 6544: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 6545: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6546: $dc_info =~ s/\s+$//;
1.359 albertel 6547: }
6548:
1.1237 raeburn 6549: my $crstype;
1.1357 raeburn 6550: if ($cid) {
6551: $crstype = $env{'course.'.$cid.'.type'};
1.1237 raeburn 6552: } elsif ($args->{'crstype'}) {
6553: $crstype = $args->{'crstype'};
6554: }
6555: if (($crstype eq 'Placement') && (!$env{'request.role.adv'})) {
6556: undef($role);
6557: } else {
1.1242 raeburn 6558: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.1237 raeburn 6559: }
1.853 droeschl 6560:
1.903 droeschl 6561: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6562:
6563: # if ($env{'request.state'} eq 'construct') {
6564: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6565: # }
6566:
1.1130 raeburn 6567: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 6568: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 6569:
1.1318 raeburn 6570: unless ($args->{'no_primary_menu'}) {
1.1369 raeburn 6571: my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
1.1380 raeburn 6572: $args->{'links_disabled'},
6573: $args->{'links_target'});
1.359 albertel 6574:
1.1318 raeburn 6575: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
6576: if ($dc_info) {
6577: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6578: }
6579: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
6580: <em>$realm</em> $dc_info</div>|;
6581: return $bodytag;
6582: }
1.894 droeschl 6583:
1.1318 raeburn 6584: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
6585: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
6586: }
1.916 droeschl 6587:
1.1318 raeburn 6588: $bodytag .= $right;
1.852 droeschl 6589:
1.1318 raeburn 6590: if ($dc_info) {
6591: $dc_info = &dc_courseid_toggle($dc_info);
6592: }
6593: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 6594: }
1.916 droeschl 6595:
1.1169 raeburn 6596: #if directed to not display the secondary menu, don't.
1.1168 raeburn 6597: if ($args->{'no_secondary_menu'}) {
6598: return $bodytag;
6599: }
1.1169 raeburn 6600: #don't show menus for public users
1.954 raeburn 6601: if (!$public){
1.1318 raeburn 6602: unless ($args->{'no_inline_menu'}) {
6603: $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
1.1359 raeburn 6604: $args->{'no_primary_menu'},
1.1369 raeburn 6605: $menucoll,$menuref,
1.1380 raeburn 6606: $args->{'links_disabled'},
6607: $args->{'links_target'});
1.1318 raeburn 6608: }
1.903 droeschl 6609: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 6610: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6611: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6612: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1385 raeburn 6613: $args->{'bread_crumbs'},'','',$hostname,
6614: $ltiscope,$ltiuri,$showncrumbsref);
1.1096 raeburn 6615: } elsif ($forcereg) {
6616: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1385 raeburn 6617: $args->{'group'},$args->{'hide_buttons'},
6618: $hostname,$ltiscope,$ltiuri,$showncrumbsref);
1.1096 raeburn 6619: } else {
6620: $bodytag .=
6621: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6622: $forcereg,$args->{'group'},
6623: $args->{'bread_crumbs'},
1.1274 raeburn 6624: $advtoolsref,'',$hostname);
1.920 raeburn 6625: }
1.903 droeschl 6626: }else{
6627: # this is to seperate menu from content when there's no secondary
6628: # menu. Especially needed for public accessible ressources.
6629: $bodytag .= '<hr style="clear:both" />';
6630: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 6631: }
1.903 droeschl 6632:
1.235 raeburn 6633: return $bodytag;
1.182 matthew 6634: }
6635:
1.917 raeburn 6636: sub dc_courseid_toggle {
6637: my ($dc_info) = @_;
1.980 raeburn 6638: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6639: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6640: &mt('(More ...)').'</a></span>'.
6641: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6642: }
6643:
1.330 albertel 6644: sub make_attr_string {
6645: my ($register,$attr_ref) = @_;
6646:
6647: if ($attr_ref && !ref($attr_ref)) {
6648: die("addentries Must be a hash ref ".
6649: join(':',caller(1))." ".
6650: join(':',caller(0))." ");
6651: }
6652:
6653: if ($register) {
1.339 albertel 6654: my ($on_load,$on_unload);
6655: foreach my $key (keys(%{$attr_ref})) {
6656: if (lc($key) eq 'onload') {
6657: $on_load.=$attr_ref->{$key}.';';
6658: delete($attr_ref->{$key});
6659:
6660: } elsif (lc($key) eq 'onunload') {
6661: $on_unload.=$attr_ref->{$key}.';';
6662: delete($attr_ref->{$key});
6663: }
6664: }
1.953 droeschl 6665: $attr_ref->{'onload'} = $on_load;
6666: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 6667: }
1.339 albertel 6668:
1.330 albertel 6669: my $attr_string;
1.1159 raeburn 6670: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6671: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6672: }
6673: return $attr_string;
6674: }
6675:
6676:
1.182 matthew 6677: ###############################################
1.251 albertel 6678: ###############################################
6679:
6680: =pod
6681:
6682: =item * &endbodytag()
6683:
6684: Returns a uniform footer for LON-CAPA web pages.
6685:
1.635 raeburn 6686: Inputs: 1 - optional reference to an args hash
6687: If in the hash, key for noredirectlink has a value which evaluates to true,
6688: a 'Continue' link is not displayed if the page contains an
6689: internal redirect in the <head></head> section,
6690: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6691:
6692: =cut
6693:
6694: sub endbodytag {
1.635 raeburn 6695: my ($args) = @_;
1.1080 raeburn 6696: my $endbodytag;
6697: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6698: $endbodytag='</body>';
6699: }
1.315 albertel 6700: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6701: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
1.1386 raeburn 6702: my ($endbodyjs,$idattr);
6703: if ($env{'internal.head.to_opener'}) {
6704: my $linkid = 'LC_continue_link';
6705: $idattr = ' id="'.$linkid.'"';
6706: my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
6707: $endbodyjs=<<ENDJS;
6708: <script type="text/javascript">
6709: // <![CDATA[
6710: function ebFunction(evt) {
6711: evt.preventDefault();
6712: var dest = '$redirect_for_js';
6713: if (window.opener != null && !window.opener.closed) {
6714: window.opener.location.href=dest;
6715: window.close();
6716: } else {
6717: window.location.href=dest;
6718: }
6719: return false;
6720: }
6721:
6722: \$(document).ready(function () {
6723: if (document.getElementById('$linkid')) {
6724: var clickelem = document.getElementById('$linkid');
6725: clickelem.addEventListener('click',ebFunction,false);
6726: }
6727: });
6728: // ]]>
6729: </script>
6730: ENDJS
6731: }
1.635 raeburn 6732: $endbodytag=
1.1386 raeburn 6733: "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
1.635 raeburn 6734: &mt('Continue').'</a>'.
6735: $endbodytag;
6736: }
1.315 albertel 6737: }
1.251 albertel 6738: return $endbodytag;
6739: }
6740:
1.352 albertel 6741: =pod
6742:
6743: =item * &standard_css()
6744:
6745: Returns a style sheet
6746:
6747: Inputs: (all optional)
6748: domain -> force to color decorate a page for a specific
6749: domain
6750: function -> force usage of a specific rolish color scheme
6751: bgcolor -> override the default page bgcolor
6752:
6753: =cut
6754:
1.343 albertel 6755: sub standard_css {
1.345 albertel 6756: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6757: $function = &get_users_function() if (!$function);
6758: my $img = &designparm($function.'.img', $domain);
6759: my $tabbg = &designparm($function.'.tabbg', $domain);
6760: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6761: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6762: #second colour for later usage
1.345 albertel 6763: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6764: my $pgbg_or_bgcolor =
6765: $bgcolor ||
1.352 albertel 6766: &designparm($function.'.pgbg', $domain);
1.382 albertel 6767: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6768: my $alink = &designparm($function.'.alink', $domain);
6769: my $vlink = &designparm($function.'.vlink', $domain);
6770: my $link = &designparm($function.'.link', $domain);
6771:
1.602 albertel 6772: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6773: my $mono = 'monospace';
1.850 bisitz 6774: my $data_table_head = $sidebg;
6775: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6776: my $data_table_dark = '#E0E0E0';
1.470 banghart 6777: my $data_table_darker = '#CCCCCC';
1.349 albertel 6778: my $data_table_highlight = '#FFFF00';
1.352 albertel 6779: my $mail_new = '#FFBB77';
6780: my $mail_new_hover = '#DD9955';
6781: my $mail_read = '#BBBB77';
6782: my $mail_read_hover = '#999944';
6783: my $mail_replied = '#AAAA88';
6784: my $mail_replied_hover = '#888855';
6785: my $mail_other = '#99BBBB';
6786: my $mail_other_hover = '#669999';
1.391 albertel 6787: my $table_header = '#DDDDDD';
1.489 raeburn 6788: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6789: my $lg_border_color = '#C8C8C8';
1.952 onken 6790: my $button_hover = '#BF2317';
1.392 albertel 6791:
1.608 albertel 6792: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6793: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6794: : '0 3px 0 4px';
1.448 albertel 6795:
1.523 albertel 6796:
1.343 albertel 6797: return <<END;
1.947 droeschl 6798:
6799: /* needed for iframe to allow 100% height in FF */
6800: body, html {
6801: margin: 0;
6802: padding: 0 0.5%;
6803: height: 99%; /* to avoid scrollbars */
6804: }
6805:
1.795 www 6806: body {
1.911 bisitz 6807: font-family: $sans;
6808: line-height:130%;
6809: font-size:0.83em;
6810: color:$font;
1.795 www 6811: }
6812:
1.959 onken 6813: a:focus,
6814: a:focus img {
1.795 www 6815: color: red;
6816: }
1.698 harmsja 6817:
1.911 bisitz 6818: form, .inline {
6819: display: inline;
1.795 www 6820: }
1.721 harmsja 6821:
1.795 www 6822: .LC_right {
1.911 bisitz 6823: text-align:right;
1.795 www 6824: }
6825:
6826: .LC_middle {
1.911 bisitz 6827: vertical-align:middle;
1.795 www 6828: }
1.721 harmsja 6829:
1.1130 raeburn 6830: .LC_floatleft {
6831: float: left;
6832: }
6833:
6834: .LC_floatright {
6835: float: right;
6836: }
6837:
1.911 bisitz 6838: .LC_400Box {
6839: width:400px;
6840: }
1.721 harmsja 6841:
1.947 droeschl 6842: .LC_iframecontainer {
6843: width: 98%;
6844: margin: 0;
6845: position: fixed;
6846: top: 8.5em;
6847: bottom: 0;
6848: }
6849:
6850: .LC_iframecontainer iframe{
6851: border: none;
6852: width: 100%;
6853: height: 100%;
6854: }
6855:
1.778 bisitz 6856: .LC_filename {
6857: font-family: $mono;
6858: white-space:pre;
1.921 bisitz 6859: font-size: 120%;
1.778 bisitz 6860: }
6861:
6862: .LC_fileicon {
6863: border: none;
6864: height: 1.3em;
6865: vertical-align: text-bottom;
6866: margin-right: 0.3em;
6867: text-decoration:none;
6868: }
6869:
1.1008 www 6870: .LC_setting {
6871: text-decoration:underline;
6872: }
6873:
1.350 albertel 6874: .LC_error {
6875: color: red;
6876: }
1.795 www 6877:
1.1097 bisitz 6878: .LC_warning {
6879: color: darkorange;
6880: }
6881:
1.457 albertel 6882: .LC_diff_removed {
1.733 bisitz 6883: color: red;
1.394 albertel 6884: }
1.532 albertel 6885:
6886: .LC_info,
1.457 albertel 6887: .LC_success,
6888: .LC_diff_added {
1.350 albertel 6889: color: green;
6890: }
1.795 www 6891:
1.802 bisitz 6892: div.LC_confirm_box {
6893: background-color: #FAFAFA;
6894: border: 1px solid $lg_border_color;
6895: margin-right: 0;
6896: padding: 5px;
6897: }
6898:
6899: div.LC_confirm_box .LC_error img,
6900: div.LC_confirm_box .LC_success img {
6901: vertical-align: middle;
6902: }
6903:
1.1242 raeburn 6904: .LC_maxwidth {
6905: max-width: 100%;
6906: height: auto;
6907: }
6908:
1.1243 raeburn 6909: .LC_textsize_mobile {
6910: \@media only screen and (max-device-width: 480px) {
6911: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6912: }
6913: }
6914:
1.440 albertel 6915: .LC_icon {
1.771 droeschl 6916: border: none;
1.790 droeschl 6917: vertical-align: middle;
1.771 droeschl 6918: }
6919:
1.543 albertel 6920: .LC_docs_spacer {
6921: width: 25px;
6922: height: 1px;
1.771 droeschl 6923: border: none;
1.543 albertel 6924: }
1.346 albertel 6925:
1.532 albertel 6926: .LC_internal_info {
1.735 bisitz 6927: color: #999999;
1.532 albertel 6928: }
6929:
1.794 www 6930: .LC_discussion {
1.1050 www 6931: background: $data_table_dark;
1.911 bisitz 6932: border: 1px solid black;
6933: margin: 2px;
1.794 www 6934: }
6935:
6936: .LC_disc_action_left {
1.1050 www 6937: background: $sidebg;
1.911 bisitz 6938: text-align: left;
1.1050 www 6939: padding: 4px;
6940: margin: 2px;
1.794 www 6941: }
6942:
6943: .LC_disc_action_right {
1.1050 www 6944: background: $sidebg;
1.911 bisitz 6945: text-align: right;
1.1050 www 6946: padding: 4px;
6947: margin: 2px;
1.794 www 6948: }
6949:
6950: .LC_disc_new_item {
1.911 bisitz 6951: background: white;
6952: border: 2px solid red;
1.1050 www 6953: margin: 4px;
6954: padding: 4px;
1.794 www 6955: }
6956:
6957: .LC_disc_old_item {
1.911 bisitz 6958: background: white;
1.1050 www 6959: margin: 4px;
6960: padding: 4px;
1.794 www 6961: }
6962:
1.458 albertel 6963: table.LC_pastsubmission {
6964: border: 1px solid black;
6965: margin: 2px;
6966: }
6967:
1.924 bisitz 6968: table#LC_menubuttons {
1.345 albertel 6969: width: 100%;
6970: background: $pgbg;
1.392 albertel 6971: border: 2px;
1.402 albertel 6972: border-collapse: separate;
1.803 bisitz 6973: padding: 0;
1.345 albertel 6974: }
1.392 albertel 6975:
1.801 tempelho 6976: table#LC_title_bar a {
6977: color: $fontmenu;
6978: }
1.836 bisitz 6979:
1.807 droeschl 6980: table#LC_title_bar {
1.819 tempelho 6981: clear: both;
1.836 bisitz 6982: display: none;
1.807 droeschl 6983: }
6984:
1.795 www 6985: table#LC_title_bar,
1.933 droeschl 6986: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6987: table#LC_title_bar.LC_with_remote {
1.359 albertel 6988: width: 100%;
1.392 albertel 6989: border-color: $pgbg;
6990: border-style: solid;
6991: border-width: $border;
1.379 albertel 6992: background: $pgbg;
1.801 tempelho 6993: color: $fontmenu;
1.392 albertel 6994: border-collapse: collapse;
1.803 bisitz 6995: padding: 0;
1.819 tempelho 6996: margin: 0;
1.359 albertel 6997: }
1.795 www 6998:
1.933 droeschl 6999: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 7000: margin: 0;
7001: padding: 0;
1.933 droeschl 7002: position: relative;
7003: list-style: none;
1.913 droeschl 7004: }
1.933 droeschl 7005: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 7006: display: inline;
7007: }
1.933 droeschl 7008:
7009: .LC_breadcrumb_tools_navigation {
1.913 droeschl 7010: padding: 0;
1.933 droeschl 7011: margin: 0;
7012: float: left;
1.913 droeschl 7013: }
1.933 droeschl 7014: .LC_breadcrumb_tools_tools {
7015: padding: 0;
7016: margin: 0;
1.913 droeschl 7017: float: right;
7018: }
7019:
1.1240 raeburn 7020: .LC_placement_prog {
7021: padding-right: 20px;
7022: font-weight: bold;
7023: font-size: 90%;
7024: }
7025:
1.359 albertel 7026: table#LC_title_bar td {
7027: background: $tabbg;
7028: }
1.795 www 7029:
1.911 bisitz 7030: table#LC_menubuttons img {
1.803 bisitz 7031: border: none;
1.346 albertel 7032: }
1.795 www 7033:
1.842 droeschl 7034: .LC_breadcrumbs_component {
1.911 bisitz 7035: float: right;
7036: margin: 0 1em;
1.357 albertel 7037: }
1.842 droeschl 7038: .LC_breadcrumbs_component img {
1.911 bisitz 7039: vertical-align: middle;
1.777 tempelho 7040: }
1.795 www 7041:
1.1243 raeburn 7042: .LC_breadcrumbs_hoverable {
7043: background: $sidebg;
7044: }
7045:
1.383 albertel 7046: td.LC_table_cell_checkbox {
7047: text-align: center;
7048: }
1.795 www 7049:
7050: .LC_fontsize_small {
1.911 bisitz 7051: font-size: 70%;
1.705 tempelho 7052: }
7053:
1.844 bisitz 7054: #LC_breadcrumbs {
1.911 bisitz 7055: clear:both;
7056: background: $sidebg;
7057: border-bottom: 1px solid $lg_border_color;
7058: line-height: 2.5em;
1.933 droeschl 7059: overflow: hidden;
1.911 bisitz 7060: margin: 0;
7061: padding: 0;
1.995 raeburn 7062: text-align: left;
1.819 tempelho 7063: }
1.862 bisitz 7064:
1.1098 bisitz 7065: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 7066: clear:both;
7067: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 7068: border: 1px solid $sidebg;
1.1098 bisitz 7069: margin: 0 0 10px 0;
1.966 bisitz 7070: padding: 3px;
1.995 raeburn 7071: text-align: left;
1.822 bisitz 7072: }
7073:
1.795 www 7074: .LC_fontsize_medium {
1.911 bisitz 7075: font-size: 85%;
1.705 tempelho 7076: }
7077:
1.795 www 7078: .LC_fontsize_large {
1.911 bisitz 7079: font-size: 120%;
1.705 tempelho 7080: }
7081:
1.346 albertel 7082: .LC_menubuttons_inline_text {
7083: color: $font;
1.698 harmsja 7084: font-size: 90%;
1.701 harmsja 7085: padding-left:3px;
1.346 albertel 7086: }
7087:
1.934 droeschl 7088: .LC_menubuttons_inline_text img{
7089: vertical-align: middle;
7090: }
7091:
1.1051 www 7092: li.LC_menubuttons_inline_text img {
1.951 onken 7093: cursor:pointer;
1.1002 droeschl 7094: text-decoration: none;
1.951 onken 7095: }
7096:
1.526 www 7097: .LC_menubuttons_link {
7098: text-decoration: none;
7099: }
1.795 www 7100:
1.522 albertel 7101: .LC_menubuttons_category {
1.521 www 7102: color: $font;
1.526 www 7103: background: $pgbg;
1.521 www 7104: font-size: larger;
7105: font-weight: bold;
7106: }
7107:
1.346 albertel 7108: td.LC_menubuttons_text {
1.911 bisitz 7109: color: $font;
1.346 albertel 7110: }
1.706 harmsja 7111:
1.346 albertel 7112: .LC_current_location {
7113: background: $tabbg;
7114: }
1.795 www 7115:
1.1286 raeburn 7116: td.LC_zero_height {
7117: line-height: 0;
7118: cellpadding: 0;
7119: }
7120:
1.938 bisitz 7121: table.LC_data_table {
1.347 albertel 7122: border: 1px solid #000000;
1.402 albertel 7123: border-collapse: separate;
1.426 albertel 7124: border-spacing: 1px;
1.610 albertel 7125: background: $pgbg;
1.347 albertel 7126: }
1.795 www 7127:
1.422 albertel 7128: .LC_data_table_dense {
7129: font-size: small;
7130: }
1.795 www 7131:
1.507 raeburn 7132: table.LC_nested_outer {
7133: border: 1px solid #000000;
1.589 raeburn 7134: border-collapse: collapse;
1.803 bisitz 7135: border-spacing: 0;
1.507 raeburn 7136: width: 100%;
7137: }
1.795 www 7138:
1.879 raeburn 7139: table.LC_innerpickbox,
1.507 raeburn 7140: table.LC_nested {
1.803 bisitz 7141: border: none;
1.589 raeburn 7142: border-collapse: collapse;
1.803 bisitz 7143: border-spacing: 0;
1.507 raeburn 7144: width: 100%;
7145: }
1.795 www 7146:
1.911 bisitz 7147: table.LC_data_table tr th,
7148: table.LC_calendar tr th,
1.879 raeburn 7149: table.LC_prior_tries tr th,
7150: table.LC_innerpickbox tr th {
1.349 albertel 7151: font-weight: bold;
7152: background-color: $data_table_head;
1.801 tempelho 7153: color:$fontmenu;
1.701 harmsja 7154: font-size:90%;
1.347 albertel 7155: }
1.795 www 7156:
1.879 raeburn 7157: table.LC_innerpickbox tr th,
7158: table.LC_innerpickbox tr td {
7159: vertical-align: top;
7160: }
7161:
1.711 raeburn 7162: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 7163: background-color: #CCCCCC;
1.711 raeburn 7164: font-weight: bold;
7165: text-align: left;
7166: }
1.795 www 7167:
1.912 bisitz 7168: table.LC_data_table tr.LC_odd_row > td {
7169: background-color: $data_table_light;
7170: padding: 2px;
7171: vertical-align: top;
7172: }
7173:
1.809 bisitz 7174: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 7175: background-color: $data_table_light;
1.912 bisitz 7176: vertical-align: top;
7177: }
7178:
7179: table.LC_data_table tr.LC_even_row > td {
7180: background-color: $data_table_dark;
1.425 albertel 7181: padding: 2px;
1.900 bisitz 7182: vertical-align: top;
1.347 albertel 7183: }
1.795 www 7184:
1.809 bisitz 7185: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 7186: background-color: $data_table_dark;
1.900 bisitz 7187: vertical-align: top;
1.347 albertel 7188: }
1.795 www 7189:
1.425 albertel 7190: table.LC_data_table tr.LC_data_table_highlight td {
7191: background-color: $data_table_darker;
7192: }
1.795 www 7193:
1.639 raeburn 7194: table.LC_data_table tr td.LC_leftcol_header {
7195: background-color: $data_table_head;
7196: font-weight: bold;
7197: }
1.795 www 7198:
1.451 albertel 7199: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 7200: table.LC_nested tr.LC_empty_row td {
1.421 albertel 7201: font-weight: bold;
7202: font-style: italic;
7203: text-align: center;
7204: padding: 8px;
1.347 albertel 7205: }
1.795 www 7206:
1.1114 raeburn 7207: table.LC_data_table tr.LC_empty_row td,
7208: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 7209: background-color: $sidebg;
7210: }
7211:
7212: table.LC_nested tr.LC_empty_row td {
7213: background-color: #FFFFFF;
7214: }
7215:
1.890 droeschl 7216: table.LC_caption {
7217: }
7218:
1.507 raeburn 7219: table.LC_nested tr.LC_empty_row td {
1.465 albertel 7220: padding: 4ex
7221: }
1.795 www 7222:
1.507 raeburn 7223: table.LC_nested_outer tr th {
7224: font-weight: bold;
1.801 tempelho 7225: color:$fontmenu;
1.507 raeburn 7226: background-color: $data_table_head;
1.701 harmsja 7227: font-size: small;
1.507 raeburn 7228: border-bottom: 1px solid #000000;
7229: }
1.795 www 7230:
1.507 raeburn 7231: table.LC_nested_outer tr td.LC_subheader {
7232: background-color: $data_table_head;
7233: font-weight: bold;
7234: font-size: small;
7235: border-bottom: 1px solid #000000;
7236: text-align: right;
1.451 albertel 7237: }
1.795 www 7238:
1.507 raeburn 7239: table.LC_nested tr.LC_info_row td {
1.735 bisitz 7240: background-color: #CCCCCC;
1.451 albertel 7241: font-weight: bold;
7242: font-size: small;
1.507 raeburn 7243: text-align: center;
7244: }
1.795 www 7245:
1.589 raeburn 7246: table.LC_nested tr.LC_info_row td.LC_left_item,
7247: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 7248: text-align: left;
1.451 albertel 7249: }
1.795 www 7250:
1.507 raeburn 7251: table.LC_nested td {
1.735 bisitz 7252: background-color: #FFFFFF;
1.451 albertel 7253: font-size: small;
1.507 raeburn 7254: }
1.795 www 7255:
1.507 raeburn 7256: table.LC_nested_outer tr th.LC_right_item,
7257: table.LC_nested tr.LC_info_row td.LC_right_item,
7258: table.LC_nested tr.LC_odd_row td.LC_right_item,
7259: table.LC_nested tr td.LC_right_item {
1.451 albertel 7260: text-align: right;
7261: }
7262:
1.507 raeburn 7263: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 7264: background-color: #EEEEEE;
1.451 albertel 7265: }
7266:
1.473 raeburn 7267: table.LC_createuser {
7268: }
7269:
7270: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 7271: font-size: small;
1.473 raeburn 7272: }
7273:
7274: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 7275: background-color: #CCCCCC;
1.473 raeburn 7276: font-weight: bold;
7277: text-align: center;
7278: }
7279:
1.349 albertel 7280: table.LC_calendar {
7281: border: 1px solid #000000;
7282: border-collapse: collapse;
1.917 raeburn 7283: width: 98%;
1.349 albertel 7284: }
1.795 www 7285:
1.349 albertel 7286: table.LC_calendar_pickdate {
7287: font-size: xx-small;
7288: }
1.795 www 7289:
1.349 albertel 7290: table.LC_calendar tr td {
7291: border: 1px solid #000000;
7292: vertical-align: top;
1.917 raeburn 7293: width: 14%;
1.349 albertel 7294: }
1.795 www 7295:
1.349 albertel 7296: table.LC_calendar tr td.LC_calendar_day_empty {
7297: background-color: $data_table_dark;
7298: }
1.795 www 7299:
1.779 bisitz 7300: table.LC_calendar tr td.LC_calendar_day_current {
7301: background-color: $data_table_highlight;
1.777 tempelho 7302: }
1.795 www 7303:
1.938 bisitz 7304: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 7305: background-color: $mail_new;
7306: }
1.795 www 7307:
1.938 bisitz 7308: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 7309: background-color: $mail_new_hover;
7310: }
1.795 www 7311:
1.938 bisitz 7312: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 7313: background-color: $mail_read;
7314: }
1.795 www 7315:
1.938 bisitz 7316: /*
7317: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 7318: background-color: $mail_read_hover;
7319: }
1.938 bisitz 7320: */
1.795 www 7321:
1.938 bisitz 7322: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 7323: background-color: $mail_replied;
7324: }
1.795 www 7325:
1.938 bisitz 7326: /*
7327: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 7328: background-color: $mail_replied_hover;
7329: }
1.938 bisitz 7330: */
1.795 www 7331:
1.938 bisitz 7332: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 7333: background-color: $mail_other;
7334: }
1.795 www 7335:
1.938 bisitz 7336: /*
7337: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 7338: background-color: $mail_other_hover;
7339: }
1.938 bisitz 7340: */
1.494 raeburn 7341:
1.777 tempelho 7342: table.LC_data_table tr > td.LC_browser_file,
7343: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 7344: background: #AAEE77;
1.389 albertel 7345: }
1.795 www 7346:
1.777 tempelho 7347: table.LC_data_table tr > td.LC_browser_file_locked,
7348: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 7349: background: #FFAA99;
1.387 albertel 7350: }
1.795 www 7351:
1.777 tempelho 7352: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 7353: background: #888888;
1.779 bisitz 7354: }
1.795 www 7355:
1.777 tempelho 7356: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 7357: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 7358: background: #F8F866;
1.777 tempelho 7359: }
1.795 www 7360:
1.696 bisitz 7361: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 7362: background: #E0E8FF;
1.387 albertel 7363: }
1.696 bisitz 7364:
1.707 bisitz 7365: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 7366: /* background: #77FF77; */
1.707 bisitz 7367: }
1.795 www 7368:
1.707 bisitz 7369: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 7370: border-right: 8px solid #FFFF77;
1.707 bisitz 7371: }
1.795 www 7372:
1.707 bisitz 7373: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 7374: border-right: 8px solid #FFAA77;
1.707 bisitz 7375: }
1.795 www 7376:
1.707 bisitz 7377: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 7378: border-right: 8px solid #FF7777;
1.707 bisitz 7379: }
1.795 www 7380:
1.707 bisitz 7381: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 7382: border-right: 8px solid #AAFF77;
1.707 bisitz 7383: }
1.795 www 7384:
1.707 bisitz 7385: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 7386: border-right: 8px solid #11CC55;
1.707 bisitz 7387: }
7388:
1.388 albertel 7389: span.LC_current_location {
1.701 harmsja 7390: font-size:larger;
1.388 albertel 7391: background: $pgbg;
7392: }
1.387 albertel 7393:
1.1029 www 7394: span.LC_current_nav_location {
7395: font-weight:bold;
7396: background: $sidebg;
7397: }
7398:
1.395 albertel 7399: span.LC_parm_menu_item {
7400: font-size: larger;
7401: }
1.795 www 7402:
1.395 albertel 7403: span.LC_parm_scope_all {
7404: color: red;
7405: }
1.795 www 7406:
1.395 albertel 7407: span.LC_parm_scope_folder {
7408: color: green;
7409: }
1.795 www 7410:
1.395 albertel 7411: span.LC_parm_scope_resource {
7412: color: orange;
7413: }
1.795 www 7414:
1.395 albertel 7415: span.LC_parm_part {
7416: color: blue;
7417: }
1.795 www 7418:
1.911 bisitz 7419: span.LC_parm_folder,
7420: span.LC_parm_symb {
1.395 albertel 7421: font-size: x-small;
7422: font-family: $mono;
7423: color: #AAAAAA;
7424: }
7425:
1.977 bisitz 7426: ul.LC_parm_parmlist li {
7427: display: inline-block;
7428: padding: 0.3em 0.8em;
7429: vertical-align: top;
7430: width: 150px;
7431: border-top:1px solid $lg_border_color;
7432: }
7433:
1.795 www 7434: td.LC_parm_overview_level_menu,
7435: td.LC_parm_overview_map_menu,
7436: td.LC_parm_overview_parm_selectors,
7437: td.LC_parm_overview_restrictions {
1.396 albertel 7438: border: 1px solid black;
7439: border-collapse: collapse;
7440: }
1.795 www 7441:
1.1285 raeburn 7442: span.LC_parm_recursive,
7443: td.LC_parm_recursive {
7444: font-weight: bold;
7445: font-size: smaller;
7446: }
7447:
1.396 albertel 7448: table.LC_parm_overview_restrictions td {
7449: border-width: 1px 4px 1px 4px;
7450: border-style: solid;
7451: border-color: $pgbg;
7452: text-align: center;
7453: }
1.795 www 7454:
1.396 albertel 7455: table.LC_parm_overview_restrictions th {
7456: background: $tabbg;
7457: border-width: 1px 4px 1px 4px;
7458: border-style: solid;
7459: border-color: $pgbg;
7460: }
1.795 www 7461:
1.398 albertel 7462: table#LC_helpmenu {
1.803 bisitz 7463: border: none;
1.398 albertel 7464: height: 55px;
1.803 bisitz 7465: border-spacing: 0;
1.398 albertel 7466: }
7467:
7468: table#LC_helpmenu fieldset legend {
7469: font-size: larger;
7470: }
1.795 www 7471:
1.397 albertel 7472: table#LC_helpmenu_links {
7473: width: 100%;
7474: border: 1px solid black;
7475: background: $pgbg;
1.803 bisitz 7476: padding: 0;
1.397 albertel 7477: border-spacing: 1px;
7478: }
1.795 www 7479:
1.397 albertel 7480: table#LC_helpmenu_links tr td {
7481: padding: 1px;
7482: background: $tabbg;
1.399 albertel 7483: text-align: center;
7484: font-weight: bold;
1.397 albertel 7485: }
1.396 albertel 7486:
1.795 www 7487: table#LC_helpmenu_links a:link,
7488: table#LC_helpmenu_links a:visited,
1.397 albertel 7489: table#LC_helpmenu_links a:active {
7490: text-decoration: none;
7491: color: $font;
7492: }
1.795 www 7493:
1.397 albertel 7494: table#LC_helpmenu_links a:hover {
7495: text-decoration: underline;
7496: color: $vlink;
7497: }
1.396 albertel 7498:
1.417 albertel 7499: .LC_chrt_popup_exists {
7500: border: 1px solid #339933;
7501: margin: -1px;
7502: }
1.795 www 7503:
1.417 albertel 7504: .LC_chrt_popup_up {
7505: border: 1px solid yellow;
7506: margin: -1px;
7507: }
1.795 www 7508:
1.417 albertel 7509: .LC_chrt_popup {
7510: border: 1px solid #8888FF;
7511: background: #CCCCFF;
7512: }
1.795 www 7513:
1.421 albertel 7514: table.LC_pick_box {
7515: border-collapse: separate;
7516: background: white;
7517: border: 1px solid black;
7518: border-spacing: 1px;
7519: }
1.795 www 7520:
1.421 albertel 7521: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 7522: background: $sidebg;
1.421 albertel 7523: font-weight: bold;
1.900 bisitz 7524: text-align: left;
1.740 bisitz 7525: vertical-align: top;
1.421 albertel 7526: width: 184px;
7527: padding: 8px;
7528: }
1.795 www 7529:
1.579 raeburn 7530: table.LC_pick_box td.LC_pick_box_value {
7531: text-align: left;
7532: padding: 8px;
7533: }
1.795 www 7534:
1.579 raeburn 7535: table.LC_pick_box td.LC_pick_box_select {
7536: text-align: left;
7537: padding: 8px;
7538: }
1.795 www 7539:
1.424 albertel 7540: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 7541: padding: 0;
1.421 albertel 7542: height: 1px;
7543: background: black;
7544: }
1.795 www 7545:
1.421 albertel 7546: table.LC_pick_box td.LC_pick_box_submit {
7547: text-align: right;
7548: }
1.795 www 7549:
1.579 raeburn 7550: table.LC_pick_box td.LC_evenrow_value {
7551: text-align: left;
7552: padding: 8px;
7553: background-color: $data_table_light;
7554: }
1.795 www 7555:
1.579 raeburn 7556: table.LC_pick_box td.LC_oddrow_value {
7557: text-align: left;
7558: padding: 8px;
7559: background-color: $data_table_light;
7560: }
1.795 www 7561:
1.579 raeburn 7562: span.LC_helpform_receipt_cat {
7563: font-weight: bold;
7564: }
1.795 www 7565:
1.424 albertel 7566: table.LC_group_priv_box {
7567: background: white;
7568: border: 1px solid black;
7569: border-spacing: 1px;
7570: }
1.795 www 7571:
1.424 albertel 7572: table.LC_group_priv_box td.LC_pick_box_title {
7573: background: $tabbg;
7574: font-weight: bold;
7575: text-align: right;
7576: width: 184px;
7577: }
1.795 www 7578:
1.424 albertel 7579: table.LC_group_priv_box td.LC_groups_fixed {
7580: background: $data_table_light;
7581: text-align: center;
7582: }
1.795 www 7583:
1.424 albertel 7584: table.LC_group_priv_box td.LC_groups_optional {
7585: background: $data_table_dark;
7586: text-align: center;
7587: }
1.795 www 7588:
1.424 albertel 7589: table.LC_group_priv_box td.LC_groups_functionality {
7590: background: $data_table_darker;
7591: text-align: center;
7592: font-weight: bold;
7593: }
1.795 www 7594:
1.424 albertel 7595: table.LC_group_priv td {
7596: text-align: left;
1.803 bisitz 7597: padding: 0;
1.424 albertel 7598: }
7599:
7600: .LC_navbuttons {
7601: margin: 2ex 0ex 2ex 0ex;
7602: }
1.795 www 7603:
1.423 albertel 7604: .LC_topic_bar {
7605: font-weight: bold;
7606: background: $tabbg;
1.918 wenzelju 7607: margin: 1em 0em 1em 2em;
1.805 bisitz 7608: padding: 3px;
1.918 wenzelju 7609: font-size: 1.2em;
1.423 albertel 7610: }
1.795 www 7611:
1.423 albertel 7612: .LC_topic_bar span {
1.918 wenzelju 7613: left: 0.5em;
7614: position: absolute;
1.423 albertel 7615: vertical-align: middle;
1.918 wenzelju 7616: font-size: 1.2em;
1.423 albertel 7617: }
1.795 www 7618:
1.423 albertel 7619: table.LC_course_group_status {
7620: margin: 20px;
7621: }
1.795 www 7622:
1.423 albertel 7623: table.LC_status_selector td {
7624: vertical-align: top;
7625: text-align: center;
1.424 albertel 7626: padding: 4px;
7627: }
1.795 www 7628:
1.599 albertel 7629: div.LC_feedback_link {
1.616 albertel 7630: clear: both;
1.829 kalberla 7631: background: $sidebg;
1.779 bisitz 7632: width: 100%;
1.829 kalberla 7633: padding-bottom: 10px;
7634: border: 1px $tabbg solid;
1.833 kalberla 7635: height: 22px;
7636: line-height: 22px;
7637: padding-top: 5px;
7638: }
7639:
7640: div.LC_feedback_link img {
7641: height: 22px;
1.867 kalberla 7642: vertical-align:middle;
1.829 kalberla 7643: }
7644:
1.911 bisitz 7645: div.LC_feedback_link a {
1.829 kalberla 7646: text-decoration: none;
1.489 raeburn 7647: }
1.795 www 7648:
1.867 kalberla 7649: div.LC_comblock {
1.911 bisitz 7650: display:inline;
1.867 kalberla 7651: color:$font;
7652: font-size:90%;
7653: }
7654:
7655: div.LC_feedback_link div.LC_comblock {
7656: padding-left:5px;
7657: }
7658:
7659: div.LC_feedback_link div.LC_comblock a {
7660: color:$font;
7661: }
7662:
1.489 raeburn 7663: span.LC_feedback_link {
1.858 bisitz 7664: /* background: $feedback_link_bg; */
1.599 albertel 7665: font-size: larger;
7666: }
1.795 www 7667:
1.599 albertel 7668: span.LC_message_link {
1.858 bisitz 7669: /* background: $feedback_link_bg; */
1.599 albertel 7670: font-size: larger;
7671: position: absolute;
7672: right: 1em;
1.489 raeburn 7673: }
1.421 albertel 7674:
1.515 albertel 7675: table.LC_prior_tries {
1.524 albertel 7676: border: 1px solid #000000;
7677: border-collapse: separate;
7678: border-spacing: 1px;
1.515 albertel 7679: }
1.523 albertel 7680:
1.515 albertel 7681: table.LC_prior_tries td {
1.524 albertel 7682: padding: 2px;
1.515 albertel 7683: }
1.523 albertel 7684:
7685: .LC_answer_correct {
1.795 www 7686: background: lightgreen;
7687: color: darkgreen;
7688: padding: 6px;
1.523 albertel 7689: }
1.795 www 7690:
1.523 albertel 7691: .LC_answer_charged_try {
1.797 www 7692: background: #FFAAAA;
1.795 www 7693: color: darkred;
7694: padding: 6px;
1.523 albertel 7695: }
1.795 www 7696:
1.779 bisitz 7697: .LC_answer_not_charged_try,
1.523 albertel 7698: .LC_answer_no_grade,
7699: .LC_answer_late {
1.795 www 7700: background: lightyellow;
1.523 albertel 7701: color: black;
1.795 www 7702: padding: 6px;
1.523 albertel 7703: }
1.795 www 7704:
1.523 albertel 7705: .LC_answer_previous {
1.795 www 7706: background: lightblue;
7707: color: darkblue;
7708: padding: 6px;
1.523 albertel 7709: }
1.795 www 7710:
1.779 bisitz 7711: .LC_answer_no_message {
1.777 tempelho 7712: background: #FFFFFF;
7713: color: black;
1.795 www 7714: padding: 6px;
1.779 bisitz 7715: }
1.795 www 7716:
1.1334 raeburn 7717: .LC_answer_unknown,
7718: .LC_answer_warning {
1.779 bisitz 7719: background: orange;
7720: color: black;
1.795 www 7721: padding: 6px;
1.777 tempelho 7722: }
1.795 www 7723:
1.529 albertel 7724: span.LC_prior_numerical,
7725: span.LC_prior_string,
7726: span.LC_prior_custom,
7727: span.LC_prior_reaction,
7728: span.LC_prior_math {
1.925 bisitz 7729: font-family: $mono;
1.523 albertel 7730: white-space: pre;
7731: }
7732:
1.525 albertel 7733: span.LC_prior_string {
1.925 bisitz 7734: font-family: $mono;
1.525 albertel 7735: white-space: pre;
7736: }
7737:
1.523 albertel 7738: table.LC_prior_option {
7739: width: 100%;
7740: border-collapse: collapse;
7741: }
1.795 www 7742:
1.911 bisitz 7743: table.LC_prior_rank,
1.795 www 7744: table.LC_prior_match {
1.528 albertel 7745: border-collapse: collapse;
7746: }
1.795 www 7747:
1.528 albertel 7748: table.LC_prior_option tr td,
7749: table.LC_prior_rank tr td,
7750: table.LC_prior_match tr td {
1.524 albertel 7751: border: 1px solid #000000;
1.515 albertel 7752: }
7753:
1.855 bisitz 7754: .LC_nobreak {
1.544 albertel 7755: white-space: nowrap;
1.519 raeburn 7756: }
7757:
1.576 raeburn 7758: span.LC_cusr_emph {
7759: font-style: italic;
7760: }
7761:
1.633 raeburn 7762: span.LC_cusr_subheading {
7763: font-weight: normal;
7764: font-size: 85%;
7765: }
7766:
1.861 bisitz 7767: div.LC_docs_entry_move {
1.859 bisitz 7768: border: 1px solid #BBBBBB;
1.545 albertel 7769: background: #DDDDDD;
1.861 bisitz 7770: width: 22px;
1.859 bisitz 7771: padding: 1px;
7772: margin: 0;
1.545 albertel 7773: }
7774:
1.861 bisitz 7775: table.LC_data_table tr > td.LC_docs_entry_commands,
7776: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7777: font-size: x-small;
7778: }
1.795 www 7779:
1.861 bisitz 7780: .LC_docs_entry_parameter {
7781: white-space: nowrap;
7782: }
7783:
1.544 albertel 7784: .LC_docs_copy {
1.545 albertel 7785: color: #000099;
1.544 albertel 7786: }
1.795 www 7787:
1.544 albertel 7788: .LC_docs_cut {
1.545 albertel 7789: color: #550044;
1.544 albertel 7790: }
1.795 www 7791:
1.544 albertel 7792: .LC_docs_rename {
1.545 albertel 7793: color: #009900;
1.544 albertel 7794: }
1.795 www 7795:
1.544 albertel 7796: .LC_docs_remove {
1.545 albertel 7797: color: #990000;
7798: }
7799:
1.1284 raeburn 7800: .LC_docs_alias {
7801: color: #440055;
7802: }
7803:
1.1286 raeburn 7804: .LC_domprefs_email,
1.1284 raeburn 7805: .LC_docs_alias_name,
1.547 albertel 7806: .LC_docs_reinit_warn,
7807: .LC_docs_ext_edit {
7808: font-size: x-small;
7809: }
7810:
1.545 albertel 7811: table.LC_docs_adddocs td,
7812: table.LC_docs_adddocs th {
7813: border: 1px solid #BBBBBB;
7814: padding: 4px;
7815: background: #DDDDDD;
1.543 albertel 7816: }
7817:
1.584 albertel 7818: table.LC_sty_begin {
7819: background: #BBFFBB;
7820: }
1.795 www 7821:
1.584 albertel 7822: table.LC_sty_end {
7823: background: #FFBBBB;
7824: }
7825:
1.589 raeburn 7826: table.LC_double_column {
1.803 bisitz 7827: border-width: 0;
1.589 raeburn 7828: border-collapse: collapse;
7829: width: 100%;
7830: padding: 2px;
7831: }
7832:
7833: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7834: top: 2px;
1.589 raeburn 7835: left: 2px;
7836: width: 47%;
7837: vertical-align: top;
7838: }
7839:
7840: table.LC_double_column tr td.LC_right_col {
7841: top: 2px;
1.779 bisitz 7842: right: 2px;
1.589 raeburn 7843: width: 47%;
7844: vertical-align: top;
7845: }
7846:
1.591 raeburn 7847: div.LC_left_float {
7848: float: left;
7849: padding-right: 5%;
1.597 albertel 7850: padding-bottom: 4px;
1.591 raeburn 7851: }
7852:
7853: div.LC_clear_float_header {
1.597 albertel 7854: padding-bottom: 2px;
1.591 raeburn 7855: }
7856:
7857: div.LC_clear_float_footer {
1.597 albertel 7858: padding-top: 10px;
1.591 raeburn 7859: clear: both;
7860: }
7861:
1.597 albertel 7862: div.LC_grade_show_user {
1.941 bisitz 7863: /* border-left: 5px solid $sidebg; */
7864: border-top: 5px solid #000000;
7865: margin: 50px 0 0 0;
1.936 bisitz 7866: padding: 15px 0 5px 10px;
1.597 albertel 7867: }
1.795 www 7868:
1.936 bisitz 7869: div.LC_grade_show_user_odd_row {
1.941 bisitz 7870: /* border-left: 5px solid #000000; */
7871: }
7872:
7873: div.LC_grade_show_user div.LC_Box {
7874: margin-right: 50px;
1.597 albertel 7875: }
7876:
7877: div.LC_grade_submissions,
7878: div.LC_grade_message_center,
1.936 bisitz 7879: div.LC_grade_info_links {
1.597 albertel 7880: margin: 5px;
7881: width: 99%;
7882: background: #FFFFFF;
7883: }
1.795 www 7884:
1.597 albertel 7885: div.LC_grade_submissions_header,
1.936 bisitz 7886: div.LC_grade_message_center_header {
1.705 tempelho 7887: font-weight: bold;
7888: font-size: large;
1.597 albertel 7889: }
1.795 www 7890:
1.597 albertel 7891: div.LC_grade_submissions_body,
1.936 bisitz 7892: div.LC_grade_message_center_body {
1.597 albertel 7893: border: 1px solid black;
7894: width: 99%;
7895: background: #FFFFFF;
7896: }
1.795 www 7897:
1.613 albertel 7898: table.LC_scantron_action {
7899: width: 100%;
7900: }
1.795 www 7901:
1.613 albertel 7902: table.LC_scantron_action tr th {
1.698 harmsja 7903: font-weight:bold;
7904: font-style:normal;
1.613 albertel 7905: }
1.795 www 7906:
1.779 bisitz 7907: .LC_edit_problem_header,
1.614 albertel 7908: div.LC_edit_problem_footer {
1.705 tempelho 7909: font-weight: normal;
7910: font-size: medium;
1.602 albertel 7911: margin: 2px;
1.1060 bisitz 7912: background-color: $sidebg;
1.600 albertel 7913: }
1.795 www 7914:
1.600 albertel 7915: div.LC_edit_problem_header,
1.602 albertel 7916: div.LC_edit_problem_header div,
1.614 albertel 7917: div.LC_edit_problem_footer,
7918: div.LC_edit_problem_footer div,
1.602 albertel 7919: div.LC_edit_problem_editxml_header,
7920: div.LC_edit_problem_editxml_header div {
1.1205 golterma 7921: z-index: 100;
1.600 albertel 7922: }
1.795 www 7923:
1.600 albertel 7924: div.LC_edit_problem_header_title {
1.705 tempelho 7925: font-weight: bold;
7926: font-size: larger;
1.602 albertel 7927: background: $tabbg;
7928: padding: 3px;
1.1060 bisitz 7929: margin: 0 0 5px 0;
1.602 albertel 7930: }
1.795 www 7931:
1.602 albertel 7932: table.LC_edit_problem_header_title {
7933: width: 100%;
1.600 albertel 7934: background: $tabbg;
1.602 albertel 7935: }
7936:
1.1205 golterma 7937: div.LC_edit_actionbar {
7938: background-color: $sidebg;
1.1218 droeschl 7939: margin: 0;
7940: padding: 0;
7941: line-height: 200%;
1.602 albertel 7942: }
1.795 www 7943:
1.1218 droeschl 7944: div.LC_edit_actionbar div{
7945: padding: 0;
7946: margin: 0;
7947: display: inline-block;
1.600 albertel 7948: }
1.795 www 7949:
1.1124 bisitz 7950: .LC_edit_opt {
7951: padding-left: 1em;
7952: white-space: nowrap;
7953: }
7954:
1.1152 golterma 7955: .LC_edit_problem_latexhelper{
7956: text-align: right;
7957: }
7958:
7959: #LC_edit_problem_colorful div{
7960: margin-left: 40px;
7961: }
7962:
1.1205 golterma 7963: #LC_edit_problem_codemirror div{
7964: margin-left: 0px;
7965: }
7966:
1.911 bisitz 7967: img.stift {
1.803 bisitz 7968: border-width: 0;
7969: vertical-align: middle;
1.677 riegler 7970: }
1.680 riegler 7971:
1.923 bisitz 7972: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7973: vertical-align: top;
1.777 tempelho 7974: }
1.795 www 7975:
1.716 raeburn 7976: div.LC_createcourse {
1.911 bisitz 7977: margin: 10px 10px 10px 10px;
1.716 raeburn 7978: }
7979:
1.917 raeburn 7980: .LC_dccid {
1.1130 raeburn 7981: float: right;
1.917 raeburn 7982: margin: 0.2em 0 0 0;
7983: padding: 0;
7984: font-size: 90%;
7985: display:none;
7986: }
7987:
1.897 wenzelju 7988: ol.LC_primary_menu a:hover,
1.721 harmsja 7989: ol#LC_MenuBreadcrumbs a:hover,
7990: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7991: ul#LC_secondary_menu a:hover,
1.721 harmsja 7992: .LC_FormSectionClearButton input:hover
1.795 www 7993: ul.LC_TabContent li:hover a {
1.952 onken 7994: color:$button_hover;
1.911 bisitz 7995: text-decoration:none;
1.693 droeschl 7996: }
7997:
1.779 bisitz 7998: h1 {
1.911 bisitz 7999: padding: 0;
8000: line-height:130%;
1.693 droeschl 8001: }
1.698 harmsja 8002:
1.911 bisitz 8003: h2,
8004: h3,
8005: h4,
8006: h5,
8007: h6 {
8008: margin: 5px 0 5px 0;
8009: padding: 0;
8010: line-height:130%;
1.693 droeschl 8011: }
1.795 www 8012:
8013: .LC_hcell {
1.911 bisitz 8014: padding:3px 15px 3px 15px;
8015: margin: 0;
8016: background-color:$tabbg;
8017: color:$fontmenu;
8018: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 8019: }
1.795 www 8020:
1.840 bisitz 8021: .LC_Box > .LC_hcell {
1.911 bisitz 8022: margin: 0 -10px 10px -10px;
1.835 bisitz 8023: }
8024:
1.721 harmsja 8025: .LC_noBorder {
1.911 bisitz 8026: border: 0;
1.698 harmsja 8027: }
1.693 droeschl 8028:
1.721 harmsja 8029: .LC_FormSectionClearButton input {
1.911 bisitz 8030: background-color:transparent;
8031: border: none;
8032: cursor:pointer;
8033: text-decoration:underline;
1.693 droeschl 8034: }
1.763 bisitz 8035:
8036: .LC_help_open_topic {
1.911 bisitz 8037: color: #FFFFFF;
8038: background-color: #EEEEFF;
8039: margin: 1px;
8040: padding: 4px;
8041: border: 1px solid #000033;
8042: white-space: nowrap;
8043: /* vertical-align: middle; */
1.759 neumanie 8044: }
1.693 droeschl 8045:
1.911 bisitz 8046: dl,
8047: ul,
8048: div,
8049: fieldset {
8050: margin: 10px 10px 10px 0;
8051: /* overflow: hidden; */
1.693 droeschl 8052: }
1.795 www 8053:
1.1211 raeburn 8054: article.geogebraweb div {
8055: margin: 0;
8056: }
8057:
1.838 bisitz 8058: fieldset > legend {
1.911 bisitz 8059: font-weight: bold;
8060: padding: 0 5px 0 5px;
1.838 bisitz 8061: }
8062:
1.813 bisitz 8063: #LC_nav_bar {
1.911 bisitz 8064: float: left;
1.995 raeburn 8065: background-color: $pgbg_or_bgcolor;
1.966 bisitz 8066: margin: 0 0 2px 0;
1.807 droeschl 8067: }
8068:
1.916 droeschl 8069: #LC_realm {
8070: margin: 0.2em 0 0 0;
8071: padding: 0;
8072: font-weight: bold;
8073: text-align: center;
1.995 raeburn 8074: background-color: $pgbg_or_bgcolor;
1.916 droeschl 8075: }
8076:
1.911 bisitz 8077: #LC_nav_bar em {
8078: font-weight: bold;
8079: font-style: normal;
1.807 droeschl 8080: }
8081:
1.897 wenzelju 8082: ol.LC_primary_menu {
1.934 droeschl 8083: margin: 0;
1.1076 raeburn 8084: padding: 0;
1.807 droeschl 8085: }
8086:
1.852 droeschl 8087: ol#LC_PathBreadcrumbs {
1.911 bisitz 8088: margin: 0;
1.693 droeschl 8089: }
8090:
1.897 wenzelju 8091: ol.LC_primary_menu li {
1.1076 raeburn 8092: color: RGB(80, 80, 80);
8093: vertical-align: middle;
8094: text-align: left;
8095: list-style: none;
1.1205 golterma 8096: position: relative;
1.1076 raeburn 8097: float: left;
1.1205 golterma 8098: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
8099: line-height: 1.5em;
1.1076 raeburn 8100: }
8101:
1.1205 golterma 8102: ol.LC_primary_menu li a,
8103: ol.LC_primary_menu li p {
1.1076 raeburn 8104: display: block;
8105: margin: 0;
8106: padding: 0 5px 0 10px;
8107: text-decoration: none;
8108: }
8109:
1.1205 golterma 8110: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
8111: display: inline-block;
8112: width: 95%;
8113: text-align: left;
8114: }
8115:
8116: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
8117: display: inline-block;
8118: width: 5%;
8119: float: right;
8120: text-align: right;
8121: font-size: 70%;
8122: }
8123:
8124: ol.LC_primary_menu ul {
1.1076 raeburn 8125: display: none;
1.1205 golterma 8126: width: 15em;
1.1076 raeburn 8127: background-color: $data_table_light;
1.1205 golterma 8128: position: absolute;
8129: top: 100%;
1.1076 raeburn 8130: }
8131:
1.1205 golterma 8132: ol.LC_primary_menu ul ul {
8133: left: 100%;
8134: top: 0;
8135: }
8136:
8137: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1076 raeburn 8138: display: block;
8139: position: absolute;
8140: margin: 0;
8141: padding: 0;
1.1078 raeburn 8142: z-index: 2;
1.1076 raeburn 8143: }
8144:
8145: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1205 golterma 8146: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1076 raeburn 8147: font-size: 90%;
1.911 bisitz 8148: vertical-align: top;
1.1076 raeburn 8149: float: none;
1.1079 raeburn 8150: border-left: 1px solid black;
8151: border-right: 1px solid black;
1.1205 golterma 8152: /* A dark bottom border to visualize different menu options;
8153: overwritten in the create_submenu routine for the last border-bottom of the menu */
8154: border-bottom: 1px solid $data_table_dark;
1.1076 raeburn 8155: }
8156:
1.1205 golterma 8157: ol.LC_primary_menu li li p:hover {
8158: color:$button_hover;
8159: text-decoration:none;
8160: background-color:$data_table_dark;
1.1076 raeburn 8161: }
8162:
8163: ol.LC_primary_menu li li a:hover {
8164: color:$button_hover;
8165: background-color:$data_table_dark;
1.693 droeschl 8166: }
8167:
1.1205 golterma 8168: /* Font-size equal to the size of the predecessors*/
8169: ol.LC_primary_menu li:hover li li {
8170: font-size: 100%;
8171: }
8172:
1.897 wenzelju 8173: ol.LC_primary_menu li img {
1.911 bisitz 8174: vertical-align: bottom;
1.934 droeschl 8175: height: 1.1em;
1.1077 raeburn 8176: margin: 0.2em 0 0 0;
1.693 droeschl 8177: }
8178:
1.897 wenzelju 8179: ol.LC_primary_menu a {
1.911 bisitz 8180: color: RGB(80, 80, 80);
8181: text-decoration: none;
1.693 droeschl 8182: }
1.795 www 8183:
1.949 droeschl 8184: ol.LC_primary_menu a.LC_new_message {
8185: font-weight:bold;
8186: color: darkred;
8187: }
8188:
1.975 raeburn 8189: ol.LC_docs_parameters {
8190: margin-left: 0;
8191: padding: 0;
8192: list-style: none;
8193: }
8194:
8195: ol.LC_docs_parameters li {
8196: margin: 0;
8197: padding-right: 20px;
8198: display: inline;
8199: }
8200:
1.976 raeburn 8201: ol.LC_docs_parameters li:before {
8202: content: "\\002022 \\0020";
8203: }
8204:
8205: li.LC_docs_parameters_title {
8206: font-weight: bold;
8207: }
8208:
8209: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
8210: content: "";
8211: }
8212:
1.897 wenzelju 8213: ul#LC_secondary_menu {
1.1107 raeburn 8214: clear: right;
1.911 bisitz 8215: color: $fontmenu;
8216: background: $tabbg;
8217: list-style: none;
8218: padding: 0;
8219: margin: 0;
8220: width: 100%;
1.995 raeburn 8221: text-align: left;
1.1107 raeburn 8222: float: left;
1.808 droeschl 8223: }
8224:
1.897 wenzelju 8225: ul#LC_secondary_menu li {
1.911 bisitz 8226: font-weight: bold;
8227: line-height: 1.8em;
1.1107 raeburn 8228: border-right: 1px solid black;
8229: float: left;
8230: }
8231:
8232: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
8233: background-color: $data_table_light;
8234: }
8235:
8236: ul#LC_secondary_menu li a {
1.911 bisitz 8237: padding: 0 0.8em;
1.1107 raeburn 8238: }
8239:
8240: ul#LC_secondary_menu li ul {
8241: display: none;
8242: }
8243:
8244: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
8245: display: block;
8246: position: absolute;
8247: margin: 0;
8248: padding: 0;
8249: list-style:none;
8250: float: none;
8251: background-color: $data_table_light;
8252: z-index: 2;
8253: margin-left: -1px;
8254: }
8255:
8256: ul#LC_secondary_menu li ul li {
8257: font-size: 90%;
8258: vertical-align: top;
8259: border-left: 1px solid black;
1.911 bisitz 8260: border-right: 1px solid black;
1.1119 raeburn 8261: background-color: $data_table_light;
1.1107 raeburn 8262: list-style:none;
8263: float: none;
8264: }
8265:
8266: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
8267: background-color: $data_table_dark;
1.807 droeschl 8268: }
8269:
1.847 tempelho 8270: ul.LC_TabContent {
1.911 bisitz 8271: display:block;
8272: background: $sidebg;
8273: border-bottom: solid 1px $lg_border_color;
8274: list-style:none;
1.1020 raeburn 8275: margin: -1px -10px 0 -10px;
1.911 bisitz 8276: padding: 0;
1.693 droeschl 8277: }
8278:
1.795 www 8279: ul.LC_TabContent li,
8280: ul.LC_TabContentBigger li {
1.911 bisitz 8281: float:left;
1.741 harmsja 8282: }
1.795 www 8283:
1.897 wenzelju 8284: ul#LC_secondary_menu li a {
1.911 bisitz 8285: color: $fontmenu;
8286: text-decoration: none;
1.693 droeschl 8287: }
1.795 www 8288:
1.721 harmsja 8289: ul.LC_TabContent {
1.952 onken 8290: min-height:20px;
1.721 harmsja 8291: }
1.795 www 8292:
8293: ul.LC_TabContent li {
1.911 bisitz 8294: vertical-align:middle;
1.959 onken 8295: padding: 0 16px 0 10px;
1.911 bisitz 8296: background-color:$tabbg;
8297: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 8298: border-left: solid 1px $font;
1.721 harmsja 8299: }
1.795 www 8300:
1.847 tempelho 8301: ul.LC_TabContent .right {
1.911 bisitz 8302: float:right;
1.847 tempelho 8303: }
8304:
1.911 bisitz 8305: ul.LC_TabContent li a,
8306: ul.LC_TabContent li {
8307: color:rgb(47,47,47);
8308: text-decoration:none;
8309: font-size:95%;
8310: font-weight:bold;
1.952 onken 8311: min-height:20px;
8312: }
8313:
1.959 onken 8314: ul.LC_TabContent li a:hover,
8315: ul.LC_TabContent li a:focus {
1.952 onken 8316: color: $button_hover;
1.959 onken 8317: background:none;
8318: outline:none;
1.952 onken 8319: }
8320:
8321: ul.LC_TabContent li:hover {
8322: color: $button_hover;
8323: cursor:pointer;
1.721 harmsja 8324: }
1.795 www 8325:
1.911 bisitz 8326: ul.LC_TabContent li.active {
1.952 onken 8327: color: $font;
1.911 bisitz 8328: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 8329: border-bottom:solid 1px #FFFFFF;
8330: cursor: default;
1.744 ehlerst 8331: }
1.795 www 8332:
1.959 onken 8333: ul.LC_TabContent li.active a {
8334: color:$font;
8335: background:#FFFFFF;
8336: outline: none;
8337: }
1.1047 raeburn 8338:
8339: ul.LC_TabContent li.goback {
8340: float: left;
8341: border-left: none;
8342: }
8343:
1.870 tempelho 8344: #maincoursedoc {
1.911 bisitz 8345: clear:both;
1.870 tempelho 8346: }
8347:
8348: ul.LC_TabContentBigger {
1.911 bisitz 8349: display:block;
8350: list-style:none;
8351: padding: 0;
1.870 tempelho 8352: }
8353:
1.795 www 8354: ul.LC_TabContentBigger li {
1.911 bisitz 8355: vertical-align:bottom;
8356: height: 30px;
8357: font-size:110%;
8358: font-weight:bold;
8359: color: #737373;
1.841 tempelho 8360: }
8361:
1.957 onken 8362: ul.LC_TabContentBigger li.active {
8363: position: relative;
8364: top: 1px;
8365: }
8366:
1.870 tempelho 8367: ul.LC_TabContentBigger li a {
1.911 bisitz 8368: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
8369: height: 30px;
8370: line-height: 30px;
8371: text-align: center;
8372: display: block;
8373: text-decoration: none;
1.958 onken 8374: outline: none;
1.741 harmsja 8375: }
1.795 www 8376:
1.870 tempelho 8377: ul.LC_TabContentBigger li.active a {
1.911 bisitz 8378: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
8379: color:$font;
1.744 ehlerst 8380: }
1.795 www 8381:
1.870 tempelho 8382: ul.LC_TabContentBigger li b {
1.911 bisitz 8383: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
8384: display: block;
8385: float: left;
8386: padding: 0 30px;
1.957 onken 8387: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 8388: }
8389:
1.956 onken 8390: ul.LC_TabContentBigger li:hover b {
8391: color:$button_hover;
8392: }
8393:
1.870 tempelho 8394: ul.LC_TabContentBigger li.active b {
1.911 bisitz 8395: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
8396: color:$font;
1.957 onken 8397: border: 0;
1.741 harmsja 8398: }
1.693 droeschl 8399:
1.870 tempelho 8400:
1.862 bisitz 8401: ul.LC_CourseBreadcrumbs {
8402: background: $sidebg;
1.1020 raeburn 8403: height: 2em;
1.862 bisitz 8404: padding-left: 10px;
1.1020 raeburn 8405: margin: 0;
1.862 bisitz 8406: list-style-position: inside;
8407: }
8408:
1.911 bisitz 8409: ol#LC_MenuBreadcrumbs,
1.862 bisitz 8410: ol#LC_PathBreadcrumbs {
1.911 bisitz 8411: padding-left: 10px;
8412: margin: 0;
1.933 droeschl 8413: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 8414: }
8415:
1.911 bisitz 8416: ol#LC_MenuBreadcrumbs li,
8417: ol#LC_PathBreadcrumbs li,
1.862 bisitz 8418: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 8419: display: inline;
1.933 droeschl 8420: white-space: normal;
1.693 droeschl 8421: }
8422:
1.823 bisitz 8423: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 8424: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 8425: text-decoration: none;
8426: font-size:90%;
1.693 droeschl 8427: }
1.795 www 8428:
1.969 droeschl 8429: ol#LC_MenuBreadcrumbs h1 {
8430: display: inline;
8431: font-size: 90%;
8432: line-height: 2.5em;
8433: margin: 0;
8434: padding: 0;
8435: }
8436:
1.795 www 8437: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 8438: text-decoration:none;
8439: font-size:100%;
8440: font-weight:bold;
1.693 droeschl 8441: }
1.795 www 8442:
1.840 bisitz 8443: .LC_Box {
1.911 bisitz 8444: border: solid 1px $lg_border_color;
8445: padding: 0 10px 10px 10px;
1.746 neumanie 8446: }
1.795 www 8447:
1.1020 raeburn 8448: .LC_DocsBox {
8449: border: solid 1px $lg_border_color;
8450: padding: 0 0 10px 10px;
8451: }
8452:
1.795 www 8453: .LC_AboutMe_Image {
1.911 bisitz 8454: float:left;
8455: margin-right:10px;
1.747 neumanie 8456: }
1.795 www 8457:
8458: .LC_Clear_AboutMe_Image {
1.911 bisitz 8459: clear:left;
1.747 neumanie 8460: }
1.795 www 8461:
1.721 harmsja 8462: dl.LC_ListStyleClean dt {
1.911 bisitz 8463: padding-right: 5px;
8464: display: table-header-group;
1.693 droeschl 8465: }
8466:
1.721 harmsja 8467: dl.LC_ListStyleClean dd {
1.911 bisitz 8468: display: table-row;
1.693 droeschl 8469: }
8470:
1.721 harmsja 8471: .LC_ListStyleClean,
8472: .LC_ListStyleSimple,
8473: .LC_ListStyleNormal,
1.795 www 8474: .LC_ListStyleSpecial {
1.911 bisitz 8475: /* display:block; */
8476: list-style-position: inside;
8477: list-style-type: none;
8478: overflow: hidden;
8479: padding: 0;
1.693 droeschl 8480: }
8481:
1.721 harmsja 8482: .LC_ListStyleSimple li,
8483: .LC_ListStyleSimple dd,
8484: .LC_ListStyleNormal li,
8485: .LC_ListStyleNormal dd,
8486: .LC_ListStyleSpecial li,
1.795 www 8487: .LC_ListStyleSpecial dd {
1.911 bisitz 8488: margin: 0;
8489: padding: 5px 5px 5px 10px;
8490: clear: both;
1.693 droeschl 8491: }
8492:
1.721 harmsja 8493: .LC_ListStyleClean li,
8494: .LC_ListStyleClean dd {
1.911 bisitz 8495: padding-top: 0;
8496: padding-bottom: 0;
1.693 droeschl 8497: }
8498:
1.721 harmsja 8499: .LC_ListStyleSimple dd,
1.795 www 8500: .LC_ListStyleSimple li {
1.911 bisitz 8501: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 8502: }
8503:
1.721 harmsja 8504: .LC_ListStyleSpecial li,
8505: .LC_ListStyleSpecial dd {
1.911 bisitz 8506: list-style-type: none;
8507: background-color: RGB(220, 220, 220);
8508: margin-bottom: 4px;
1.693 droeschl 8509: }
8510:
1.721 harmsja 8511: table.LC_SimpleTable {
1.911 bisitz 8512: margin:5px;
8513: border:solid 1px $lg_border_color;
1.795 www 8514: }
1.693 droeschl 8515:
1.721 harmsja 8516: table.LC_SimpleTable tr {
1.911 bisitz 8517: padding: 0;
8518: border:solid 1px $lg_border_color;
1.693 droeschl 8519: }
1.795 www 8520:
8521: table.LC_SimpleTable thead {
1.911 bisitz 8522: background:rgb(220,220,220);
1.693 droeschl 8523: }
8524:
1.721 harmsja 8525: div.LC_columnSection {
1.911 bisitz 8526: display: block;
8527: clear: both;
8528: overflow: hidden;
8529: margin: 0;
1.693 droeschl 8530: }
8531:
1.721 harmsja 8532: div.LC_columnSection>* {
1.911 bisitz 8533: float: left;
8534: margin: 10px 20px 10px 0;
8535: overflow:hidden;
1.693 droeschl 8536: }
1.721 harmsja 8537:
1.795 www 8538: table em {
1.911 bisitz 8539: font-weight: bold;
8540: font-style: normal;
1.748 schulted 8541: }
1.795 www 8542:
1.779 bisitz 8543: table.LC_tableBrowseRes,
1.795 www 8544: table.LC_tableOfContent {
1.911 bisitz 8545: border:none;
8546: border-spacing: 1px;
8547: padding: 3px;
8548: background-color: #FFFFFF;
8549: font-size: 90%;
1.753 droeschl 8550: }
1.789 droeschl 8551:
1.911 bisitz 8552: table.LC_tableOfContent {
8553: border-collapse: collapse;
1.789 droeschl 8554: }
8555:
1.771 droeschl 8556: table.LC_tableBrowseRes a,
1.768 schulted 8557: table.LC_tableOfContent a {
1.911 bisitz 8558: background-color: transparent;
8559: text-decoration: none;
1.753 droeschl 8560: }
8561:
1.795 www 8562: table.LC_tableOfContent img {
1.911 bisitz 8563: border: none;
8564: height: 1.3em;
8565: vertical-align: text-bottom;
8566: margin-right: 0.3em;
1.753 droeschl 8567: }
1.757 schulted 8568:
1.795 www 8569: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8570: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8571: }
8572:
1.795 www 8573: a#LC_content_toolbar_everything {
1.911 bisitz 8574: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8575: }
8576:
1.795 www 8577: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8578: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8579: }
8580:
1.795 www 8581: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8582: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8583: }
8584:
1.795 www 8585: a#LC_content_toolbar_changefolder {
1.911 bisitz 8586: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8587: }
8588:
1.795 www 8589: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8590: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8591: }
8592:
1.1043 raeburn 8593: a#LC_content_toolbar_edittoplevel {
8594: background-image:url(/res/adm/pages/edittoplevel.gif);
8595: }
8596:
1.1384 raeburn 8597: a#LC_content_toolbar_printout {
8598: background-image:url(/res/adm/pages/printout.gif);
8599: }
8600:
1.795 www 8601: ul#LC_toolbar li a:hover {
1.911 bisitz 8602: background-position: bottom center;
1.757 schulted 8603: }
8604:
1.795 www 8605: ul#LC_toolbar {
1.911 bisitz 8606: padding: 0;
8607: margin: 2px;
8608: list-style:none;
8609: position:relative;
8610: background-color:white;
1.1082 raeburn 8611: overflow: auto;
1.757 schulted 8612: }
8613:
1.795 www 8614: ul#LC_toolbar li {
1.911 bisitz 8615: border:1px solid white;
8616: padding: 0;
8617: margin: 0;
8618: float: left;
8619: display:inline;
8620: vertical-align:middle;
1.1082 raeburn 8621: white-space: nowrap;
1.911 bisitz 8622: }
1.757 schulted 8623:
1.783 amueller 8624:
1.795 www 8625: a.LC_toolbarItem {
1.911 bisitz 8626: display:block;
8627: padding: 0;
8628: margin: 0;
8629: height: 32px;
8630: width: 32px;
8631: color:white;
8632: border: none;
8633: background-repeat:no-repeat;
8634: background-color:transparent;
1.757 schulted 8635: }
8636:
1.915 droeschl 8637: ul.LC_funclist {
8638: margin: 0;
8639: padding: 0.5em 1em 0.5em 0;
8640: }
8641:
1.933 droeschl 8642: ul.LC_funclist > li:first-child {
8643: font-weight:bold;
8644: margin-left:0.8em;
8645: }
8646:
1.915 droeschl 8647: ul.LC_funclist + ul.LC_funclist {
8648: /*
8649: left border as a seperator if we have more than
8650: one list
8651: */
8652: border-left: 1px solid $sidebg;
8653: /*
8654: this hides the left border behind the border of the
8655: outer box if element is wrapped to the next 'line'
8656: */
8657: margin-left: -1px;
8658: }
8659:
1.843 bisitz 8660: ul.LC_funclist li {
1.915 droeschl 8661: display: inline;
1.782 bisitz 8662: white-space: nowrap;
1.915 droeschl 8663: margin: 0 0 0 25px;
8664: line-height: 150%;
1.782 bisitz 8665: }
8666:
1.974 wenzelju 8667: .LC_hidden {
8668: display: none;
8669: }
8670:
1.1030 www 8671: .LCmodal-overlay {
8672: position:fixed;
8673: top:0;
8674: right:0;
8675: bottom:0;
8676: left:0;
8677: height:100%;
8678: width:100%;
8679: margin:0;
8680: padding:0;
8681: background:#999;
8682: opacity:.75;
8683: filter: alpha(opacity=75);
8684: -moz-opacity: 0.75;
8685: z-index:101;
8686: }
8687:
8688: * html .LCmodal-overlay {
8689: position: absolute;
8690: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8691: }
8692:
8693: .LCmodal-window {
8694: position:fixed;
8695: top:50%;
8696: left:50%;
8697: margin:0;
8698: padding:0;
8699: z-index:102;
8700: }
8701:
8702: * html .LCmodal-window {
8703: position:absolute;
8704: }
8705:
8706: .LCclose-window {
8707: position:absolute;
8708: width:32px;
8709: height:32px;
8710: right:8px;
8711: top:8px;
8712: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8713: text-indent:-99999px;
8714: overflow:hidden;
8715: cursor:pointer;
8716: }
8717:
1.1369 raeburn 8718: .LCisDisabled {
8719: cursor: not-allowed;
8720: opacity: 0.5;
8721: }
8722:
8723: a[aria-disabled="true"] {
8724: color: currentColor;
8725: display: inline-block; /* For IE11/ MS Edge bug */
8726: pointer-events: none;
8727: text-decoration: none;
8728: }
8729:
1.1335 raeburn 8730: pre.LC_wordwrap {
8731: white-space: pre-wrap;
8732: white-space: -moz-pre-wrap;
8733: white-space: -pre-wrap;
8734: white-space: -o-pre-wrap;
8735: word-wrap: break-word;
8736: }
8737:
1.1100 raeburn 8738: /*
1.1231 damieng 8739: styles used for response display
8740: */
8741: div.LC_radiofoil, div.LC_rankfoil {
8742: margin: .5em 0em .5em 0em;
8743: }
8744: table.LC_itemgroup {
8745: margin-top: 1em;
8746: }
8747:
8748: /*
1.1100 raeburn 8749: styles used by TTH when "Default set of options to pass to tth/m
8750: when converting TeX" in course settings has been set
8751:
8752: option passed: -t
8753:
8754: */
8755:
8756: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8757: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8758: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8759: td div.norm {line-height:normal;}
8760:
8761: /*
8762: option passed -y3
8763: */
8764:
8765: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8766: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8767: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8768:
1.1230 damieng 8769: /*
8770: sections with roles, for content only
8771: */
8772: section[class^="role-"] {
8773: padding-left: 10px;
8774: padding-right: 5px;
8775: margin-top: 8px;
8776: margin-bottom: 8px;
8777: border: 1px solid #2A4;
8778: border-radius: 5px;
8779: box-shadow: 0px 1px 1px #BBB;
8780: }
8781: section[class^="role-"]>h1 {
8782: position: relative;
8783: margin: 0px;
8784: padding-top: 10px;
8785: padding-left: 40px;
8786: }
8787: section[class^="role-"]>h1:before {
8788: position: absolute;
8789: left: -5px;
8790: top: 5px;
8791: }
8792: section.role-activity>h1:before {
8793: content:url('/adm/daxe/images/section_icons/activity.png');
8794: }
8795: section.role-advice>h1:before {
8796: content:url('/adm/daxe/images/section_icons/advice.png');
8797: }
8798: section.role-bibliography>h1:before {
8799: content:url('/adm/daxe/images/section_icons/bibliography.png');
8800: }
8801: section.role-citation>h1:before {
8802: content:url('/adm/daxe/images/section_icons/citation.png');
8803: }
8804: section.role-conclusion>h1:before {
8805: content:url('/adm/daxe/images/section_icons/conclusion.png');
8806: }
8807: section.role-definition>h1:before {
8808: content:url('/adm/daxe/images/section_icons/definition.png');
8809: }
8810: section.role-demonstration>h1:before {
8811: content:url('/adm/daxe/images/section_icons/demonstration.png');
8812: }
8813: section.role-example>h1:before {
8814: content:url('/adm/daxe/images/section_icons/example.png');
8815: }
8816: section.role-explanation>h1:before {
8817: content:url('/adm/daxe/images/section_icons/explanation.png');
8818: }
8819: section.role-introduction>h1:before {
8820: content:url('/adm/daxe/images/section_icons/introduction.png');
8821: }
8822: section.role-method>h1:before {
8823: content:url('/adm/daxe/images/section_icons/method.png');
8824: }
8825: section.role-more_information>h1:before {
8826: content:url('/adm/daxe/images/section_icons/more_information.png');
8827: }
8828: section.role-objectives>h1:before {
8829: content:url('/adm/daxe/images/section_icons/objectives.png');
8830: }
8831: section.role-prerequisites>h1:before {
8832: content:url('/adm/daxe/images/section_icons/prerequisites.png');
8833: }
8834: section.role-remark>h1:before {
8835: content:url('/adm/daxe/images/section_icons/remark.png');
8836: }
8837: section.role-reminder>h1:before {
8838: content:url('/adm/daxe/images/section_icons/reminder.png');
8839: }
8840: section.role-summary>h1:before {
8841: content:url('/adm/daxe/images/section_icons/summary.png');
8842: }
8843: section.role-syntax>h1:before {
8844: content:url('/adm/daxe/images/section_icons/syntax.png');
8845: }
8846: section.role-warning>h1:before {
8847: content:url('/adm/daxe/images/section_icons/warning.png');
8848: }
8849:
1.1269 raeburn 8850: #LC_minitab_header {
8851: float:left;
8852: width:100%;
8853: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8854: font-size:93%;
8855: line-height:normal;
8856: margin: 0.5em 0 0.5em 0;
8857: }
8858: #LC_minitab_header ul {
8859: margin:0;
8860: padding:10px 10px 0;
8861: list-style:none;
8862: }
8863: #LC_minitab_header li {
8864: float:left;
8865: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8866: margin:0;
8867: padding:0 0 0 9px;
8868: }
8869: #LC_minitab_header a {
8870: display:block;
8871: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8872: padding:5px 15px 4px 6px;
8873: }
8874: #LC_minitab_header #LC_current_minitab {
8875: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8876: }
8877: #LC_minitab_header #LC_current_minitab a {
8878: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8879: padding-bottom:5px;
8880: }
8881:
8882:
1.343 albertel 8883: END
8884: }
8885:
1.306 albertel 8886: =pod
8887:
8888: =item * &headtag()
8889:
8890: Returns a uniform footer for LON-CAPA web pages.
8891:
1.307 albertel 8892: Inputs: $title - optional title for the head
8893: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8894: $args - optional arguments
1.319 albertel 8895: force_register - if is true call registerurl so the remote is
8896: informed
1.415 albertel 8897: redirect -> array ref of
8898: 1- seconds before redirect occurs
8899: 2- url to redirect to
8900: 3- whether the side effect should occur
1.315 albertel 8901: (side effect of setting
8902: $env{'internal.head.redirect'} to the url
1.1386 raeburn 8903: redirected to)
8904: 4- whether the redirect target should be
8905: the opener of the current (pop-up)
8906: window (side effect of setting
8907: $env{'internal.head.to_opener'} to
8908: 1, if true.
1.1388 raeburn 8909: 5- whether encrypt check should be skipped
1.352 albertel 8910: domain -> force to color decorate a page for a specific
8911: domain
8912: function -> force usage of a specific rolish color scheme
8913: bgcolor -> override the default page bgcolor
1.460 albertel 8914: no_auto_mt_title
8915: -> prevent &mt()ing the title arg
1.464 albertel 8916:
1.306 albertel 8917: =cut
8918:
8919: sub headtag {
1.313 albertel 8920: my ($title,$head_extra,$args) = @_;
1.306 albertel 8921:
1.363 albertel 8922: my $function = $args->{'function'} || &get_users_function();
8923: my $domain = $args->{'domain'} || &determinedomain();
8924: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 8925: my $httphost = $args->{'use_absolute'};
1.418 albertel 8926: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8927: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8928: #time(),
1.418 albertel 8929: $env{'environment.color.timestamp'},
1.363 albertel 8930: $function,$domain,$bgcolor);
8931:
1.369 www 8932: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8933:
1.308 albertel 8934: my $result =
8935: '<head>'.
1.1160 raeburn 8936: &font_settings($args);
1.319 albertel 8937:
1.1188 raeburn 8938: my $inhibitprint;
8939: if ($args->{'print_suppress'}) {
8940: $inhibitprint = &print_suppression();
8941: }
1.1064 raeburn 8942:
1.461 albertel 8943: if (!$args->{'frameset'}) {
8944: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8945: }
1.962 droeschl 8946: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
8947: $result .= Apache::lonxml::display_title();
1.319 albertel 8948: }
1.436 albertel 8949: if (!$args->{'no_nav_bar'}
8950: && !$args->{'only_body'}
8951: && !$args->{'frameset'}) {
1.1154 raeburn 8952: $result .= &help_menu_js($httphost);
1.1032 www 8953: $result.=&modal_window();
1.1038 www 8954: $result.=&togglebox_script();
1.1034 www 8955: $result.=&wishlist_window();
1.1041 www 8956: $result.=&LCprogressbarUpdate_script();
1.1034 www 8957: } else {
8958: if ($args->{'add_modal'}) {
8959: $result.=&modal_window();
8960: }
8961: if ($args->{'add_wishlist'}) {
8962: $result.=&wishlist_window();
8963: }
1.1038 www 8964: if ($args->{'add_togglebox'}) {
8965: $result.=&togglebox_script();
8966: }
1.1041 www 8967: if ($args->{'add_progressbar'}) {
8968: $result.=&LCprogressbarUpdate_script();
8969: }
1.436 albertel 8970: }
1.314 albertel 8971: if (ref($args->{'redirect'})) {
1.1388 raeburn 8972: my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
8973: if (!$skip_enc_check) {
8974: $url = &Apache::lonenc::check_encrypt($url);
8975: }
1.414 albertel 8976: if (!$inhibit_continue) {
8977: $env{'internal.head.redirect'} = $url;
8978: }
1.1386 raeburn 8979: $result.=<<"ADDMETA";
1.313 albertel 8980: <meta http-equiv="pragma" content="no-cache" />
1.1386 raeburn 8981: ADDMETA
8982: if ($to_opener) {
8983: $env{'internal.head.to_opener'} = 1;
8984: my $dest = &js_escape($url);
8985: my $timeout = int($time * 1000);
8986: $result .=<<"ENDJS";
8987: <script type="text/javascript">
8988: // <![CDATA[
8989: function LC_To_Opener() {
8990: var dest = '$dest';
8991: if (dest != '') {
8992: if (window.opener != null && !window.opener.closed) {
8993: window.opener.location.href=dest;
8994: window.close();
8995: } else {
8996: window.location.href=dest;
8997: }
8998: }
8999: }
9000: \$(document).ready(function () {
9001: setTimeout('LC_To_Opener()',$timeout);
9002: });
9003: // ]]>
9004: </script>
9005: ENDJS
9006: } else {
9007: $result.=<<"ADDMETA";
1.344 albertel 9008: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 9009: ADDMETA
1.1386 raeburn 9010: }
1.1210 raeburn 9011: } else {
9012: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
9013: my $requrl = $env{'request.uri'};
9014: if ($requrl eq '') {
9015: $requrl = $ENV{'REQUEST_URI'};
9016: $requrl =~ s/\?.+$//;
9017: }
9018: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
9019: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
9020: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
9021: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
9022: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
9023: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1340 raeburn 9024: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1352 raeburn 9025: my ($offload,$offloadoth);
1.1210 raeburn 9026: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
9027: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1340 raeburn 9028: $offload = 1;
1.1353 raeburn 9029: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
9030: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
9031: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
9032: $offloadoth = 1;
9033: $dom_in_use = $env{'user.domain'};
9034: }
9035: }
1.1340 raeburn 9036: }
9037: }
9038: unless ($offload) {
9039: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
9040: if ($domdefs{'offloadoth'}{$lonhost}) {
9041: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
9042: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
9043: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
9044: $offload = 1;
1.1352 raeburn 9045: $offloadoth = 1;
1.1340 raeburn 9046: $dom_in_use = $env{'user.domain'};
9047: }
1.1210 raeburn 9048: }
1.1340 raeburn 9049: }
9050: }
9051: }
9052: if ($offload) {
1.1358 raeburn 9053: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1352 raeburn 9054: if (($newserver eq '') && ($offloadoth)) {
9055: my @domains = &Apache::lonnet::current_machine_domains();
9056: if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
9057: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
9058: }
9059: }
1.1340 raeburn 9060: if (($newserver) && ($newserver ne $lonhost)) {
9061: my $numsec = 5;
9062: my $timeout = $numsec * 1000;
9063: my ($newurl,$locknum,%locks,$msg);
9064: if ($env{'request.role.adv'}) {
9065: ($locknum,%locks) = &Apache::lonnet::get_locks();
9066: }
9067: my $disable_submit = 0;
9068: if ($requrl =~ /$LONCAPA::assess_re/) {
9069: $disable_submit = 1;
9070: }
9071: if ($locknum) {
9072: my @lockinfo = sort(values(%locks));
1.1354 raeburn 9073: $msg = &mt('Once the following tasks are complete:')." \n".
1.1340 raeburn 9074: join(", ",sort(values(%locks)))."\n";
9075: if (&show_course()) {
9076: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
9077: } else {
9078: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
1.1210 raeburn 9079: }
1.1340 raeburn 9080: } else {
9081: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
9082: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
9083: }
9084: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
9085: $newurl = '/adm/switchserver?otherserver='.$newserver;
9086: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
9087: $newurl .= '&role='.$env{'request.role'};
9088: }
9089: if ($env{'request.symb'}) {
9090: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
9091: if ($shownsymb =~ m{^/enc/}) {
9092: my $reqdmajor = 2;
9093: my $reqdminor = 11;
9094: my $reqdsubminor = 3;
9095: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
9096: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
9097: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
9098: if (($major eq '' && $minor eq '') ||
9099: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
9100: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
9101: ($reqdsubminor > $subminor))))) {
9102: undef($shownsymb);
9103: }
1.1210 raeburn 9104: }
1.1340 raeburn 9105: if ($shownsymb) {
9106: &js_escape(\$shownsymb);
9107: $newurl .= '&symb='.$shownsymb;
1.1210 raeburn 9108: }
1.1340 raeburn 9109: } else {
9110: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
9111: &js_escape(\$shownurl);
9112: $newurl .= '&origurl='.$shownurl;
1.1210 raeburn 9113: }
1.1340 raeburn 9114: }
9115: &js_escape(\$msg);
9116: $result.=<<OFFLOAD
1.1210 raeburn 9117: <meta http-equiv="pragma" content="no-cache" />
9118: <script type="text/javascript">
1.1215 raeburn 9119: // <![CDATA[
1.1210 raeburn 9120: function LC_Offload_Now() {
9121: var dest = "$newurl";
9122: if (dest != '') {
9123: window.location.href="$newurl";
9124: }
9125: }
1.1214 raeburn 9126: \$(document).ready(function () {
9127: window.alert('$msg');
9128: if ($disable_submit) {
1.1210 raeburn 9129: \$(".LC_hwk_submit").prop("disabled", true);
9130: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1214 raeburn 9131: }
9132: setTimeout('LC_Offload_Now()', $timeout);
9133: });
1.1215 raeburn 9134: // ]]>
1.1210 raeburn 9135: </script>
9136: OFFLOAD
9137: }
9138: }
9139: }
9140: }
9141: }
1.313 albertel 9142: }
1.306 albertel 9143: if (!defined($title)) {
9144: $title = 'The LearningOnline Network with CAPA';
9145: }
1.460 albertel 9146: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
9147: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 9148: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
9149: if (!$args->{'frameset'}) {
9150: $result .= ' /';
9151: }
9152: $result .= '>'
1.1064 raeburn 9153: .$inhibitprint
1.414 albertel 9154: .$head_extra;
1.1242 raeburn 9155: my $clientmobile;
9156: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
9157: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
9158: } else {
9159: $clientmobile = $env{'browser.mobile'};
9160: }
9161: if ($clientmobile) {
1.1137 raeburn 9162: $result .= '
9163: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
9164: <meta name="apple-mobile-web-app-capable" content="yes" />';
9165: }
1.1278 raeburn 9166: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 9167: return $result.'</head>';
1.306 albertel 9168: }
9169:
9170: =pod
9171:
1.340 albertel 9172: =item * &font_settings()
9173:
9174: Returns neccessary <meta> to set the proper encoding
9175:
1.1160 raeburn 9176: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 9177:
9178: =cut
9179:
9180: sub font_settings {
1.1160 raeburn 9181: my ($args) = @_;
1.340 albertel 9182: my $headerstring='';
1.1160 raeburn 9183: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
9184: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 9185: $headerstring.=
9186: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
9187: if (!$args->{'frameset'}) {
9188: $headerstring.= ' /';
9189: }
9190: $headerstring .= '>'."\n";
1.340 albertel 9191: }
9192: return $headerstring;
9193: }
9194:
1.341 albertel 9195: =pod
9196:
1.1064 raeburn 9197: =item * &print_suppression()
9198:
9199: In course context returns css which causes the body to be blank when media="print",
9200: if printout generation is unavailable for the current resource.
9201:
9202: This could be because:
9203:
9204: (a) printstartdate is in the future
9205:
9206: (b) printenddate is in the past
9207:
9208: (c) there is an active exam block with "printout"
9209: functionality blocked
9210:
9211: Users with pav, pfo or evb privileges are exempt.
9212:
9213: Inputs: none
9214:
9215: =cut
9216:
9217:
9218: sub print_suppression {
9219: my $noprint;
9220: if ($env{'request.course.id'}) {
9221: my $scope = $env{'request.course.id'};
9222: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9223: (&Apache::lonnet::allowed('pfo',$scope))) {
9224: return;
9225: }
9226: if ($env{'request.course.sec'} ne '') {
9227: $scope .= "/$env{'request.course.sec'}";
9228: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9229: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 9230: return;
1.1064 raeburn 9231: }
9232: }
9233: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9234: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 9235: my $clientip = &Apache::lonnet::get_requestor_ip();
9236: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 9237: if ($blocked) {
9238: my $checkrole = "cm./$cdom/$cnum";
9239: if ($env{'request.course.sec'} ne '') {
9240: $checkrole .= "/$env{'request.course.sec'}";
9241: }
9242: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
9243: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
9244: $noprint = 1;
9245: }
9246: }
9247: unless ($noprint) {
9248: my $symb = &Apache::lonnet::symbread();
9249: if ($symb ne '') {
9250: my $navmap = Apache::lonnavmaps::navmap->new();
9251: if (ref($navmap)) {
9252: my $res = $navmap->getBySymb($symb);
9253: if (ref($res)) {
9254: if (!$res->resprintable()) {
9255: $noprint = 1;
9256: }
9257: }
9258: }
9259: }
9260: }
9261: if ($noprint) {
9262: return <<"ENDSTYLE";
9263: <style type="text/css" media="print">
9264: body { display:none }
9265: </style>
9266: ENDSTYLE
9267: }
9268: }
9269: return;
9270: }
9271:
9272: =pod
9273:
1.341 albertel 9274: =item * &xml_begin()
9275:
9276: Returns the needed doctype and <html>
9277:
9278: Inputs: none
9279:
9280: =cut
9281:
9282: sub xml_begin {
1.1168 raeburn 9283: my ($is_frameset) = @_;
1.341 albertel 9284: my $output='';
9285:
9286: if ($env{'browser.mathml'}) {
9287: $output='<?xml version="1.0"?>'
9288: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
9289: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
9290:
9291: # .'<!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">] >'
9292: .'<!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">'
9293: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
9294: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 9295: } elsif ($is_frameset) {
9296: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
9297: '<html>'."\n";
1.341 albertel 9298: } else {
1.1168 raeburn 9299: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
9300: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 9301: }
9302: return $output;
9303: }
1.340 albertel 9304:
9305: =pod
9306:
1.306 albertel 9307: =item * &start_page()
9308:
9309: Returns a complete <html> .. <body> section for LON-CAPA web pages.
9310:
1.648 raeburn 9311: Inputs:
9312:
9313: =over 4
9314:
9315: $title - optional title for the page
9316:
9317: $head_extra - optional extra HTML to incude inside the <head>
9318:
9319: $args - additional optional args supported are:
9320:
9321: =over 8
9322:
9323: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 9324: arg on
1.814 bisitz 9325: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 9326: add_entries -> additional attributes to add to the <body>
9327: domain -> force to color decorate a page for a
1.317 albertel 9328: specific domain
1.648 raeburn 9329: function -> force usage of a specific rolish color
1.317 albertel 9330: scheme
1.648 raeburn 9331: redirect -> see &headtag()
9332: bgcolor -> override the default page bg color
9333: js_ready -> return a string ready for being used in
1.317 albertel 9334: a javascript writeln
1.648 raeburn 9335: html_encode -> return a string ready for being used in
1.320 albertel 9336: a html attribute
1.648 raeburn 9337: force_register -> if is true will turn on the &bodytag()
1.317 albertel 9338: $forcereg arg
1.648 raeburn 9339: frameset -> if true will start with a <frameset>
1.330 albertel 9340: rather than <body>
1.648 raeburn 9341: skip_phases -> hash ref of
1.338 albertel 9342: head -> skip the <html><head> generation
9343: body -> skip all <body> generation
1.648 raeburn 9344: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 9345: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 9346: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1272 raeburn 9347: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
9348: to lonhtmlcommon::breadcrumbs
1.1096 raeburn 9349: group -> includes the current group, if page is for a
1.1274 raeburn 9350: specific group
9351: use_absolute -> for request for external resource or syllabus, this
9352: will contain https://<hostname> if server uses
9353: https (as per hosts.tab), but request is for http
9354: hostname -> hostname, originally from $r->hostname(), (optional).
1.1369 raeburn 9355: links_disabled -> Links in primary and secondary menus are disabled
9356: (Can enable them once page has loaded - see lonroles.pm
9357: for an example).
1.1380 raeburn 9358: links_target -> Target for links, e.g., _parent (optional).
1.361 albertel 9359:
1.648 raeburn 9360: =back
1.460 albertel 9361:
1.648 raeburn 9362: =back
1.562 albertel 9363:
1.306 albertel 9364: =cut
9365:
9366: sub start_page {
1.309 albertel 9367: my ($title,$head_extra,$args) = @_;
1.318 albertel 9368: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 9369:
1.315 albertel 9370: $env{'internal.start_page'}++;
1.1359 raeburn 9371: my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964 droeschl 9372:
1.338 albertel 9373: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 9374: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 9375: }
1.1316 raeburn 9376:
9377: if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
1.1318 raeburn 9378: if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
9379: unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
9380: $args->{'no_primary_menu'} = 1;
9381: }
9382: unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
9383: $args->{'no_inline_menu'} = 1;
9384: }
9385: if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
9386: map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
9387: }
9388: } else {
9389: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9390: my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
9391: if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
9392: unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
9393: $args->{'no_primary_menu'} = 1;
9394: }
9395: unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
9396: $args->{'no_inline_menu'} = 1;
9397: }
9398: if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
9399: map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
9400: }
9401: }
9402: }
1.1316 raeburn 9403: ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
9404: $env{'course.'.$env{'request.course.id'}.'.domain'},
9405: $env{'course.'.$env{'request.course.id'}.'.num'});
1.1359 raeburn 9406: } elsif ($env{'request.course.id'}) {
9407: my $expiretime=600;
9408: if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
9409: &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
9410: }
9411: my ($deeplinkmenu,$menuref);
9412: ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
9413: if ($menucoll) {
9414: if (ref($menuref) eq 'HASH') {
9415: %menu = %{$menuref};
9416: }
9417: if ($menu{'top'} eq 'n') {
9418: $args->{'no_primary_menu'} = 1;
9419: }
9420: if ($menu{'inline'} eq 'n') {
9421: unless (&Apache::lonnet::allowed('opa')) {
9422: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9423: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9424: my $crstype = &course_type();
9425: my $now = time;
9426: my $ccrole;
9427: if ($crstype eq 'Community') {
9428: $ccrole = 'co';
9429: } else {
9430: $ccrole = 'cc';
9431: }
9432: if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
9433: my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
9434: if ((($start) && ($start<0)) ||
9435: (($end) && ($end<$now)) ||
9436: (($start) && ($now<$start))) {
9437: $args->{'no_inline_menu'} = 1;
9438: }
9439: } else {
9440: $args->{'no_inline_menu'} = 1;
9441: }
9442: }
9443: }
9444: }
1.1316 raeburn 9445: }
1.1359 raeburn 9446:
1.1385 raeburn 9447: my $showncrumbs;
1.338 albertel 9448: if (! exists($args->{'skip_phases'}{'body'}) ) {
9449: if ($args->{'frameset'}) {
9450: my $attr_string = &make_attr_string($args->{'force_register'},
9451: $args->{'add_entries'});
9452: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 9453: } else {
9454: $result .=
9455: &bodytag($title,
9456: $args->{'function'}, $args->{'add_entries'},
9457: $args->{'only_body'}, $args->{'domain'},
9458: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 9459: $args->{'bgcolor'}, $args,
1.1385 raeburn 9460: \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,
9461: \%menu,\$showncrumbs);
1.831 bisitz 9462: }
1.330 albertel 9463: }
1.338 albertel 9464:
1.315 albertel 9465: if ($args->{'js_ready'}) {
1.713 kaisler 9466: $result = &js_ready($result);
1.315 albertel 9467: }
1.320 albertel 9468: if ($args->{'html_encode'}) {
1.713 kaisler 9469: $result = &html_encode($result);
9470: }
9471:
1.813 bisitz 9472: # Preparation for new and consistent functionlist at top of screen
9473: # if ($args->{'functionlist'}) {
9474: # $result .= &build_functionlist();
9475: #}
9476:
1.964 droeschl 9477: # Don't add anything more if only_body wanted or in const space
9478: return $result if $args->{'only_body'}
9479: || $env{'request.state'} eq 'construct';
1.813 bisitz 9480:
9481: #Breadcrumbs
1.758 kaisler 9482: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
1.1385 raeburn 9483: unless ($showncrumbs) {
1.758 kaisler 9484: &Apache::lonhtmlcommon::clear_breadcrumbs();
9485: #if any br links exists, add them to the breadcrumbs
9486: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
9487: foreach my $crumb (@{$args->{'bread_crumbs'}}){
9488: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
9489: }
9490: }
1.1096 raeburn 9491: # if @advtools array contains items add then to the breadcrumbs
9492: if (@advtools > 0) {
9493: &Apache::lonmenu::advtools_crumbs(@advtools);
9494: }
1.1272 raeburn 9495: my $menulink;
9496: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
9497: if ((exists($args->{'bread_crumbs_nomenu'})) ||
1.1312 raeburn 9498: ($ltiscope eq 'map') || ($ltiscope eq 'resource') ||
1.1272 raeburn 9499: ((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) &&
9500: ($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
9501: (!$env{'request.role.adv'}))) {
9502: $menulink = 0;
9503: } else {
9504: undef($menulink);
9505: }
1.1385 raeburn 9506: my $linkprotout;
9507: if ($env{'request.deeplink.login'}) {
9508: my $linkprotout = &Apache::lonmenu::linkprot_exit();
9509: if ($linkprotout) {
9510: &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
9511: }
9512: }
1.758 kaisler 9513: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
9514: if(exists($args->{'bread_crumbs_component'})){
1.1272 raeburn 9515: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
1.1237 raeburn 9516: } else {
1.1272 raeburn 9517: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
1.758 kaisler 9518: }
1.1385 raeburn 9519: }
1.320 albertel 9520: }
1.315 albertel 9521: return $result;
1.306 albertel 9522: }
9523:
9524: sub end_page {
1.315 albertel 9525: my ($args) = @_;
9526: $env{'internal.end_page'}++;
1.330 albertel 9527: my $result;
1.335 albertel 9528: if ($args->{'discussion'}) {
9529: my ($target,$parser);
9530: if (ref($args->{'discussion'})) {
9531: ($target,$parser) =($args->{'discussion'}{'target'},
9532: $args->{'discussion'}{'parser'});
9533: }
9534: $result .= &Apache::lonxml::xmlend($target,$parser);
9535: }
1.330 albertel 9536: if ($args->{'frameset'}) {
9537: $result .= '</frameset>';
9538: } else {
1.635 raeburn 9539: $result .= &endbodytag($args);
1.330 albertel 9540: }
1.1080 raeburn 9541: unless ($args->{'notbody'}) {
9542: $result .= "\n</html>";
9543: }
1.330 albertel 9544:
1.315 albertel 9545: if ($args->{'js_ready'}) {
1.317 albertel 9546: $result = &js_ready($result);
1.315 albertel 9547: }
1.335 albertel 9548:
1.320 albertel 9549: if ($args->{'html_encode'}) {
9550: $result = &html_encode($result);
9551: }
1.335 albertel 9552:
1.315 albertel 9553: return $result;
9554: }
9555:
1.1359 raeburn 9556: sub menucoll_in_effect {
9557: my ($menucoll,$deeplinkmenu,%menu);
9558: if ($env{'request.course.id'}) {
9559: $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
1.1362 raeburn 9560: if ($env{'request.deeplink.login'}) {
1.1370 raeburn 9561: my ($deeplink_symb,$deeplink,$check_login_symb);
1.1362 raeburn 9562: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9563: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9564: if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
9565: if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
9566: my $navmap = Apache::lonnavmaps::navmap->new();
9567: if (ref($navmap)) {
9568: $deeplink = $navmap->get_mapparam(undef,
9569: &Apache::lonnet::declutter($env{'request.noversionuri'}),
9570: '0.deeplink');
1.1370 raeburn 9571: } else {
9572: $check_login_symb = 1;
1.1362 raeburn 9573: }
9574: } else {
1.1370 raeburn 9575: my $symb = &Apache::lonnet::symbread();
9576: if ($symb) {
9577: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
9578: } else {
9579: $check_login_symb = 1;
9580: }
1.1362 raeburn 9581: }
9582: } else {
1.1370 raeburn 9583: $check_login_symb = 1;
9584: }
9585: if ($check_login_symb) {
1.1362 raeburn 9586: $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
9587: if ($deeplink_symb =~ /\.(page|sequence)$/) {
9588: my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
9589: my $navmap = Apache::lonnavmaps::navmap->new();
9590: if (ref($navmap)) {
9591: $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
9592: }
9593: } else {
9594: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
9595: }
9596: }
1.1359 raeburn 9597: if ($deeplink ne '') {
1.1378 raeburn 9598: my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
1.1359 raeburn 9599: if ($display =~ /^\d+$/) {
9600: $deeplinkmenu = 1;
9601: $menucoll = $display;
9602: }
9603: }
9604: }
9605: if ($menucoll) {
9606: %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
9607: }
9608: }
9609: return ($menucoll,$deeplinkmenu,\%menu);
9610: }
9611:
1.1362 raeburn 9612: sub deeplink_login_symb {
9613: my ($cnum,$cdom) = @_;
9614: my $login_symb;
9615: if ($env{'request.deeplink.login'}) {
1.1364 raeburn 9616: $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
9617: }
9618: return $login_symb;
9619: }
9620:
9621: sub symb_from_tinyurl {
9622: my ($url,$cnum,$cdom) = @_;
9623: if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
9624: my $key = $1;
9625: my ($tinyurl,$login);
9626: my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
9627: if (defined($cached)) {
9628: $tinyurl = $result;
9629: } else {
9630: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
9631: my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
9632: if ($currtiny{$key} ne '') {
9633: $tinyurl = $currtiny{$key};
9634: &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
1.1362 raeburn 9635: }
1.1364 raeburn 9636: }
9637: if ($tinyurl ne '') {
9638: my ($cnumreq,$symb) = split(/\&/,$tinyurl);
9639: if (wantarray) {
9640: return ($cnumreq,$symb);
9641: } elsif ($cnumreq eq $cnum) {
9642: return $symb;
1.1362 raeburn 9643: }
9644: }
9645: }
1.1364 raeburn 9646: if (wantarray) {
9647: return ();
9648: } else {
9649: return;
9650: }
1.1362 raeburn 9651: }
9652:
1.1034 www 9653: sub wishlist_window {
9654: return(<<'ENDWISHLIST');
1.1046 raeburn 9655: <script type="text/javascript">
1.1034 www 9656: // <![CDATA[
9657: // <!-- BEGIN LON-CAPA Internal
9658: function set_wishlistlink(title, path) {
9659: if (!title) {
9660: title = document.title;
9661: title = title.replace(/^LON-CAPA /,'');
9662: }
1.1175 raeburn 9663: title = encodeURIComponent(title);
1.1203 raeburn 9664: title = title.replace("'","\\\'");
1.1034 www 9665: if (!path) {
9666: path = location.pathname;
9667: }
1.1175 raeburn 9668: path = encodeURIComponent(path);
1.1203 raeburn 9669: path = path.replace("'","\\\'");
1.1034 www 9670: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
9671: 'wishlistNewLink','width=560,height=350,scrollbars=0');
9672: }
9673: // END LON-CAPA Internal -->
9674: // ]]>
9675: </script>
9676: ENDWISHLIST
9677: }
9678:
1.1030 www 9679: sub modal_window {
9680: return(<<'ENDMODAL');
1.1046 raeburn 9681: <script type="text/javascript">
1.1030 www 9682: // <![CDATA[
9683: // <!-- BEGIN LON-CAPA Internal
9684: var modalWindow = {
9685: parent:"body",
9686: windowId:null,
9687: content:null,
9688: width:null,
9689: height:null,
9690: close:function()
9691: {
9692: $(".LCmodal-window").remove();
9693: $(".LCmodal-overlay").remove();
9694: },
9695: open:function()
9696: {
9697: var modal = "";
9698: modal += "<div class=\"LCmodal-overlay\"></div>";
9699: 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;\">";
9700: modal += this.content;
9701: modal += "</div>";
9702:
9703: $(this.parent).append(modal);
9704:
9705: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
9706: $(".LCclose-window").click(function(){modalWindow.close();});
9707: $(".LCmodal-overlay").click(function(){modalWindow.close();});
9708: }
9709: };
1.1140 raeburn 9710: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 9711: {
1.1266 raeburn 9712: source = source.replace(/'/g,"'");
1.1030 www 9713: modalWindow.windowId = "myModal";
9714: modalWindow.width = width;
9715: modalWindow.height = height;
1.1196 raeburn 9716: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 9717: modalWindow.open();
1.1208 raeburn 9718: };
1.1030 www 9719: // END LON-CAPA Internal -->
9720: // ]]>
9721: </script>
9722: ENDMODAL
9723: }
9724:
9725: sub modal_link {
1.1140 raeburn 9726: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 9727: unless ($width) { $width=480; }
9728: unless ($height) { $height=400; }
1.1031 www 9729: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 9730: unless ($transparency) { $transparency='true'; }
9731:
1.1074 raeburn 9732: my $target_attr;
9733: if (defined($target)) {
9734: $target_attr = 'target="'.$target.'"';
9735: }
9736: return <<"ENDLINK";
1.1336 raeburn 9737: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 9738: ENDLINK
1.1030 www 9739: }
9740:
1.1032 www 9741: sub modal_adhoc_script {
1.1365 raeburn 9742: my ($funcname,$width,$height,$content,$possmathjax)=@_;
9743: my $mathjax;
9744: if ($possmathjax) {
9745: $mathjax = <<'ENDJAX';
9746: if (typeof MathJax == 'object') {
9747: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
9748: }
9749: ENDJAX
9750: }
1.1032 www 9751: return (<<ENDADHOC);
1.1046 raeburn 9752: <script type="text/javascript">
1.1032 www 9753: // <![CDATA[
9754: var $funcname = function()
9755: {
9756: modalWindow.windowId = "myModal";
9757: modalWindow.width = $width;
9758: modalWindow.height = $height;
9759: modalWindow.content = '$content';
9760: modalWindow.open();
1.1365 raeburn 9761: $mathjax
1.1032 www 9762: };
9763: // ]]>
9764: </script>
9765: ENDADHOC
9766: }
9767:
1.1041 www 9768: sub modal_adhoc_inner {
1.1365 raeburn 9769: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 9770: my $innerwidth=$width-20;
9771: $content=&js_ready(
1.1140 raeburn 9772: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
9773: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
9774: $content.
1.1041 www 9775: &end_scrollbox().
1.1140 raeburn 9776: &end_page()
1.1041 www 9777: );
1.1365 raeburn 9778: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 9779: }
9780:
9781: sub modal_adhoc_window {
1.1365 raeburn 9782: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
9783: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 9784: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
9785: }
9786:
9787: sub modal_adhoc_launch {
9788: my ($funcname,$width,$height,$content)=@_;
9789: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
9790: <script type="text/javascript">
9791: // <![CDATA[
9792: $funcname();
9793: // ]]>
9794: </script>
9795: ENDLAUNCH
9796: }
9797:
9798: sub modal_adhoc_close {
9799: return (<<ENDCLOSE);
9800: <script type="text/javascript">
9801: // <![CDATA[
9802: modalWindow.close();
9803: // ]]>
9804: </script>
9805: ENDCLOSE
9806: }
9807:
1.1038 www 9808: sub togglebox_script {
9809: return(<<ENDTOGGLE);
9810: <script type="text/javascript">
9811: // <![CDATA[
9812: function LCtoggleDisplay(id,hidetext,showtext) {
9813: link = document.getElementById(id + "link").childNodes[0];
9814: with (document.getElementById(id).style) {
9815: if (display == "none" ) {
9816: display = "inline";
9817: link.nodeValue = hidetext;
9818: } else {
9819: display = "none";
9820: link.nodeValue = showtext;
9821: }
9822: }
9823: }
9824: // ]]>
9825: </script>
9826: ENDTOGGLE
9827: }
9828:
1.1039 www 9829: sub start_togglebox {
9830: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
9831: unless ($heading) { $heading=''; } else { $heading.=' '; }
9832: unless ($showtext) { $showtext=&mt('show'); }
9833: unless ($hidetext) { $hidetext=&mt('hide'); }
9834: unless ($headerbg) { $headerbg='#FFFFFF'; }
9835: return &start_data_table().
9836: &start_data_table_header_row().
9837: '<td bgcolor="'.$headerbg.'">'.$heading.
9838: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
9839: $showtext.'\')">'.$showtext.'</a>]</td>'.
9840: &end_data_table_header_row().
9841: '<tr id="'.$id.'" style="display:none""><td>';
9842: }
9843:
9844: sub end_togglebox {
9845: return '</td></tr>'.&end_data_table();
9846: }
9847:
1.1041 www 9848: sub LCprogressbar_script {
1.1302 raeburn 9849: my ($id,$number_to_do)=@_;
9850: if ($number_to_do) {
9851: return(<<ENDPROGRESS);
1.1041 www 9852: <script type="text/javascript">
9853: // <![CDATA[
1.1045 www 9854: \$('#progressbar$id').progressbar({
1.1041 www 9855: value: 0,
9856: change: function(event, ui) {
9857: var newVal = \$(this).progressbar('option', 'value');
9858: \$('.pblabel', this).text(LCprogressTxt);
9859: }
9860: });
9861: // ]]>
9862: </script>
9863: ENDPROGRESS
1.1302 raeburn 9864: } else {
9865: return(<<ENDPROGRESS);
9866: <script type="text/javascript">
9867: // <![CDATA[
9868: \$('#progressbar$id').progressbar({
9869: value: false,
9870: create: function(event, ui) {
9871: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
9872: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
9873: }
9874: });
9875: // ]]>
9876: </script>
9877: ENDPROGRESS
9878: }
1.1041 www 9879: }
9880:
9881: sub LCprogressbarUpdate_script {
9882: return(<<ENDPROGRESSUPDATE);
9883: <style type="text/css">
9884: .ui-progressbar { position:relative; }
1.1302 raeburn 9885: .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 9886: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
9887: </style>
9888: <script type="text/javascript">
9889: // <![CDATA[
1.1045 www 9890: var LCprogressTxt='---';
9891:
1.1302 raeburn 9892: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 9893: LCprogressTxt=progresstext;
1.1302 raeburn 9894: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
9895: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
9896: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
1.1301 raeburn 9897: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
9898: } else {
9899: \$('#progressbar'+id).progressbar('value',percent);
9900: }
1.1041 www 9901: }
9902: // ]]>
9903: </script>
9904: ENDPROGRESSUPDATE
9905: }
9906:
1.1042 www 9907: my $LClastpercent;
1.1045 www 9908: my $LCidcnt;
9909: my $LCcurrentid;
1.1042 www 9910:
1.1041 www 9911: sub LCprogressbar {
1.1302 raeburn 9912: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 9913: $LClastpercent=0;
1.1045 www 9914: $LCidcnt++;
9915: $LCcurrentid=$$.'_'.$LCidcnt;
1.1302 raeburn 9916: my ($starting,$content);
9917: if ($number_to_do) {
9918: $starting=&mt('Starting');
9919: $content=(<<ENDPROGBAR);
9920: $preamble
1.1045 www 9921: <div id="progressbar$LCcurrentid">
1.1041 www 9922: <span class="pblabel">$starting</span>
9923: </div>
9924: ENDPROGBAR
1.1302 raeburn 9925: } else {
9926: $starting=&mt('Loading...');
9927: $LClastpercent='false';
9928: $content=(<<ENDPROGBAR);
9929: $preamble
9930: <div id="progressbar$LCcurrentid">
9931: <div class="progress-label">$starting</div>
9932: </div>
9933: ENDPROGBAR
9934: }
9935: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 9936: }
9937:
9938: sub LCprogressbarUpdate {
1.1302 raeburn 9939: my ($r,$val,$text,$number_to_do)=@_;
9940: if ($number_to_do) {
9941: unless ($val) {
9942: if ($LClastpercent) {
9943: $val=$LClastpercent;
9944: } else {
9945: $val=0;
9946: }
9947: }
9948: if ($val<0) { $val=0; }
9949: if ($val>100) { $val=0; }
9950: $LClastpercent=$val;
9951: unless ($text) { $text=$val.'%'; }
9952: } else {
9953: $val = 'false';
1.1042 www 9954: }
1.1041 www 9955: $text=&js_ready($text);
1.1044 www 9956: &r_print($r,<<ENDUPDATE);
1.1041 www 9957: <script type="text/javascript">
9958: // <![CDATA[
1.1302 raeburn 9959: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 9960: // ]]>
9961: </script>
9962: ENDUPDATE
1.1035 www 9963: }
9964:
1.1042 www 9965: sub LCprogressbarClose {
9966: my ($r)=@_;
9967: $LClastpercent=0;
1.1044 www 9968: &r_print($r,<<ENDCLOSE);
1.1042 www 9969: <script type="text/javascript">
9970: // <![CDATA[
1.1045 www 9971: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 9972: // ]]>
9973: </script>
9974: ENDCLOSE
1.1044 www 9975: }
9976:
9977: sub r_print {
9978: my ($r,$to_print)=@_;
9979: if ($r) {
9980: $r->print($to_print);
9981: $r->rflush();
9982: } else {
9983: print($to_print);
9984: }
1.1042 www 9985: }
9986:
1.320 albertel 9987: sub html_encode {
9988: my ($result) = @_;
9989:
1.322 albertel 9990: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 9991:
9992: return $result;
9993: }
1.1044 www 9994:
1.317 albertel 9995: sub js_ready {
9996: my ($result) = @_;
9997:
1.323 albertel 9998: $result =~ s/[\n\r]/ /xmsg;
9999: $result =~ s/\\/\\\\/xmsg;
10000: $result =~ s/'/\\'/xmsg;
1.372 albertel 10001: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 10002:
10003: return $result;
10004: }
10005:
1.315 albertel 10006: sub validate_page {
10007: if ( exists($env{'internal.start_page'})
1.316 albertel 10008: && $env{'internal.start_page'} > 1) {
10009: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 10010: $env{'internal.start_page'}.' '.
1.316 albertel 10011: $ENV{'request.filename'});
1.315 albertel 10012: }
10013: if ( exists($env{'internal.end_page'})
1.316 albertel 10014: && $env{'internal.end_page'} > 1) {
10015: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 10016: $env{'internal.end_page'}.' '.
1.316 albertel 10017: $env{'request.filename'});
1.315 albertel 10018: }
10019: if ( exists($env{'internal.start_page'})
10020: && ! exists($env{'internal.end_page'})) {
1.316 albertel 10021: &Apache::lonnet::logthis('start_page called without end_page '.
10022: $env{'request.filename'});
1.315 albertel 10023: }
10024: if ( ! exists($env{'internal.start_page'})
10025: && exists($env{'internal.end_page'})) {
1.316 albertel 10026: &Apache::lonnet::logthis('end_page called without start_page'.
10027: $env{'request.filename'});
1.315 albertel 10028: }
1.306 albertel 10029: }
1.315 albertel 10030:
1.996 www 10031:
10032: sub start_scrollbox {
1.1140 raeburn 10033: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 10034: unless ($outerwidth) { $outerwidth='520px'; }
10035: unless ($width) { $width='500px'; }
10036: unless ($height) { $height='200px'; }
1.1075 raeburn 10037: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 10038: if ($id ne '') {
1.1140 raeburn 10039: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 10040: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 10041: }
1.1075 raeburn 10042: if ($bgcolor ne '') {
10043: $tdcol = "background-color: $bgcolor;";
10044: }
1.1137 raeburn 10045: my $nicescroll_js;
10046: if ($env{'browser.mobile'}) {
1.1140 raeburn 10047: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
10048: }
10049: return <<"END";
10050: $nicescroll_js
10051:
10052: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
10053: <div style="overflow:auto; width:$width; height:$height;"$div_id>
10054: END
10055: }
10056:
10057: sub end_scrollbox {
10058: return '</div></td></tr></table>';
10059: }
10060:
10061: sub nicescroll_javascript {
10062: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
10063: my %options;
10064: if (ref($cursor) eq 'HASH') {
10065: %options = %{$cursor};
10066: }
10067: unless ($options{'railalign'} =~ /^left|right$/) {
10068: $options{'railalign'} = 'left';
10069: }
10070: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
10071: my $function = &get_users_function();
10072: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 10073: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 10074: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 10075: }
1.1140 raeburn 10076: }
10077: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
10078: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 10079: $options{'cursoropacity'}='1.0';
10080: }
1.1140 raeburn 10081: } else {
10082: $options{'cursoropacity'}='1.0';
10083: }
10084: if ($options{'cursorfixedheight'} eq 'none') {
10085: delete($options{'cursorfixedheight'});
10086: } else {
10087: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
10088: }
10089: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
10090: delete($options{'railoffset'});
10091: }
10092: my @niceoptions;
10093: while (my($key,$value) = each(%options)) {
10094: if ($value =~ /^\{.+\}$/) {
10095: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 10096: } else {
1.1140 raeburn 10097: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 10098: }
1.1140 raeburn 10099: }
10100: my $nicescroll_js = '
1.1137 raeburn 10101: $(document).ready(
1.1140 raeburn 10102: function() {
10103: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
10104: }
1.1137 raeburn 10105: );
10106: ';
1.1140 raeburn 10107: if ($framecheck) {
10108: $nicescroll_js .= '
10109: function expand_div(caller) {
10110: if (top === self) {
10111: document.getElementById("'.$id.'").style.width = "auto";
10112: document.getElementById("'.$id.'").style.height = "auto";
10113: } else {
10114: try {
10115: if (parent.frames) {
10116: if (parent.frames.length > 1) {
10117: var framesrc = parent.frames[1].location.href;
10118: var currsrc = framesrc.replace(/\#.*$/,"");
10119: if ((caller == "search") || (currsrc == "'.$location.'")) {
10120: document.getElementById("'.$id.'").style.width = "auto";
10121: document.getElementById("'.$id.'").style.height = "auto";
10122: }
10123: }
10124: }
10125: } catch (e) {
10126: return;
10127: }
1.1137 raeburn 10128: }
1.1140 raeburn 10129: return;
1.996 www 10130: }
1.1140 raeburn 10131: ';
10132: }
10133: if ($needjsready) {
10134: $nicescroll_js = '
10135: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
10136: } else {
10137: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
10138: }
10139: return $nicescroll_js;
1.996 www 10140: }
10141:
1.318 albertel 10142: sub simple_error_page {
1.1150 bisitz 10143: my ($r,$title,$msg,$args) = @_;
1.1304 raeburn 10144: my %displayargs;
1.1151 raeburn 10145: if (ref($args) eq 'HASH') {
10146: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1304 raeburn 10147: if ($args->{'only_body'}) {
10148: $displayargs{'only_body'} = 1;
10149: }
10150: if ($args->{'no_nav_bar'}) {
10151: $displayargs{'no_nav_bar'} = 1;
10152: }
1.1151 raeburn 10153: } else {
10154: $msg = &mt($msg);
10155: }
1.1150 bisitz 10156:
1.318 albertel 10157: my $page =
1.1304 raeburn 10158: &Apache::loncommon::start_page($title,'',\%displayargs).
1.1150 bisitz 10159: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 10160: &Apache::loncommon::end_page();
10161: if (ref($r)) {
10162: $r->print($page);
1.327 albertel 10163: return;
1.318 albertel 10164: }
10165: return $page;
10166: }
1.347 albertel 10167:
10168: {
1.610 albertel 10169: my @row_count;
1.961 onken 10170:
10171: sub start_data_table_count {
10172: unshift(@row_count, 0);
10173: return;
10174: }
10175:
10176: sub end_data_table_count {
10177: shift(@row_count);
10178: return;
10179: }
10180:
1.347 albertel 10181: sub start_data_table {
1.1018 raeburn 10182: my ($add_class,$id) = @_;
1.422 albertel 10183: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 10184: my $table_id;
10185: if (defined($id)) {
10186: $table_id = ' id="'.$id.'"';
10187: }
1.961 onken 10188: &start_data_table_count();
1.1018 raeburn 10189: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 10190: }
10191:
10192: sub end_data_table {
1.961 onken 10193: &end_data_table_count();
1.389 albertel 10194: return '</table>'."\n";;
1.347 albertel 10195: }
10196:
10197: sub start_data_table_row {
1.974 wenzelju 10198: my ($add_class, $id) = @_;
1.610 albertel 10199: $row_count[0]++;
10200: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 10201: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 10202: $id = (' id="'.$id.'"') unless ($id eq '');
10203: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 10204: }
1.471 banghart 10205:
10206: sub continue_data_table_row {
1.974 wenzelju 10207: my ($add_class, $id) = @_;
1.610 albertel 10208: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 10209: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
10210: $id = (' id="'.$id.'"') unless ($id eq '');
10211: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 10212: }
1.347 albertel 10213:
10214: sub end_data_table_row {
1.389 albertel 10215: return '</tr>'."\n";;
1.347 albertel 10216: }
1.367 www 10217:
1.421 albertel 10218: sub start_data_table_empty_row {
1.707 bisitz 10219: # $row_count[0]++;
1.421 albertel 10220: return '<tr class="LC_empty_row" >'."\n";;
10221: }
10222:
10223: sub end_data_table_empty_row {
10224: return '</tr>'."\n";;
10225: }
10226:
1.367 www 10227: sub start_data_table_header_row {
1.389 albertel 10228: return '<tr class="LC_header_row">'."\n";;
1.367 www 10229: }
10230:
10231: sub end_data_table_header_row {
1.389 albertel 10232: return '</tr>'."\n";;
1.367 www 10233: }
1.890 droeschl 10234:
10235: sub data_table_caption {
10236: my $caption = shift;
10237: return "<caption class=\"LC_caption\">$caption</caption>";
10238: }
1.347 albertel 10239: }
10240:
1.548 albertel 10241: =pod
10242:
10243: =item * &inhibit_menu_check($arg)
10244:
10245: Checks for a inhibitmenu state and generates output to preserve it
10246:
10247: Inputs: $arg - can be any of
10248: - undef - in which case the return value is a string
10249: to add into arguments list of a uri
10250: - 'input' - in which case the return value is a HTML
10251: <form> <input> field of type hidden to
10252: preserve the value
10253: - a url - in which case the return value is the url with
10254: the neccesary cgi args added to preserve the
10255: inhibitmenu state
10256: - a ref to a url - no return value, but the string is
10257: updated to include the neccessary cgi
10258: args to preserve the inhibitmenu state
10259:
10260: =cut
10261:
10262: sub inhibit_menu_check {
10263: my ($arg) = @_;
10264: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
10265: if ($arg eq 'input') {
10266: if ($env{'form.inhibitmenu'}) {
10267: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
10268: } else {
10269: return
10270: }
10271: }
10272: if ($env{'form.inhibitmenu'}) {
10273: if (ref($arg)) {
10274: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10275: } elsif ($arg eq '') {
10276: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
10277: } else {
10278: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10279: }
10280: }
10281: if (!ref($arg)) {
10282: return $arg;
10283: }
10284: }
10285:
1.251 albertel 10286: ###############################################
1.182 matthew 10287:
10288: =pod
10289:
1.549 albertel 10290: =back
10291:
10292: =head1 User Information Routines
10293:
10294: =over 4
10295:
1.405 albertel 10296: =item * &get_users_function()
1.182 matthew 10297:
10298: Used by &bodytag to determine the current users primary role.
10299: Returns either 'student','coordinator','admin', or 'author'.
10300:
10301: =cut
10302:
10303: ###############################################
10304: sub get_users_function {
1.815 tempelho 10305: my $function = 'norole';
1.818 tempelho 10306: if ($env{'request.role'}=~/^(st)/) {
10307: $function='student';
10308: }
1.907 raeburn 10309: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 10310: $function='coordinator';
10311: }
1.258 albertel 10312: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 10313: $function='admin';
10314: }
1.826 bisitz 10315: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 10316: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 10317: $function='author';
10318: }
10319: return $function;
1.54 www 10320: }
1.99 www 10321:
10322: ###############################################
10323:
1.233 raeburn 10324: =pod
10325:
1.821 raeburn 10326: =item * &show_course()
10327:
10328: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
10329: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
10330:
10331: Inputs:
10332: None
10333:
10334: Outputs:
10335: Scalar: 1 if 'Course' to be used, 0 otherwise.
10336:
10337: =cut
10338:
10339: ###############################################
10340: sub show_course {
10341: my $course = !$env{'user.adv'};
10342: if (!$env{'user.adv'}) {
10343: foreach my $env (keys(%env)) {
10344: next if ($env !~ m/^user\.priv\./);
10345: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
10346: $course = 0;
10347: last;
10348: }
10349: }
10350: }
10351: return $course;
10352: }
10353:
10354: ###############################################
10355:
10356: =pod
10357:
1.542 raeburn 10358: =item * &check_user_status()
1.274 raeburn 10359:
10360: Determines current status of supplied role for a
10361: specific user. Roles can be active, previous or future.
10362:
10363: Inputs:
10364: user's domain, user's username, course's domain,
1.375 raeburn 10365: course's number, optional section ID.
1.274 raeburn 10366:
10367: Outputs:
10368: role status: active, previous or future.
10369:
10370: =cut
10371:
10372: sub check_user_status {
1.412 raeburn 10373: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 10374: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1202 raeburn 10375: my @uroles = keys(%userinfo);
1.274 raeburn 10376: my $srchstr;
10377: my $active_chk = 'none';
1.412 raeburn 10378: my $now = time;
1.274 raeburn 10379: if (@uroles > 0) {
1.908 raeburn 10380: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 10381: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
10382: } else {
1.412 raeburn 10383: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
10384: }
10385: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 10386: my $role_end = 0;
10387: my $role_start = 0;
10388: $active_chk = 'active';
1.412 raeburn 10389: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
10390: $role_end = $1;
10391: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
10392: $role_start = $1;
1.274 raeburn 10393: }
10394: }
10395: if ($role_start > 0) {
1.412 raeburn 10396: if ($now < $role_start) {
1.274 raeburn 10397: $active_chk = 'future';
10398: }
10399: }
10400: if ($role_end > 0) {
1.412 raeburn 10401: if ($now > $role_end) {
1.274 raeburn 10402: $active_chk = 'previous';
10403: }
10404: }
10405: }
10406: }
10407: return $active_chk;
10408: }
10409:
10410: ###############################################
10411:
10412: =pod
10413:
1.405 albertel 10414: =item * &get_sections()
1.233 raeburn 10415:
10416: Determines all the sections for a course including
10417: sections with students and sections containing other roles.
1.419 raeburn 10418: Incoming parameters:
10419:
10420: 1. domain
10421: 2. course number
10422: 3. reference to array containing roles for which sections should
10423: be gathered (optional).
10424: 4. reference to array containing status types for which sections
10425: should be gathered (optional).
10426:
10427: If the third argument is undefined, sections are gathered for any role.
10428: If the fourth argument is undefined, sections are gathered for any status.
10429: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 10430:
1.374 raeburn 10431: Returns section hash (keys are section IDs, values are
10432: number of users in each section), subject to the
1.419 raeburn 10433: optional roles filter, optional status filter
1.233 raeburn 10434:
10435: =cut
10436:
10437: ###############################################
10438: sub get_sections {
1.419 raeburn 10439: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 10440: if (!defined($cdom) || !defined($cnum)) {
10441: my $cid = $env{'request.course.id'};
10442:
10443: return if (!defined($cid));
10444:
10445: $cdom = $env{'course.'.$cid.'.domain'};
10446: $cnum = $env{'course.'.$cid.'.num'};
10447: }
10448:
10449: my %sectioncount;
1.419 raeburn 10450: my $now = time;
1.240 albertel 10451:
1.1118 raeburn 10452: my $check_students = 1;
10453: my $only_students = 0;
10454: if (ref($possible_roles) eq 'ARRAY') {
10455: if (grep(/^st$/,@{$possible_roles})) {
10456: if (@{$possible_roles} == 1) {
10457: $only_students = 1;
10458: }
10459: } else {
10460: $check_students = 0;
10461: }
10462: }
10463:
10464: if ($check_students) {
1.276 albertel 10465: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 10466: my $sec_index = &Apache::loncoursedata::CL_SECTION();
10467: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 10468: my $start_index = &Apache::loncoursedata::CL_START();
10469: my $end_index = &Apache::loncoursedata::CL_END();
10470: my $status;
1.366 albertel 10471: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 10472: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
10473: $data->[$status_index],
10474: $data->[$start_index],
10475: $data->[$end_index]);
10476: if ($stu_status eq 'Active') {
10477: $status = 'active';
10478: } elsif ($end < $now) {
10479: $status = 'previous';
10480: } elsif ($start > $now) {
10481: $status = 'future';
10482: }
10483: if ($section ne '-1' && $section !~ /^\s*$/) {
10484: if ((!defined($possible_status)) || (($status ne '') &&
10485: (grep/^\Q$status\E$/,@{$possible_status}))) {
10486: $sectioncount{$section}++;
10487: }
1.240 albertel 10488: }
10489: }
10490: }
1.1118 raeburn 10491: if ($only_students) {
10492: return %sectioncount;
10493: }
1.240 albertel 10494: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10495: foreach my $user (sort(keys(%courseroles))) {
10496: if ($user !~ /^(\w{2})/) { next; }
10497: my ($role) = ($user =~ /^(\w{2})/);
10498: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 10499: my ($section,$status);
1.240 albertel 10500: if ($role eq 'cr' &&
10501: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
10502: $section=$1;
10503: }
10504: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
10505: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 10506: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
10507: if ($end == -1 && $start == -1) {
10508: next; #deleted role
10509: }
10510: if (!defined($possible_status)) {
10511: $sectioncount{$section}++;
10512: } else {
10513: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
10514: $status = 'active';
10515: } elsif ($end < $now) {
10516: $status = 'future';
10517: } elsif ($start > $now) {
10518: $status = 'previous';
10519: }
10520: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
10521: $sectioncount{$section}++;
10522: }
10523: }
1.233 raeburn 10524: }
1.366 albertel 10525: return %sectioncount;
1.233 raeburn 10526: }
10527:
1.274 raeburn 10528: ###############################################
1.294 raeburn 10529:
10530: =pod
1.405 albertel 10531:
10532: =item * &get_course_users()
10533:
1.275 raeburn 10534: Retrieves usernames:domains for users in the specified course
10535: with specific role(s), and access status.
10536:
10537: Incoming parameters:
1.277 albertel 10538: 1. course domain
10539: 2. course number
10540: 3. access status: users must have - either active,
1.275 raeburn 10541: previous, future, or all.
1.277 albertel 10542: 4. reference to array of permissible roles
1.288 raeburn 10543: 5. reference to array of section restrictions (optional)
10544: 6. reference to results object (hash of hashes).
10545: 7. reference to optional userdata hash
1.609 raeburn 10546: 8. reference to optional statushash
1.630 raeburn 10547: 9. flag if privileged users (except those set to unhide in
10548: course settings) should be excluded
1.609 raeburn 10549: Keys of top level results hash are roles.
1.275 raeburn 10550: Keys of inner hashes are username:domain, with
10551: values set to access type.
1.288 raeburn 10552: Optional userdata hash returns an array with arguments in the
10553: same order as loncoursedata::get_classlist() for student data.
10554:
1.609 raeburn 10555: Optional statushash returns
10556:
1.288 raeburn 10557: Entries for end, start, section and status are blank because
10558: of the possibility of multiple values for non-student roles.
10559:
1.275 raeburn 10560: =cut
1.405 albertel 10561:
1.275 raeburn 10562: ###############################################
1.405 albertel 10563:
1.275 raeburn 10564: sub get_course_users {
1.630 raeburn 10565: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 10566: my %idx = ();
1.419 raeburn 10567: my %seclists;
1.288 raeburn 10568:
10569: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
10570: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
10571: $idx{end} = &Apache::loncoursedata::CL_END();
10572: $idx{start} = &Apache::loncoursedata::CL_START();
10573: $idx{id} = &Apache::loncoursedata::CL_ID();
10574: $idx{section} = &Apache::loncoursedata::CL_SECTION();
10575: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
10576: $idx{status} = &Apache::loncoursedata::CL_STATUS();
10577:
1.290 albertel 10578: if (grep(/^st$/,@{$roles})) {
1.276 albertel 10579: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 10580: my $now = time;
1.277 albertel 10581: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 10582: my $match = 0;
1.412 raeburn 10583: my $secmatch = 0;
1.419 raeburn 10584: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 10585: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 10586: if ($section eq '') {
10587: $section = 'none';
10588: }
1.291 albertel 10589: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10590: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10591: $secmatch = 1;
10592: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 10593: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10594: $secmatch = 1;
10595: }
10596: } else {
1.419 raeburn 10597: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 10598: $secmatch = 1;
10599: }
1.290 albertel 10600: }
1.412 raeburn 10601: if (!$secmatch) {
10602: next;
10603: }
1.419 raeburn 10604: }
1.275 raeburn 10605: if (defined($$types{'active'})) {
1.288 raeburn 10606: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 10607: push(@{$$users{st}{$student}},'active');
1.288 raeburn 10608: $match = 1;
1.275 raeburn 10609: }
10610: }
10611: if (defined($$types{'previous'})) {
1.609 raeburn 10612: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 10613: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 10614: $match = 1;
1.275 raeburn 10615: }
10616: }
10617: if (defined($$types{'future'})) {
1.609 raeburn 10618: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 10619: push(@{$$users{st}{$student}},'future');
1.288 raeburn 10620: $match = 1;
1.275 raeburn 10621: }
10622: }
1.609 raeburn 10623: if ($match) {
10624: push(@{$seclists{$student}},$section);
10625: if (ref($userdata) eq 'HASH') {
10626: $$userdata{$student} = $$classlist{$student};
10627: }
10628: if (ref($statushash) eq 'HASH') {
10629: $statushash->{$student}{'st'}{$section} = $status;
10630: }
1.288 raeburn 10631: }
1.275 raeburn 10632: }
10633: }
1.412 raeburn 10634: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 10635: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10636: my $now = time;
1.609 raeburn 10637: my %displaystatus = ( previous => 'Expired',
10638: active => 'Active',
10639: future => 'Future',
10640: );
1.1121 raeburn 10641: my (%nothide,@possdoms);
1.630 raeburn 10642: if ($hidepriv) {
10643: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
10644: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
10645: if ($user !~ /:/) {
10646: $nothide{join(':',split(/[\@]/,$user))}=1;
10647: } else {
10648: $nothide{$user} = 1;
10649: }
10650: }
1.1121 raeburn 10651: my @possdoms = ($cdom);
10652: if ($coursehash{'checkforpriv'}) {
10653: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
10654: }
1.630 raeburn 10655: }
1.439 raeburn 10656: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 10657: my $match = 0;
1.412 raeburn 10658: my $secmatch = 0;
1.439 raeburn 10659: my $status;
1.412 raeburn 10660: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 10661: $user =~ s/:$//;
1.439 raeburn 10662: my ($end,$start) = split(/:/,$coursepersonnel{$person});
10663: if ($end == -1 || $start == -1) {
10664: next;
10665: }
10666: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
10667: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 10668: my ($uname,$udom) = split(/:/,$user);
10669: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10670: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10671: $secmatch = 1;
10672: } elsif ($usec eq '') {
1.420 albertel 10673: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10674: $secmatch = 1;
10675: }
10676: } else {
10677: if (grep(/^\Q$usec\E$/,@{$sections})) {
10678: $secmatch = 1;
10679: }
10680: }
10681: if (!$secmatch) {
10682: next;
10683: }
1.288 raeburn 10684: }
1.419 raeburn 10685: if ($usec eq '') {
10686: $usec = 'none';
10687: }
1.275 raeburn 10688: if ($uname ne '' && $udom ne '') {
1.630 raeburn 10689: if ($hidepriv) {
1.1121 raeburn 10690: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 10691: (!$nothide{$uname.':'.$udom})) {
10692: next;
10693: }
10694: }
1.503 raeburn 10695: if ($end > 0 && $end < $now) {
1.439 raeburn 10696: $status = 'previous';
10697: } elsif ($start > $now) {
10698: $status = 'future';
10699: } else {
10700: $status = 'active';
10701: }
1.277 albertel 10702: foreach my $type (keys(%{$types})) {
1.275 raeburn 10703: if ($status eq $type) {
1.420 albertel 10704: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 10705: push(@{$$users{$role}{$user}},$type);
10706: }
1.288 raeburn 10707: $match = 1;
10708: }
10709: }
1.419 raeburn 10710: if (($match) && (ref($userdata) eq 'HASH')) {
10711: if (!exists($$userdata{$uname.':'.$udom})) {
10712: &get_user_info($udom,$uname,\%idx,$userdata);
10713: }
1.420 albertel 10714: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 10715: push(@{$seclists{$uname.':'.$udom}},$usec);
10716: }
1.609 raeburn 10717: if (ref($statushash) eq 'HASH') {
10718: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
10719: }
1.275 raeburn 10720: }
10721: }
10722: }
10723: }
1.290 albertel 10724: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 10725: if ((defined($cdom)) && (defined($cnum))) {
10726: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
10727: if ( defined($csettings{'internal.courseowner'}) ) {
10728: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 10729: next if ($owner eq '');
10730: my ($ownername,$ownerdom);
10731: if ($owner =~ /^([^:]+):([^:]+)$/) {
10732: $ownername = $1;
10733: $ownerdom = $2;
10734: } else {
10735: $ownername = $owner;
10736: $ownerdom = $cdom;
10737: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 10738: }
10739: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 10740: if (defined($userdata) &&
1.609 raeburn 10741: !exists($$userdata{$owner})) {
10742: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
10743: if (!grep(/^none$/,@{$seclists{$owner}})) {
10744: push(@{$seclists{$owner}},'none');
10745: }
10746: if (ref($statushash) eq 'HASH') {
10747: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 10748: }
1.290 albertel 10749: }
1.279 raeburn 10750: }
10751: }
10752: }
1.419 raeburn 10753: foreach my $user (keys(%seclists)) {
10754: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
10755: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
10756: }
1.275 raeburn 10757: }
10758: return;
10759: }
10760:
1.288 raeburn 10761: sub get_user_info {
10762: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 10763: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
10764: &plainname($uname,$udom,'lastname');
1.291 albertel 10765: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 10766: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 10767: my %idhash = &Apache::lonnet::idrget($udom,($uname));
10768: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 10769: return;
10770: }
1.275 raeburn 10771:
1.472 raeburn 10772: ###############################################
10773:
10774: =pod
10775:
10776: =item * &get_user_quota()
10777:
1.1134 raeburn 10778: Retrieves quota assigned for storage of user files.
10779: Default is to report quota for portfolio files.
1.472 raeburn 10780:
10781: Incoming parameters:
10782: 1. user's username
10783: 2. user's domain
1.1134 raeburn 10784: 3. quota name - portfolio, author, or course
1.1136 raeburn 10785: (if no quota name provided, defaults to portfolio).
1.1237 raeburn 10786: 4. crstype - official, unofficial, textbook, placement or community,
10787: if quota name is course
1.472 raeburn 10788:
10789: Returns:
1.1163 raeburn 10790: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 10791: 2. (Optional) Type of setting: custom or default
10792: (individually assigned or default for user's
10793: institutional status).
10794: 3. (Optional) - User's institutional status (e.g., faculty, staff
10795: or student - types as defined in localenroll::inst_usertypes
10796: for user's domain, which determines default quota for user.
10797: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 10798:
10799: If a value has been stored in the user's environment,
1.536 raeburn 10800: it will return that, otherwise it returns the maximal default
1.1134 raeburn 10801: defined for the user's institutional status(es) in the domain.
1.472 raeburn 10802:
10803: =cut
10804:
10805: ###############################################
10806:
10807:
10808: sub get_user_quota {
1.1136 raeburn 10809: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 10810: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 10811: if (!defined($udom)) {
10812: $udom = $env{'user.domain'};
10813: }
10814: if (!defined($uname)) {
10815: $uname = $env{'user.name'};
10816: }
10817: if (($udom eq '' || $uname eq '') ||
10818: ($udom eq 'public') && ($uname eq 'public')) {
10819: $quota = 0;
1.536 raeburn 10820: $quotatype = 'default';
10821: $defquota = 0;
1.472 raeburn 10822: } else {
1.536 raeburn 10823: my $inststatus;
1.1134 raeburn 10824: if ($quotaname eq 'course') {
10825: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
10826: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
10827: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
10828: } else {
10829: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
10830: $quota = $cenv{'internal.uploadquota'};
10831: }
1.536 raeburn 10832: } else {
1.1134 raeburn 10833: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
10834: if ($quotaname eq 'author') {
10835: $quota = $env{'environment.authorquota'};
10836: } else {
10837: $quota = $env{'environment.portfolioquota'};
10838: }
10839: $inststatus = $env{'environment.inststatus'};
10840: } else {
10841: my %userenv =
10842: &Apache::lonnet::get('environment',['portfolioquota',
10843: 'authorquota','inststatus'],$udom,$uname);
10844: my ($tmp) = keys(%userenv);
10845: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
10846: if ($quotaname eq 'author') {
10847: $quota = $userenv{'authorquota'};
10848: } else {
10849: $quota = $userenv{'portfolioquota'};
10850: }
10851: $inststatus = $userenv{'inststatus'};
10852: } else {
10853: undef(%userenv);
10854: }
10855: }
10856: }
10857: if ($quota eq '' || wantarray) {
10858: if ($quotaname eq 'course') {
10859: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 10860: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
1.1237 raeburn 10861: ($crstype eq 'community') || ($crstype eq 'textbook') ||
10862: ($crstype eq 'placement')) {
1.1136 raeburn 10863: $defquota = $domdefs{$crstype.'quota'};
10864: }
10865: if ($defquota eq '') {
10866: $defquota = 500;
10867: }
1.1134 raeburn 10868: } else {
10869: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
10870: }
10871: if ($quota eq '') {
10872: $quota = $defquota;
10873: $quotatype = 'default';
10874: } else {
10875: $quotatype = 'custom';
10876: }
1.472 raeburn 10877: }
10878: }
1.536 raeburn 10879: if (wantarray) {
10880: return ($quota,$quotatype,$settingstatus,$defquota);
10881: } else {
10882: return $quota;
10883: }
1.472 raeburn 10884: }
10885:
10886: ###############################################
10887:
10888: =pod
10889:
10890: =item * &default_quota()
10891:
1.536 raeburn 10892: Retrieves default quota assigned for storage of user portfolio files,
10893: given an (optional) user's institutional status.
1.472 raeburn 10894:
10895: Incoming parameters:
1.1142 raeburn 10896:
1.472 raeburn 10897: 1. domain
1.536 raeburn 10898: 2. (Optional) institutional status(es). This is a : separated list of
10899: status types (e.g., faculty, staff, student etc.)
10900: which apply to the user for whom the default is being retrieved.
10901: If the institutional status string in undefined, the domain
1.1134 raeburn 10902: default quota will be returned.
10903: 3. quota name - portfolio, author, or course
10904: (if no quota name provided, defaults to portfolio).
1.472 raeburn 10905:
10906: Returns:
1.1142 raeburn 10907:
1.1163 raeburn 10908: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 10909: 2. (Optional) institutional type which determined the value of the
10910: default quota.
1.472 raeburn 10911:
10912: If a value has been stored in the domain's configuration db,
10913: it will return that, otherwise it returns 20 (for backwards
10914: compatibility with domains which have not set up a configuration
1.1163 raeburn 10915: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 10916:
1.536 raeburn 10917: If the user's status includes multiple types (e.g., staff and student),
10918: the largest default quota which applies to the user determines the
10919: default quota returned.
10920:
1.472 raeburn 10921: =cut
10922:
10923: ###############################################
10924:
10925:
10926: sub default_quota {
1.1134 raeburn 10927: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 10928: my ($defquota,$settingstatus);
10929: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 10930: ['quotas'],$udom);
1.1134 raeburn 10931: my $key = 'defaultquota';
10932: if ($quotaname eq 'author') {
10933: $key = 'authorquota';
10934: }
1.622 raeburn 10935: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 10936: if ($inststatus ne '') {
1.765 raeburn 10937: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 10938: foreach my $item (@statuses) {
1.1134 raeburn 10939: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10940: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 10941: if ($defquota eq '') {
1.1134 raeburn 10942: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10943: $settingstatus = $item;
1.1134 raeburn 10944: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
10945: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 10946: $settingstatus = $item;
10947: }
10948: }
1.1134 raeburn 10949: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10950: if ($quotahash{'quotas'}{$item} ne '') {
10951: if ($defquota eq '') {
10952: $defquota = $quotahash{'quotas'}{$item};
10953: $settingstatus = $item;
10954: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
10955: $defquota = $quotahash{'quotas'}{$item};
10956: $settingstatus = $item;
10957: }
1.536 raeburn 10958: }
10959: }
10960: }
10961: }
10962: if ($defquota eq '') {
1.1134 raeburn 10963: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10964: $defquota = $quotahash{'quotas'}{$key}{'default'};
10965: } elsif ($key eq 'defaultquota') {
1.711 raeburn 10966: $defquota = $quotahash{'quotas'}{'default'};
10967: }
1.536 raeburn 10968: $settingstatus = 'default';
1.1139 raeburn 10969: if ($defquota eq '') {
10970: if ($quotaname eq 'author') {
10971: $defquota = 500;
10972: }
10973: }
1.536 raeburn 10974: }
10975: } else {
10976: $settingstatus = 'default';
1.1134 raeburn 10977: if ($quotaname eq 'author') {
10978: $defquota = 500;
10979: } else {
10980: $defquota = 20;
10981: }
1.536 raeburn 10982: }
10983: if (wantarray) {
10984: return ($defquota,$settingstatus);
1.472 raeburn 10985: } else {
1.536 raeburn 10986: return $defquota;
1.472 raeburn 10987: }
10988: }
10989:
1.1135 raeburn 10990: ###############################################
10991:
10992: =pod
10993:
1.1136 raeburn 10994: =item * &excess_filesize_warning()
1.1135 raeburn 10995:
10996: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 10997: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 10998: space to be exceeded.
1.1136 raeburn 10999:
11000: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 11001: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 11002:
1.1165 raeburn 11003: Inputs: 7
1.1136 raeburn 11004: 1. username or coursenum
1.1135 raeburn 11005: 2. domain
1.1136 raeburn 11006: 3. context ('author' or 'course')
1.1135 raeburn 11007: 4. filename of file for which action is being requested
11008: 5. filesize (kB) of file
11009: 6. action being taken: copy or upload.
1.1237 raeburn 11010: 7. quotatype (in course context -- official, unofficial, textbook, placement or community).
1.1135 raeburn 11011:
11012: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 11013: otherwise return null.
11014:
11015: =back
1.1135 raeburn 11016:
11017: =cut
11018:
1.1136 raeburn 11019: sub excess_filesize_warning {
1.1165 raeburn 11020: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 11021: my $current_disk_usage = 0;
1.1165 raeburn 11022: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 11023: if ($context eq 'author') {
11024: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
11025: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
11026: } else {
11027: foreach my $subdir ('docs','supplemental') {
11028: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
11029: }
11030: }
1.1135 raeburn 11031: $disk_quota = int($disk_quota * 1000);
11032: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 11033: return '<p class="LC_warning">'.
1.1135 raeburn 11034: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 11035: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
11036: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 11037: $disk_quota,$current_disk_usage).
11038: '</p>';
11039: }
11040: return;
11041: }
11042:
11043: ###############################################
11044:
11045:
1.1136 raeburn 11046:
11047:
1.384 raeburn 11048: sub get_secgrprole_info {
11049: my ($cdom,$cnum,$needroles,$type) = @_;
11050: my %sections_count = &get_sections($cdom,$cnum);
11051: my @sections = (sort {$a <=> $b} keys(%sections_count));
11052: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
11053: my @groups = sort(keys(%curr_groups));
11054: my $allroles = [];
11055: my $rolehash;
11056: my $accesshash = {
11057: active => 'Currently has access',
11058: future => 'Will have future access',
11059: previous => 'Previously had access',
11060: };
11061: if ($needroles) {
11062: $rolehash = {'all' => 'all'};
1.385 albertel 11063: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
11064: if (&Apache::lonnet::error(%user_roles)) {
11065: undef(%user_roles);
11066: }
11067: foreach my $item (keys(%user_roles)) {
1.384 raeburn 11068: my ($role)=split(/\:/,$item,2);
11069: if ($role eq 'cr') { next; }
11070: if ($role =~ /^cr/) {
11071: $$rolehash{$role} = (split('/',$role))[3];
11072: } else {
11073: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
11074: }
11075: }
11076: foreach my $key (sort(keys(%{$rolehash}))) {
11077: push(@{$allroles},$key);
11078: }
11079: push (@{$allroles},'st');
11080: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
11081: }
11082: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
11083: }
11084:
1.555 raeburn 11085: sub user_picker {
1.1279 raeburn 11086: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 11087: my $currdom = $dom;
1.1253 raeburn 11088: my @alldoms = &Apache::lonnet::all_domains();
11089: if (@alldoms == 1) {
11090: my %domsrch = &Apache::lonnet::get_dom('configuration',
11091: ['directorysrch'],$alldoms[0]);
11092: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
11093: my $showdom = $domdesc;
11094: if ($showdom eq '') {
11095: $showdom = $dom;
11096: }
11097: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
11098: if ((!$domsrch{'directorysrch'}{'available'}) &&
11099: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
11100: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
11101: }
11102: }
11103: }
1.555 raeburn 11104: my %curr_selected = (
11105: srchin => 'dom',
1.580 raeburn 11106: srchby => 'lastname',
1.555 raeburn 11107: );
11108: my $srchterm;
1.625 raeburn 11109: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 11110: if ($srch->{'srchby'} ne '') {
11111: $curr_selected{'srchby'} = $srch->{'srchby'};
11112: }
11113: if ($srch->{'srchin'} ne '') {
11114: $curr_selected{'srchin'} = $srch->{'srchin'};
11115: }
11116: if ($srch->{'srchtype'} ne '') {
11117: $curr_selected{'srchtype'} = $srch->{'srchtype'};
11118: }
11119: if ($srch->{'srchdomain'} ne '') {
11120: $currdom = $srch->{'srchdomain'};
11121: }
11122: $srchterm = $srch->{'srchterm'};
11123: }
1.1222 damieng 11124: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 11125: 'usr' => 'Search criteria',
1.563 raeburn 11126: 'doma' => 'Domain/institution to search',
1.558 albertel 11127: 'uname' => 'username',
11128: 'lastname' => 'last name',
1.555 raeburn 11129: 'lastfirst' => 'last name, first name',
1.558 albertel 11130: 'crs' => 'in this course',
1.576 raeburn 11131: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 11132: 'alc' => 'all LON-CAPA',
1.573 raeburn 11133: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 11134: 'exact' => 'is',
11135: 'contains' => 'contains',
1.569 raeburn 11136: 'begins' => 'begins with',
1.1222 damieng 11137: );
11138: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 11139: 'youm' => "You must include some text to search for.",
11140: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
11141: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
11142: 'yomc' => "You must choose a domain when using an institutional directory search.",
11143: 'ymcd' => "You must choose a domain when using a domain search.",
11144: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
11145: 'whse' => "When searching by last,first you must include at least one character in the first name.",
11146: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 11147: );
1.1222 damieng 11148: &html_escape(\%html_lt);
11149: &js_escape(\%js_lt);
1.1255 raeburn 11150: my $domform;
1.1277 raeburn 11151: my $allow_blank = 1;
1.1255 raeburn 11152: if ($fixeddom) {
1.1277 raeburn 11153: $allow_blank = 0;
11154: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1255 raeburn 11155: } else {
1.1287 raeburn 11156: my $defdom = $env{'request.role.domain'};
1.1288 raeburn 11157: my ($trusted,$untrusted);
1.1287 raeburn 11158: if (($context eq 'requestcrs') || ($context eq 'course')) {
1.1288 raeburn 11159: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
1.1287 raeburn 11160: } elsif ($context eq 'author') {
1.1288 raeburn 11161: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
1.1287 raeburn 11162: } elsif ($context eq 'domain') {
1.1288 raeburn 11163: ($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
1.1287 raeburn 11164: }
1.1288 raeburn 11165: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
1.1255 raeburn 11166: }
1.563 raeburn 11167: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 11168:
11169: my @srchins = ('crs','dom','alc','instd');
11170:
11171: foreach my $option (@srchins) {
11172: # FIXME 'alc' option unavailable until
11173: # loncreateuser::print_user_query_page()
11174: # has been completed.
11175: next if ($option eq 'alc');
1.880 raeburn 11176: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 11177: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1279 raeburn 11178: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 11179: if ($curr_selected{'srchin'} eq $option) {
11180: $srchinsel .= '
1.1222 damieng 11181: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 11182: } else {
11183: $srchinsel .= '
1.1222 damieng 11184: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 11185: }
1.555 raeburn 11186: }
1.563 raeburn 11187: $srchinsel .= "\n </select>\n";
1.555 raeburn 11188:
11189: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 11190: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 11191: if ($curr_selected{'srchby'} eq $option) {
11192: $srchbysel .= '
1.1222 damieng 11193: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11194: } else {
11195: $srchbysel .= '
1.1222 damieng 11196: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11197: }
11198: }
11199: $srchbysel .= "\n </select>\n";
11200:
11201: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 11202: foreach my $option ('begins','contains','exact') {
1.555 raeburn 11203: if ($curr_selected{'srchtype'} eq $option) {
11204: $srchtypesel .= '
1.1222 damieng 11205: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11206: } else {
11207: $srchtypesel .= '
1.1222 damieng 11208: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11209: }
11210: }
11211: $srchtypesel .= "\n </select>\n";
11212:
1.558 albertel 11213: my ($newuserscript,$new_user_create);
1.994 raeburn 11214: my $context_dom = $env{'request.role.domain'};
11215: if ($context eq 'requestcrs') {
11216: if ($env{'form.coursedom'} ne '') {
11217: $context_dom = $env{'form.coursedom'};
11218: }
11219: }
1.556 raeburn 11220: if ($forcenewuser) {
1.576 raeburn 11221: if (ref($srch) eq 'HASH') {
1.994 raeburn 11222: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 11223: if ($cancreate) {
11224: $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>';
11225: } else {
1.799 bisitz 11226: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 11227: my %usertypetext = (
11228: official => 'institutional',
11229: unofficial => 'non-institutional',
11230: );
1.799 bisitz 11231: $new_user_create = '<p class="LC_warning">'
11232: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
11233: .' '
11234: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
11235: ,'<a href="'.$helplink.'">','</a>')
11236: .'</p><br />';
1.627 raeburn 11237: }
1.576 raeburn 11238: }
11239: }
11240:
1.556 raeburn 11241: $newuserscript = <<"ENDSCRIPT";
11242:
1.570 raeburn 11243: function setSearch(createnew,callingForm) {
1.556 raeburn 11244: if (createnew == 1) {
1.570 raeburn 11245: for (var i=0; i<callingForm.srchby.length; i++) {
11246: if (callingForm.srchby.options[i].value == 'uname') {
11247: callingForm.srchby.selectedIndex = i;
1.556 raeburn 11248: }
11249: }
1.570 raeburn 11250: for (var i=0; i<callingForm.srchin.length; i++) {
11251: if ( callingForm.srchin.options[i].value == 'dom') {
11252: callingForm.srchin.selectedIndex = i;
1.556 raeburn 11253: }
11254: }
1.570 raeburn 11255: for (var i=0; i<callingForm.srchtype.length; i++) {
11256: if (callingForm.srchtype.options[i].value == 'exact') {
11257: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 11258: }
11259: }
1.570 raeburn 11260: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 11261: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 11262: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 11263: }
11264: }
11265: }
11266: }
11267: ENDSCRIPT
1.558 albertel 11268:
1.556 raeburn 11269: }
11270:
1.555 raeburn 11271: my $output = <<"END_BLOCK";
1.556 raeburn 11272: <script type="text/javascript">
1.824 bisitz 11273: // <![CDATA[
1.570 raeburn 11274: function validateEntry(callingForm) {
1.558 albertel 11275:
1.556 raeburn 11276: var checkok = 1;
1.558 albertel 11277: var srchin;
1.570 raeburn 11278: for (var i=0; i<callingForm.srchin.length; i++) {
11279: if ( callingForm.srchin[i].checked ) {
11280: srchin = callingForm.srchin[i].value;
1.558 albertel 11281: }
11282: }
11283:
1.570 raeburn 11284: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
11285: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
11286: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
11287: var srchterm = callingForm.srchterm.value;
11288: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 11289: var msg = "";
11290:
11291: if (srchterm == "") {
11292: checkok = 0;
1.1222 damieng 11293: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 11294: }
11295:
1.569 raeburn 11296: if (srchtype== 'begins') {
11297: if (srchterm.length < 2) {
11298: checkok = 0;
1.1222 damieng 11299: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 11300: }
11301: }
11302:
1.556 raeburn 11303: if (srchtype== 'contains') {
11304: if (srchterm.length < 3) {
11305: checkok = 0;
1.1222 damieng 11306: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 11307: }
11308: }
11309: if (srchin == 'instd') {
11310: if (srchdomain == '') {
11311: checkok = 0;
1.1222 damieng 11312: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 11313: }
11314: }
11315: if (srchin == 'dom') {
11316: if (srchdomain == '') {
11317: checkok = 0;
1.1222 damieng 11318: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 11319: }
11320: }
11321: if (srchby == 'lastfirst') {
11322: if (srchterm.indexOf(",") == -1) {
11323: checkok = 0;
1.1222 damieng 11324: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 11325: }
11326: if (srchterm.indexOf(",") == srchterm.length -1) {
11327: checkok = 0;
1.1222 damieng 11328: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 11329: }
11330: }
11331: if (checkok == 0) {
1.1222 damieng 11332: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 11333: return;
11334: }
11335: if (checkok == 1) {
1.570 raeburn 11336: callingForm.submit();
1.556 raeburn 11337: }
11338: }
11339:
11340: $newuserscript
11341:
1.824 bisitz 11342: // ]]>
1.556 raeburn 11343: </script>
1.558 albertel 11344:
11345: $new_user_create
11346:
1.555 raeburn 11347: END_BLOCK
1.558 albertel 11348:
1.876 raeburn 11349: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1222 damieng 11350: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 11351: $domform.
11352: &Apache::lonhtmlcommon::row_closure().
1.1222 damieng 11353: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 11354: $srchbysel.
11355: $srchtypesel.
11356: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
11357: $srchinsel.
11358: &Apache::lonhtmlcommon::row_closure(1).
11359: &Apache::lonhtmlcommon::end_pick_box().
11360: '<br />';
1.1253 raeburn 11361: return ($output,1);
1.555 raeburn 11362: }
11363:
1.612 raeburn 11364: sub user_rule_check {
1.615 raeburn 11365: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1226 raeburn 11366: my ($response,%inst_response);
1.612 raeburn 11367: if (ref($usershash) eq 'HASH') {
1.1226 raeburn 11368: if (keys(%{$usershash}) > 1) {
11369: my (%by_username,%by_id,%userdoms);
11370: my $checkid;
11371: if (ref($checks) eq 'HASH') {
11372: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
11373: $checkid = 1;
11374: }
11375: }
11376: foreach my $user (keys(%{$usershash})) {
11377: my ($uname,$udom) = split(/:/,$user);
11378: if ($checkid) {
11379: if (ref($usershash->{$user}) eq 'HASH') {
11380: if ($usershash->{$user}->{'id'} ne '') {
1.1227 raeburn 11381: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
1.1226 raeburn 11382: $userdoms{$udom} = 1;
1.1227 raeburn 11383: if (ref($inst_results) eq 'HASH') {
11384: $inst_results->{$uname.':'.$udom} = {};
11385: }
1.1226 raeburn 11386: }
11387: }
11388: } else {
11389: $by_username{$udom}{$uname} = 1;
11390: $userdoms{$udom} = 1;
1.1227 raeburn 11391: if (ref($inst_results) eq 'HASH') {
11392: $inst_results->{$uname.':'.$udom} = {};
11393: }
1.1226 raeburn 11394: }
11395: }
11396: foreach my $udom (keys(%userdoms)) {
11397: if (!$got_rules->{$udom}) {
11398: my %domconfig = &Apache::lonnet::get_dom('configuration',
11399: ['usercreation'],$udom);
11400: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11401: foreach my $item ('username','id') {
11402: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
1.1227 raeburn 11403: $$curr_rules{$udom}{$item} =
11404: $domconfig{'usercreation'}{$item.'_rule'};
1.1226 raeburn 11405: }
11406: }
11407: }
11408: $got_rules->{$udom} = 1;
11409: }
1.612 raeburn 11410: }
1.1226 raeburn 11411: if ($checkid) {
11412: foreach my $udom (keys(%by_id)) {
11413: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
11414: if ($outcome eq 'ok') {
1.1227 raeburn 11415: foreach my $id (keys(%{$by_id{$udom}})) {
11416: my $uname = $by_id{$udom}{$id};
11417: $inst_response{$uname.':'.$udom} = $outcome;
11418: }
1.1226 raeburn 11419: if (ref($results) eq 'HASH') {
11420: foreach my $uname (keys(%{$results})) {
1.1227 raeburn 11421: if (exists($inst_response{$uname.':'.$udom})) {
11422: $inst_response{$uname.':'.$udom} = $outcome;
11423: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11424: }
1.1226 raeburn 11425: }
11426: }
11427: }
1.612 raeburn 11428: }
1.615 raeburn 11429: } else {
1.1226 raeburn 11430: foreach my $udom (keys(%by_username)) {
11431: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
11432: if ($outcome eq 'ok') {
1.1227 raeburn 11433: foreach my $uname (keys(%{$by_username{$udom}})) {
11434: $inst_response{$uname.':'.$udom} = $outcome;
11435: }
1.1226 raeburn 11436: if (ref($results) eq 'HASH') {
11437: foreach my $uname (keys(%{$results})) {
11438: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11439: }
11440: }
11441: }
11442: }
1.612 raeburn 11443: }
1.1226 raeburn 11444: } elsif (keys(%{$usershash}) == 1) {
11445: my $user = (keys(%{$usershash}))[0];
11446: my ($uname,$udom) = split(/:/,$user);
11447: if (($udom ne '') && ($uname ne '')) {
11448: if (ref($usershash->{$user}) eq 'HASH') {
11449: if (ref($checks) eq 'HASH') {
11450: if (defined($checks->{'username'})) {
11451: ($inst_response{$user},%{$inst_results->{$user}}) =
11452: &Apache::lonnet::get_instuser($udom,$uname);
11453: } elsif (defined($checks->{'id'})) {
11454: if ($usershash->{$user}->{'id'} ne '') {
11455: ($inst_response{$user},%{$inst_results->{$user}}) =
11456: &Apache::lonnet::get_instuser($udom,undef,
11457: $usershash->{$user}->{'id'});
11458: } else {
11459: ($inst_response{$user},%{$inst_results->{$user}}) =
11460: &Apache::lonnet::get_instuser($udom,$uname);
11461: }
1.585 raeburn 11462: }
1.1226 raeburn 11463: } else {
11464: ($inst_response{$user},%{$inst_results->{$user}}) =
11465: &Apache::lonnet::get_instuser($udom,$uname);
11466: return;
11467: }
11468: if (!$got_rules->{$udom}) {
11469: my %domconfig = &Apache::lonnet::get_dom('configuration',
11470: ['usercreation'],$udom);
11471: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11472: foreach my $item ('username','id') {
11473: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
11474: $$curr_rules{$udom}{$item} =
11475: $domconfig{'usercreation'}{$item.'_rule'};
11476: }
11477: }
11478: }
11479: $got_rules->{$udom} = 1;
1.585 raeburn 11480: }
11481: }
1.1226 raeburn 11482: } else {
11483: return;
11484: }
11485: } else {
11486: return;
11487: }
11488: foreach my $user (keys(%{$usershash})) {
11489: my ($uname,$udom) = split(/:/,$user);
11490: next if (($udom eq '') || ($uname eq ''));
11491: my $id;
1.1227 raeburn 11492: if (ref($inst_results) eq 'HASH') {
11493: if (ref($inst_results->{$user}) eq 'HASH') {
11494: $id = $inst_results->{$user}->{'id'};
11495: }
11496: }
11497: if ($id eq '') {
11498: if (ref($usershash->{$user})) {
11499: $id = $usershash->{$user}->{'id'};
11500: }
1.585 raeburn 11501: }
1.612 raeburn 11502: foreach my $item (keys(%{$checks})) {
11503: if (ref($$curr_rules{$udom}) eq 'HASH') {
11504: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
11505: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1226 raeburn 11506: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
11507: $$curr_rules{$udom}{$item});
1.612 raeburn 11508: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
11509: if ($rule_check{$rule}) {
11510: $$rulematch{$user}{$item} = $rule;
1.1226 raeburn 11511: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 11512: if (ref($inst_results) eq 'HASH') {
11513: if (ref($inst_results->{$user}) eq 'HASH') {
11514: if (keys(%{$inst_results->{$user}}) == 0) {
11515: $$alerts{$item}{$udom}{$uname} = 1;
1.1227 raeburn 11516: } elsif ($item eq 'id') {
11517: if ($inst_results->{$user}->{'id'} eq '') {
11518: $$alerts{$item}{$udom}{$uname} = 1;
11519: }
1.615 raeburn 11520: }
1.612 raeburn 11521: }
11522: }
1.615 raeburn 11523: }
11524: last;
1.585 raeburn 11525: }
11526: }
11527: }
11528: }
11529: }
11530: }
11531: }
11532: }
1.612 raeburn 11533: return;
11534: }
11535:
11536: sub user_rule_formats {
11537: my ($domain,$domdesc,$curr_rules,$check) = @_;
11538: my %text = (
11539: 'username' => 'Usernames',
11540: 'id' => 'IDs',
11541: );
11542: my $output;
11543: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
11544: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
11545: if (@{$ruleorder} > 0) {
1.1102 raeburn 11546: $output = '<br />'.
11547: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
11548: '<span class="LC_cusr_emph">','</span>',$domdesc).
11549: ' <ul>';
1.612 raeburn 11550: foreach my $rule (@{$ruleorder}) {
11551: if (ref($curr_rules) eq 'ARRAY') {
11552: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
11553: if (ref($rules->{$rule}) eq 'HASH') {
11554: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
11555: $rules->{$rule}{'desc'}.'</li>';
11556: }
11557: }
11558: }
11559: }
11560: $output .= '</ul>';
11561: }
11562: }
11563: return $output;
11564: }
11565:
11566: sub instrule_disallow_msg {
1.615 raeburn 11567: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 11568: my $response;
11569: my %text = (
11570: item => 'username',
11571: items => 'usernames',
11572: match => 'matches',
11573: do => 'does',
11574: action => 'a username',
11575: one => 'one',
11576: );
11577: if ($count > 1) {
11578: $text{'item'} = 'usernames';
11579: $text{'match'} ='match';
11580: $text{'do'} = 'do';
11581: $text{'action'} = 'usernames',
11582: $text{'one'} = 'ones';
11583: }
11584: if ($checkitem eq 'id') {
11585: $text{'items'} = 'IDs';
11586: $text{'item'} = 'ID';
11587: $text{'action'} = 'an ID';
1.615 raeburn 11588: if ($count > 1) {
11589: $text{'item'} = 'IDs';
11590: $text{'action'} = 'IDs';
11591: }
1.612 raeburn 11592: }
1.674 bisitz 11593: $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 11594: if ($mode eq 'upload') {
11595: if ($checkitem eq 'username') {
11596: $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'}.");
11597: } elsif ($checkitem eq 'id') {
1.674 bisitz 11598: $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 11599: }
1.669 raeburn 11600: } elsif ($mode eq 'selfcreate') {
11601: if ($checkitem eq 'id') {
11602: $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.");
11603: }
1.615 raeburn 11604: } else {
11605: if ($checkitem eq 'username') {
11606: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
11607: } elsif ($checkitem eq 'id') {
11608: $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.");
11609: }
1.612 raeburn 11610: }
11611: return $response;
1.585 raeburn 11612: }
11613:
1.624 raeburn 11614: sub personal_data_fieldtitles {
11615: my %fieldtitles = &Apache::lonlocal::texthash (
11616: id => 'Student/Employee ID',
11617: permanentemail => 'E-mail address',
11618: lastname => 'Last Name',
11619: firstname => 'First Name',
11620: middlename => 'Middle Name',
11621: generation => 'Generation',
11622: gen => 'Generation',
1.765 raeburn 11623: inststatus => 'Affiliation',
1.624 raeburn 11624: );
11625: return %fieldtitles;
11626: }
11627:
1.642 raeburn 11628: sub sorted_inst_types {
11629: my ($dom) = @_;
1.1185 raeburn 11630: my ($usertypes,$order);
11631: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
11632: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
11633: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
11634: $order = $domdefaults{'inststatus'}{'inststatusorder'};
11635: } else {
11636: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
11637: }
1.642 raeburn 11638: my $othertitle = &mt('All users');
11639: if ($env{'request.course.id'}) {
1.668 raeburn 11640: $othertitle = &mt('Any users');
1.642 raeburn 11641: }
11642: my @types;
11643: if (ref($order) eq 'ARRAY') {
11644: @types = @{$order};
11645: }
11646: if (@types == 0) {
11647: if (ref($usertypes) eq 'HASH') {
11648: @types = sort(keys(%{$usertypes}));
11649: }
11650: }
11651: if (keys(%{$usertypes}) > 0) {
11652: $othertitle = &mt('Other users');
11653: }
11654: return ($othertitle,$usertypes,\@types);
11655: }
11656:
1.645 raeburn 11657: sub get_institutional_codes {
1.1361 raeburn 11658: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 11659: # Get complete list of course sections to update
11660: my @currsections = ();
11661: my @currxlists = ();
1.1361 raeburn 11662: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 11663: my $coursecode = $$settings{'internal.coursecode'};
1.1361 raeburn 11664: my $crskey = $crs.':'.$coursecode;
11665: @{$unclutteredsec{$crskey}} = ();
11666: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 11667:
11668: if ($$settings{'internal.sectionnums'} ne '') {
11669: @currsections = split(/,/,$$settings{'internal.sectionnums'});
11670: }
11671:
11672: if ($$settings{'internal.crosslistings'} ne '') {
11673: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
11674: }
11675:
11676: if (@currxlists > 0) {
1.1361 raeburn 11677: foreach my $xl (@currxlists) {
11678: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 11679: unless (grep/^$1$/,@{$allcourses}) {
1.1263 raeburn 11680: push(@{$allcourses},$1);
1.645 raeburn 11681: $$LC_code{$1} = $2;
11682: }
11683: }
11684: }
11685: }
1.1361 raeburn 11686:
1.645 raeburn 11687: if (@currsections > 0) {
1.1361 raeburn 11688: foreach my $sec (@currsections) {
11689: if ($sec =~ m/^(\w+):(\w*)$/ ) {
11690: my $instsec = $1;
1.645 raeburn 11691: my $lc_sec = $2;
1.1361 raeburn 11692: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
11693: push(@{$unclutteredsec{$crskey}},$instsec);
11694: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
11695: }
11696: }
11697: }
11698: }
11699:
11700: if (@{$unclutteredsec{$crskey}} > 0) {
11701: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
11702: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
11703: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
11704: my $sec = $coursecode.$formattedsec{$crskey}[$i];
11705: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1263 raeburn 11706: push(@{$allcourses},$sec);
1.1361 raeburn 11707: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 11708: }
11709: }
11710: }
11711: }
11712: return;
11713: }
11714:
1.971 raeburn 11715: sub get_standard_codeitems {
11716: return ('Year','Semester','Department','Number','Section');
11717: }
11718:
1.112 bowersj2 11719: =pod
11720:
1.780 raeburn 11721: =head1 Slot Helpers
11722:
11723: =over 4
11724:
11725: =item * sorted_slots()
11726:
1.1040 raeburn 11727: Sorts an array of slot names in order of an optional sort key,
11728: default sort is by slot start time (earliest first).
1.780 raeburn 11729:
11730: Inputs:
11731:
11732: =over 4
11733:
11734: slotsarr - Reference to array of unsorted slot names.
11735:
11736: slots - Reference to hash of hash, where outer hash keys are slot names.
11737:
1.1040 raeburn 11738: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
11739:
1.549 albertel 11740: =back
11741:
1.780 raeburn 11742: Returns:
11743:
11744: =over 4
11745:
1.1040 raeburn 11746: sorted - An array of slot names sorted by a specified sort key
11747: (default sort key is start time of the slot).
1.780 raeburn 11748:
11749: =back
11750:
11751: =cut
11752:
11753:
11754: sub sorted_slots {
1.1040 raeburn 11755: my ($slotsarr,$slots,$sortkey) = @_;
11756: if ($sortkey eq '') {
11757: $sortkey = 'starttime';
11758: }
1.780 raeburn 11759: my @sorted;
11760: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
11761: @sorted =
11762: sort {
11763: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 11764: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 11765: }
11766: if (ref($slots->{$a})) { return -1;}
11767: if (ref($slots->{$b})) { return 1;}
11768: return 0;
11769: } @{$slotsarr};
11770: }
11771: return @sorted;
11772: }
11773:
1.1040 raeburn 11774: =pod
11775:
11776: =item * get_future_slots()
11777:
11778: Inputs:
11779:
11780: =over 4
11781:
11782: cnum - course number
11783:
11784: cdom - course domain
11785:
11786: now - current UNIX time
11787:
11788: symb - optional symb
11789:
11790: =back
11791:
11792: Returns:
11793:
11794: =over 4
11795:
11796: sorted_reservable - ref to array of student_schedulable slots currently
11797: reservable, ordered by end date of reservation period.
11798:
11799: reservable_now - ref to hash of student_schedulable slots currently
11800: reservable.
11801:
11802: Keys in inner hash are:
11803: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 11804: (b) endreserve: end date of reservation period.
11805: (c) uniqueperiod: start,end dates when slot is to be uniquely
11806: selected.
1.1040 raeburn 11807:
11808: sorted_future - ref to array of student_schedulable slots reservable in
11809: the future, ordered by start date of reservation period.
11810:
11811: future_reservable - ref to hash of student_schedulable slots reservable
11812: in the future.
11813:
11814: Keys in inner hash are:
11815: (a) symb: either blank or symb to which slot use is restricted.
1.1250 raeburn 11816: (b) startreserve: start date of reservation period.
11817: (c) uniqueperiod: start,end dates when slot is to be uniquely
11818: selected.
1.1040 raeburn 11819:
11820: =back
11821:
11822: =cut
11823:
11824: sub get_future_slots {
11825: my ($cnum,$cdom,$now,$symb) = @_;
1.1229 raeburn 11826: my $map;
11827: if ($symb) {
11828: ($map) = &Apache::lonnet::decode_symb($symb);
11829: }
1.1040 raeburn 11830: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
11831: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
11832: foreach my $slot (keys(%slots)) {
11833: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
11834: if ($symb) {
1.1229 raeburn 11835: if ($slots{$slot}->{'symb'} ne '') {
11836: my $canuse;
11837: my %oksymbs;
11838: my @slotsymbs = split(/\s*,\s*/,$slots{$slot}->{'symb'});
11839: map { $oksymbs{$_} = 1; } @slotsymbs;
11840: if ($oksymbs{$symb}) {
11841: $canuse = 1;
11842: } else {
11843: foreach my $item (@slotsymbs) {
11844: if ($item =~ /\.(page|sequence)$/) {
11845: (undef,undef,my $sloturl) = &Apache::lonnet::decode_symb($item);
11846: if (($map ne '') && ($map eq $sloturl)) {
11847: $canuse = 1;
11848: last;
11849: }
11850: }
11851: }
11852: }
11853: next unless ($canuse);
11854: }
1.1040 raeburn 11855: }
11856: if (($slots{$slot}->{'starttime'} > $now) &&
11857: ($slots{$slot}->{'endtime'} > $now)) {
11858: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
11859: my $userallowed = 0;
11860: if ($slots{$slot}->{'allowedsections'}) {
11861: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
11862: if (!defined($env{'request.role.sec'})
11863: && grep(/^No section assigned$/,@allowed_sec)) {
11864: $userallowed=1;
11865: } else {
11866: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
11867: $userallowed=1;
11868: }
11869: }
11870: unless ($userallowed) {
11871: if (defined($env{'request.course.groups'})) {
11872: my @groups = split(/:/,$env{'request.course.groups'});
11873: foreach my $group (@groups) {
11874: if (grep(/^\Q$group\E$/,@allowed_sec)) {
11875: $userallowed=1;
11876: last;
11877: }
11878: }
11879: }
11880: }
11881: }
11882: if ($slots{$slot}->{'allowedusers'}) {
11883: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
11884: my $user = $env{'user.name'}.':'.$env{'user.domain'};
11885: if (grep(/^\Q$user\E$/,@allowed_users)) {
11886: $userallowed = 1;
11887: }
11888: }
11889: next unless($userallowed);
11890: }
11891: my $startreserve = $slots{$slot}->{'startreserve'};
11892: my $endreserve = $slots{$slot}->{'endreserve'};
11893: my $symb = $slots{$slot}->{'symb'};
1.1250 raeburn 11894: my $uniqueperiod;
11895: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
11896: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
11897: }
1.1040 raeburn 11898: if (($startreserve < $now) &&
11899: (!$endreserve || $endreserve > $now)) {
11900: my $lastres = $endreserve;
11901: if (!$lastres) {
11902: $lastres = $slots{$slot}->{'starttime'};
11903: }
11904: $reservable_now{$slot} = {
11905: symb => $symb,
1.1250 raeburn 11906: endreserve => $lastres,
11907: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11908: };
11909: } elsif (($startreserve > $now) &&
11910: (!$endreserve || $endreserve > $startreserve)) {
11911: $future_reservable{$slot} = {
11912: symb => $symb,
1.1250 raeburn 11913: startreserve => $startreserve,
11914: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11915: };
11916: }
11917: }
11918: }
11919: my @unsorted_reservable = keys(%reservable_now);
11920: if (@unsorted_reservable > 0) {
11921: @sorted_reservable =
11922: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
11923: }
11924: my @unsorted_future = keys(%future_reservable);
11925: if (@unsorted_future > 0) {
11926: @sorted_future =
11927: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
11928: }
11929: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
11930: }
1.780 raeburn 11931:
11932: =pod
11933:
1.1057 foxr 11934: =back
11935:
1.549 albertel 11936: =head1 HTTP Helpers
11937:
11938: =over 4
11939:
1.648 raeburn 11940: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 11941:
1.258 albertel 11942: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 11943: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 11944: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 11945:
11946: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
11947: $possible_names is an ref to an array of form element names. As an example:
11948: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 11949: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 11950:
11951: =cut
1.1 albertel 11952:
1.6 albertel 11953: sub get_unprocessed_cgi {
1.25 albertel 11954: my ($query,$possible_names)= @_;
1.26 matthew 11955: # $Apache::lonxml::debug=1;
1.356 albertel 11956: foreach my $pair (split(/&/,$query)) {
11957: my ($name, $value) = split(/=/,$pair);
1.369 www 11958: $name = &unescape($name);
1.25 albertel 11959: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
11960: $value =~ tr/+/ /;
11961: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 11962: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 11963: }
1.16 harris41 11964: }
1.6 albertel 11965: }
11966:
1.112 bowersj2 11967: =pod
11968:
1.648 raeburn 11969: =item * &cacheheader()
1.112 bowersj2 11970:
11971: returns cache-controlling header code
11972:
11973: =cut
11974:
1.7 albertel 11975: sub cacheheader {
1.258 albertel 11976: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 11977: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
11978: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 11979: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
11980: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 11981: return $output;
1.7 albertel 11982: }
11983:
1.112 bowersj2 11984: =pod
11985:
1.648 raeburn 11986: =item * &no_cache($r)
1.112 bowersj2 11987:
11988: specifies header code to not have cache
11989:
11990: =cut
11991:
1.9 albertel 11992: sub no_cache {
1.216 albertel 11993: my ($r) = @_;
11994: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 11995: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 11996: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
11997: $r->no_cache(1);
11998: $r->header_out("Expires" => $date);
11999: $r->header_out("Pragma" => "no-cache");
1.123 www 12000: }
12001:
12002: sub content_type {
1.181 albertel 12003: my ($r,$type,$charset) = @_;
1.299 foxr 12004: if ($r) {
12005: # Note that printout.pl calls this with undef for $r.
12006: &no_cache($r);
12007: }
1.258 albertel 12008: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 12009: unless ($charset) {
12010: $charset=&Apache::lonlocal::current_encoding;
12011: }
12012: if ($charset) { $type.='; charset='.$charset; }
12013: if ($r) {
12014: $r->content_type($type);
12015: } else {
12016: print("Content-type: $type\n\n");
12017: }
1.9 albertel 12018: }
1.25 albertel 12019:
1.112 bowersj2 12020: =pod
12021:
1.648 raeburn 12022: =item * &add_to_env($name,$value)
1.112 bowersj2 12023:
1.258 albertel 12024: adds $name to the %env hash with value
1.112 bowersj2 12025: $value, if $name already exists, the entry is converted to an array
12026: reference and $value is added to the array.
12027:
12028: =cut
12029:
1.25 albertel 12030: sub add_to_env {
12031: my ($name,$value)=@_;
1.258 albertel 12032: if (defined($env{$name})) {
12033: if (ref($env{$name})) {
1.25 albertel 12034: #already have multiple values
1.258 albertel 12035: push(@{ $env{$name} },$value);
1.25 albertel 12036: } else {
12037: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 12038: my $first=$env{$name};
12039: undef($env{$name});
12040: push(@{ $env{$name} },$first,$value);
1.25 albertel 12041: }
12042: } else {
1.258 albertel 12043: $env{$name}=$value;
1.25 albertel 12044: }
1.31 albertel 12045: }
1.149 albertel 12046:
12047: =pod
12048:
1.648 raeburn 12049: =item * &get_env_multiple($name)
1.149 albertel 12050:
1.258 albertel 12051: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 12052: values may be defined and end up as an array ref.
12053:
12054: returns an array of values
12055:
12056: =cut
12057:
12058: sub get_env_multiple {
12059: my ($name) = @_;
12060: my @values;
1.258 albertel 12061: if (defined($env{$name})) {
1.149 albertel 12062: # exists is it an array
1.258 albertel 12063: if (ref($env{$name})) {
12064: @values=@{ $env{$name} };
1.149 albertel 12065: } else {
1.258 albertel 12066: $values[0]=$env{$name};
1.149 albertel 12067: }
12068: }
12069: return(@values);
12070: }
12071:
1.1249 damieng 12072: # Looks at given dependencies, and returns something depending on the context.
12073: # For coursedocs paste, returns (undef, $counter, $numpathchg, \%existing).
12074: # For syllabus rewrites, returns (undef, $counter, $numpathchg, \%existing, \%mapping).
12075: # For all other contexts, returns ($output, $counter, $numpathchg).
12076: # $output: string with the HTML output. Can contain missing dependencies with an upload form, existing dependencies, and dependencies no longer in use.
12077: # $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.
12078: # $numpathchg: integer with the number of cleaned up dependency paths.
12079: # \%existing: hash reference clean path -> 1 only for existing dependencies.
12080: # \%mapping: hash reference clean path -> original path for all dependencies.
12081: # @param {string} actionurl - The path to the handler, indicative of the context.
12082: # @param {string} state - Can contain HTML with hidden inputs that will be added to the output form.
12083: # @param {hash reference} allfiles - List of file info from lonnet::extract_embedded_items
12084: # @param {hash reference} codebase - undef, not modified by lonnet::extract_embedded_items ?
12085: # @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)
12086: # @return {Array} - array depending on the context (not a reference)
1.660 raeburn 12087: sub ask_for_embedded_content {
1.1249 damieng 12088: # NOTE: documentation was added afterwards, it could be wrong
1.660 raeburn 12089: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 12090: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 12091: %currsubfile,%unused,$rem);
1.1071 raeburn 12092: my $counter = 0;
12093: my $numnew = 0;
1.987 raeburn 12094: my $numremref = 0;
12095: my $numinvalid = 0;
12096: my $numpathchg = 0;
12097: my $numexisting = 0;
1.1071 raeburn 12098: my $numunused = 0;
12099: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 12100: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 12101: my $heading = &mt('Upload embedded files');
12102: my $buttontext = &mt('Upload');
12103:
1.1249 damieng 12104: # fills these variables based on the context:
12105: # $navmap, $cdom, $cnum, $udom, $uname, $url, $toplevel, $getpropath,
12106: # $path, $fileloc, $title, $rem, $filename
1.1085 raeburn 12107: if ($env{'request.course.id'}) {
1.1123 raeburn 12108: if ($actionurl eq '/adm/dependencies') {
12109: $navmap = Apache::lonnavmaps::navmap->new();
12110: }
12111: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
12112: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 12113: }
1.1123 raeburn 12114: if (($actionurl eq '/adm/portfolio') ||
12115: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 12116: my $current_path='/';
12117: if ($env{'form.currentpath'}) {
12118: $current_path = $env{'form.currentpath'};
12119: }
12120: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 12121: $udom = $cdom;
12122: $uname = $cnum;
1.984 raeburn 12123: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
12124: } else {
12125: $udom = $env{'user.domain'};
12126: $uname = $env{'user.name'};
12127: $url = '/userfiles/portfolio';
12128: }
1.987 raeburn 12129: $toplevel = $url.'/';
1.984 raeburn 12130: $url .= $current_path;
12131: $getpropath = 1;
1.987 raeburn 12132: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12133: ($actionurl eq '/adm/imsimport')) {
1.1022 www 12134: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 12135: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 12136: $toplevel = $url;
1.984 raeburn 12137: if ($rest ne '') {
1.987 raeburn 12138: $url .= $rest;
12139: }
12140: } elsif ($actionurl eq '/adm/coursedocs') {
12141: if (ref($args) eq 'HASH') {
1.1071 raeburn 12142: $url = $args->{'docs_url'};
12143: $toplevel = $url;
1.1084 raeburn 12144: if ($args->{'context'} eq 'paste') {
12145: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
12146: ($path) =
12147: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12148: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12149: $fileloc =~ s{^/}{};
12150: }
1.1071 raeburn 12151: }
1.1084 raeburn 12152: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 12153: if ($env{'request.course.id'} ne '') {
12154: if (ref($args) eq 'HASH') {
12155: $url = $args->{'docs_url'};
12156: $title = $args->{'docs_title'};
1.1126 raeburn 12157: $toplevel = $url;
12158: unless ($toplevel =~ m{^/}) {
12159: $toplevel = "/$url";
12160: }
1.1085 raeburn 12161: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 12162: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
12163: $path = $1;
12164: } else {
12165: ($path) =
12166: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12167: }
1.1195 raeburn 12168: if ($toplevel=~/^\/*(uploaded|editupload)/) {
12169: $fileloc = $toplevel;
12170: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
12171: my ($udom,$uname,$fname) =
12172: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
12173: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
12174: } else {
12175: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12176: }
1.1071 raeburn 12177: $fileloc =~ s{^/}{};
12178: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
12179: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
12180: }
1.987 raeburn 12181: }
1.1123 raeburn 12182: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12183: $udom = $cdom;
12184: $uname = $cnum;
12185: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
12186: $toplevel = $url;
12187: $path = $url;
12188: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
12189: $fileloc =~ s{^/}{};
1.987 raeburn 12190: }
1.1249 damieng 12191:
12192: # parses the dependency paths to get some info
12193: # fills $newfiles, $mapping, $subdependencies, $dependencies
12194: # $newfiles: hash URL -> 1 for new files or external URLs
12195: # (will be completed later)
12196: # $mapping:
12197: # for external URLs: external URL -> external URL
12198: # for relative paths: clean path -> original path
12199: # $subdependencies: hash clean path -> clean file name -> 1 for relative paths in subdirectories
12200: # $dependencies: hash clean or not file name -> 1 for relative paths not in subdirectories
1.1126 raeburn 12201: foreach my $file (keys(%{$allfiles})) {
12202: my $embed_file;
12203: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
12204: $embed_file = $1;
12205: } else {
12206: $embed_file = $file;
12207: }
1.1158 raeburn 12208: my ($absolutepath,$cleaned_file);
12209: if ($embed_file =~ m{^\w+://}) {
12210: $cleaned_file = $embed_file;
1.1147 raeburn 12211: $newfiles{$cleaned_file} = 1;
12212: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12213: } else {
1.1158 raeburn 12214: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 12215: if ($embed_file =~ m{^/}) {
12216: $absolutepath = $embed_file;
12217: }
1.1147 raeburn 12218: if ($cleaned_file =~ m{/}) {
12219: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 12220: $path = &check_for_traversal($path,$url,$toplevel);
12221: my $item = $fname;
12222: if ($path ne '') {
12223: $item = $path.'/'.$fname;
12224: $subdependencies{$path}{$fname} = 1;
12225: } else {
12226: $dependencies{$item} = 1;
12227: }
12228: if ($absolutepath) {
12229: $mapping{$item} = $absolutepath;
12230: } else {
12231: $mapping{$item} = $embed_file;
12232: }
12233: } else {
12234: $dependencies{$embed_file} = 1;
12235: if ($absolutepath) {
1.1147 raeburn 12236: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 12237: } else {
1.1147 raeburn 12238: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12239: }
12240: }
1.984 raeburn 12241: }
12242: }
1.1249 damieng 12243:
12244: # looks for all existing files in dependency subdirectories (from $subdependencies filled above)
12245: # and lists
12246: # fills $currsubfile, $pathchanges, $existing, $numexisting, $newfiles, $unused
12247: # $currsubfile: hash clean path -> file name -> 1 for all existing files in the path
12248: # $pathchanges: hash clean path -> 1 if the file in subdirectory exists and
12249: # the path had to be cleaned up
12250: # $existing: hash clean path -> 1 if the file exists
12251: # $numexisting: number of keys in $existing
12252: # $newfiles: updated with clean path -> 1 for files in subdirectories that do not exist
12253: # $unused: only for /adm/dependencies, hash clean path -> 1 for existing files in
12254: # dependency subdirectories that are
12255: # not listed as dependencies, with some exceptions using $rem
1.1071 raeburn 12256: my $dirptr = 16384;
1.984 raeburn 12257: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 12258: $currsubfile{$path} = {};
1.1123 raeburn 12259: if (($actionurl eq '/adm/portfolio') ||
12260: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12261: my ($sublistref,$listerror) =
12262: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
12263: if (ref($sublistref) eq 'ARRAY') {
12264: foreach my $line (@{$sublistref}) {
12265: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 12266: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 12267: }
1.984 raeburn 12268: }
1.987 raeburn 12269: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12270: if (opendir(my $dir,$url.'/'.$path)) {
12271: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 12272: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
12273: }
1.1084 raeburn 12274: } elsif (($actionurl eq '/adm/dependencies') ||
12275: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12276: ($args->{'context'} eq 'paste')) ||
12277: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12278: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 12279: my $dir;
12280: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12281: $dir = $fileloc;
12282: } else {
12283: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12284: }
1.1071 raeburn 12285: if ($dir ne '') {
12286: my ($sublistref,$listerror) =
12287: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
12288: if (ref($sublistref) eq 'ARRAY') {
12289: foreach my $line (@{$sublistref}) {
12290: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
12291: undef,$mtime)=split(/\&/,$line,12);
12292: unless (($testdir&$dirptr) ||
12293: ($file_name =~ /^\.\.?$/)) {
12294: $currsubfile{$path}{$file_name} = [$size,$mtime];
12295: }
12296: }
12297: }
12298: }
1.984 raeburn 12299: }
12300: }
12301: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 12302: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 12303: my $item = $path.'/'.$file;
12304: unless ($mapping{$item} eq $item) {
12305: $pathchanges{$item} = 1;
12306: }
12307: $existing{$item} = 1;
12308: $numexisting ++;
12309: } else {
12310: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 12311: }
12312: }
1.1071 raeburn 12313: if ($actionurl eq '/adm/dependencies') {
12314: foreach my $path (keys(%currsubfile)) {
12315: if (ref($currsubfile{$path}) eq 'HASH') {
12316: foreach my $file (keys(%{$currsubfile{$path}})) {
12317: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 12318: next if (($rem ne '') &&
12319: (($env{"httpref.$rem"."$path/$file"} ne '') ||
12320: (ref($navmap) &&
12321: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
12322: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12323: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 12324: $unused{$path.'/'.$file} = 1;
12325: }
12326: }
12327: }
12328: }
12329: }
1.984 raeburn 12330: }
1.1249 damieng 12331:
12332: # fills $currfile, hash file name -> 1 or [$size,$mtime]
12333: # for files in $url or $fileloc (target directory) in some contexts
1.987 raeburn 12334: my %currfile;
1.1123 raeburn 12335: if (($actionurl eq '/adm/portfolio') ||
12336: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12337: my ($dirlistref,$listerror) =
12338: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
12339: if (ref($dirlistref) eq 'ARRAY') {
12340: foreach my $line (@{$dirlistref}) {
12341: my ($file_name,$rest) = split(/\&/,$line,2);
12342: $currfile{$file_name} = 1;
12343: }
1.984 raeburn 12344: }
1.987 raeburn 12345: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12346: if (opendir(my $dir,$url)) {
1.987 raeburn 12347: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 12348: map {$currfile{$_} = 1;} @dir_list;
12349: }
1.1084 raeburn 12350: } elsif (($actionurl eq '/adm/dependencies') ||
12351: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 12352: ($args->{'context'} eq 'paste')) ||
12353: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12354: if ($env{'request.course.id'} ne '') {
12355: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12356: if ($dir ne '') {
12357: my ($dirlistref,$listerror) =
12358: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
12359: if (ref($dirlistref) eq 'ARRAY') {
12360: foreach my $line (@{$dirlistref}) {
12361: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
12362: $size,undef,$mtime)=split(/\&/,$line,12);
12363: unless (($testdir&$dirptr) ||
12364: ($file_name =~ /^\.\.?$/)) {
12365: $currfile{$file_name} = [$size,$mtime];
12366: }
12367: }
12368: }
12369: }
12370: }
1.984 raeburn 12371: }
1.1249 damieng 12372: # updates $pathchanges, $existing, $numexisting, $newfiles and $unused for files that
12373: # are not in subdirectories, using $currfile
1.984 raeburn 12374: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 12375: if (exists($currfile{$file})) {
1.987 raeburn 12376: unless ($mapping{$file} eq $file) {
12377: $pathchanges{$file} = 1;
12378: }
12379: $existing{$file} = 1;
12380: $numexisting ++;
12381: } else {
1.984 raeburn 12382: $newfiles{$file} = 1;
12383: }
12384: }
1.1071 raeburn 12385: foreach my $file (keys(%currfile)) {
12386: unless (($file eq $filename) ||
12387: ($file eq $filename.'.bak') ||
12388: ($dependencies{$file})) {
1.1085 raeburn 12389: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 12390: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
12391: next if (($rem ne '') &&
12392: (($env{"httpref.$rem".$file} ne '') ||
12393: (ref($navmap) &&
12394: (($navmap->getResourceByUrl($rem.$file) ne '') ||
12395: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12396: ($navmap->getResourceByUrl($rem.$1)))))));
12397: }
1.1085 raeburn 12398: }
1.1071 raeburn 12399: $unused{$file} = 1;
12400: }
12401: }
1.1249 damieng 12402:
12403: # returns some results for coursedocs paste and syllabus rewrites ($output is undef)
1.1084 raeburn 12404: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
12405: ($args->{'context'} eq 'paste')) {
12406: $counter = scalar(keys(%existing));
12407: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 12408: return ($output,$counter,$numpathchg,\%existing);
12409: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
12410: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
12411: $counter = scalar(keys(%existing));
12412: $numpathchg = scalar(keys(%pathchanges));
12413: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 12414: }
1.1249 damieng 12415:
12416: # returns HTML otherwise, with dependency results and to ask for more uploads
12417:
12418: # $upload_output: missing dependencies (with upload form)
12419: # $modify_output: uploaded dependencies (in use)
12420: # $delete_output: files no longer in use (unused files are not listed for londocs, bug?)
1.984 raeburn 12421: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 12422: if ($actionurl eq '/adm/dependencies') {
12423: next if ($embed_file =~ m{^\w+://});
12424: }
1.660 raeburn 12425: $upload_output .= &start_data_table_row().
1.1123 raeburn 12426: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 12427: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 12428: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 12429: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
12430: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 12431: }
1.1123 raeburn 12432: $upload_output .= '</td>';
1.1071 raeburn 12433: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 12434: $upload_output.='<td align="right">'.
12435: '<span class="LC_info LC_fontsize_medium">'.
12436: &mt("URL points to web address").'</span>';
1.987 raeburn 12437: $numremref++;
1.660 raeburn 12438: } elsif ($args->{'error_on_invalid_names'}
12439: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 12440: $upload_output.='<td align="right"><span class="LC_warning">'.
12441: &mt('Invalid characters').'</span>';
1.987 raeburn 12442: $numinvalid++;
1.660 raeburn 12443: } else {
1.1123 raeburn 12444: $upload_output .= '<td>'.
12445: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 12446: $embed_file,\%mapping,
1.1071 raeburn 12447: $allfiles,$codebase,'upload');
12448: $counter ++;
12449: $numnew ++;
1.987 raeburn 12450: }
12451: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
12452: }
12453: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 12454: if ($actionurl eq '/adm/dependencies') {
12455: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
12456: $modify_output .= &start_data_table_row().
12457: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
12458: '<img src="'.&icon($embed_file).'" border="0" />'.
12459: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
12460: '<td>'.$size.'</td>'.
12461: '<td>'.$mtime.'</td>'.
12462: '<td><label><input type="checkbox" name="mod_upload_dep" '.
12463: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
12464: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
12465: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
12466: &embedded_file_element('upload_embedded',$counter,
12467: $embed_file,\%mapping,
12468: $allfiles,$codebase,'modify').
12469: '</div></td>'.
12470: &end_data_table_row()."\n";
12471: $counter ++;
12472: } else {
12473: $upload_output .= &start_data_table_row().
1.1123 raeburn 12474: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
12475: '<span class="LC_filename">'.$embed_file.'</span></td>'.
12476: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 12477: &Apache::loncommon::end_data_table_row()."\n";
12478: }
12479: }
12480: my $delidx = $counter;
12481: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
12482: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
12483: $delete_output .= &start_data_table_row().
12484: '<td><img src="'.&icon($oldfile).'" />'.
12485: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
12486: '<td>'.$size.'</td>'.
12487: '<td>'.$mtime.'</td>'.
12488: '<td><label><input type="checkbox" name="del_upload_dep" '.
12489: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
12490: &embedded_file_element('upload_embedded',$delidx,
12491: $oldfile,\%mapping,$allfiles,
12492: $codebase,'delete').'</td>'.
12493: &end_data_table_row()."\n";
12494: $numunused ++;
12495: $delidx ++;
1.987 raeburn 12496: }
12497: if ($upload_output) {
12498: $upload_output = &start_data_table().
12499: $upload_output.
12500: &end_data_table()."\n";
12501: }
1.1071 raeburn 12502: if ($modify_output) {
12503: $modify_output = &start_data_table().
12504: &start_data_table_header_row().
12505: '<th>'.&mt('File').'</th>'.
12506: '<th>'.&mt('Size (KB)').'</th>'.
12507: '<th>'.&mt('Modified').'</th>'.
12508: '<th>'.&mt('Upload replacement?').'</th>'.
12509: &end_data_table_header_row().
12510: $modify_output.
12511: &end_data_table()."\n";
12512: }
12513: if ($delete_output) {
12514: $delete_output = &start_data_table().
12515: &start_data_table_header_row().
12516: '<th>'.&mt('File').'</th>'.
12517: '<th>'.&mt('Size (KB)').'</th>'.
12518: '<th>'.&mt('Modified').'</th>'.
12519: '<th>'.&mt('Delete?').'</th>'.
12520: &end_data_table_header_row().
12521: $delete_output.
12522: &end_data_table()."\n";
12523: }
1.987 raeburn 12524: my $applies = 0;
12525: if ($numremref) {
12526: $applies ++;
12527: }
12528: if ($numinvalid) {
12529: $applies ++;
12530: }
12531: if ($numexisting) {
12532: $applies ++;
12533: }
1.1071 raeburn 12534: if ($counter || $numunused) {
1.987 raeburn 12535: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
12536: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 12537: $state.'<h3>'.$heading.'</h3>';
12538: if ($actionurl eq '/adm/dependencies') {
12539: if ($numnew) {
12540: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
12541: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
12542: $upload_output.'<br />'."\n";
12543: }
12544: if ($numexisting) {
12545: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
12546: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
12547: $modify_output.'<br />'."\n";
12548: $buttontext = &mt('Save changes');
12549: }
12550: if ($numunused) {
12551: $output .= '<h4>'.&mt('Unused files').'</h4>'.
12552: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
12553: $delete_output.'<br />'."\n";
12554: $buttontext = &mt('Save changes');
12555: }
12556: } else {
12557: $output .= $upload_output.'<br />'."\n";
12558: }
12559: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
12560: $counter.'" />'."\n";
12561: if ($actionurl eq '/adm/dependencies') {
12562: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
12563: $numnew.'" />'."\n";
12564: } elsif ($actionurl eq '') {
1.987 raeburn 12565: $output .= '<input type="hidden" name="phase" value="three" />';
12566: }
12567: } elsif ($applies) {
12568: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
12569: if ($applies > 1) {
12570: $output .=
1.1123 raeburn 12571: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 12572: if ($numremref) {
12573: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
12574: }
12575: if ($numinvalid) {
12576: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
12577: }
12578: if ($numexisting) {
12579: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
12580: }
12581: $output .= '</ul><br />';
12582: } elsif ($numremref) {
12583: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
12584: } elsif ($numinvalid) {
12585: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
12586: } elsif ($numexisting) {
12587: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
12588: }
12589: $output .= $upload_output.'<br />';
12590: }
12591: my ($pathchange_output,$chgcount);
1.1071 raeburn 12592: $chgcount = $counter;
1.987 raeburn 12593: if (keys(%pathchanges) > 0) {
12594: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 12595: if ($counter) {
1.987 raeburn 12596: $output .= &embedded_file_element('pathchange',$chgcount,
12597: $embed_file,\%mapping,
1.1071 raeburn 12598: $allfiles,$codebase,'change');
1.987 raeburn 12599: } else {
12600: $pathchange_output .=
12601: &start_data_table_row().
12602: '<td><input type ="checkbox" name="namechange" value="'.
12603: $chgcount.'" checked="checked" /></td>'.
12604: '<td>'.$mapping{$embed_file}.'</td>'.
12605: '<td>'.$embed_file.
12606: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 12607: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 12608: '</td>'.&end_data_table_row();
1.660 raeburn 12609: }
1.987 raeburn 12610: $numpathchg ++;
12611: $chgcount ++;
1.660 raeburn 12612: }
12613: }
1.1127 raeburn 12614: if (($counter) || ($numunused)) {
1.987 raeburn 12615: if ($numpathchg) {
12616: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
12617: $numpathchg.'" />'."\n";
12618: }
12619: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12620: ($actionurl eq '/adm/imsimport')) {
12621: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
12622: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
12623: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 12624: } elsif ($actionurl eq '/adm/dependencies') {
12625: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 12626: }
1.1123 raeburn 12627: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 12628: } elsif ($numpathchg) {
12629: my %pathchange = ();
12630: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
12631: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12632: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 12633: }
1.987 raeburn 12634: }
1.1071 raeburn 12635: return ($output,$counter,$numpathchg);
1.987 raeburn 12636: }
12637:
1.1147 raeburn 12638: =pod
12639:
12640: =item * clean_path($name)
12641:
12642: Performs clean-up of directories, subdirectories and filename in an
12643: embedded object, referenced in an HTML file which is being uploaded
12644: to a course or portfolio, where
12645: "Upload embedded images/multimedia files if HTML file" checkbox was
12646: checked.
12647:
12648: Clean-up is similar to replacements in lonnet::clean_filename()
12649: except each / between sub-directory and next level is preserved.
12650:
12651: =cut
12652:
12653: sub clean_path {
12654: my ($embed_file) = @_;
12655: $embed_file =~s{^/+}{};
12656: my @contents;
12657: if ($embed_file =~ m{/}) {
12658: @contents = split(/\//,$embed_file);
12659: } else {
12660: @contents = ($embed_file);
12661: }
12662: my $lastidx = scalar(@contents)-1;
12663: for (my $i=0; $i<=$lastidx; $i++) {
12664: $contents[$i]=~s{\\}{/}g;
12665: $contents[$i]=~s/\s+/\_/g;
12666: $contents[$i]=~s{[^/\w\.\-]}{}g;
12667: if ($i == $lastidx) {
12668: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
12669: }
12670: }
12671: if ($lastidx > 0) {
12672: return join('/',@contents);
12673: } else {
12674: return $contents[0];
12675: }
12676: }
12677:
1.987 raeburn 12678: sub embedded_file_element {
1.1071 raeburn 12679: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 12680: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
12681: (ref($codebase) eq 'HASH'));
12682: my $output;
1.1071 raeburn 12683: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 12684: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
12685: }
12686: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
12687: &escape($embed_file).'" />';
12688: unless (($context eq 'upload_embedded') &&
12689: ($mapping->{$embed_file} eq $embed_file)) {
12690: $output .='
12691: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
12692: }
12693: my $attrib;
12694: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
12695: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
12696: }
12697: $output .=
12698: "\n\t\t".
12699: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
12700: $attrib.'" />';
12701: if (exists($codebase->{$mapping->{$embed_file}})) {
12702: $output .=
12703: "\n\t\t".
12704: '<input name="codebase_'.$num.'" type="hidden" value="'.
12705: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 12706: }
1.987 raeburn 12707: return $output;
1.660 raeburn 12708: }
12709:
1.1071 raeburn 12710: sub get_dependency_details {
12711: my ($currfile,$currsubfile,$embed_file) = @_;
12712: my ($size,$mtime,$showsize,$showmtime);
12713: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
12714: if ($embed_file =~ m{/}) {
12715: my ($path,$fname) = split(/\//,$embed_file);
12716: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
12717: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
12718: }
12719: } else {
12720: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
12721: ($size,$mtime) = @{$currfile->{$embed_file}};
12722: }
12723: }
12724: $showsize = $size/1024.0;
12725: $showsize = sprintf("%.1f",$showsize);
12726: if ($mtime > 0) {
12727: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
12728: }
12729: }
12730: return ($showsize,$showmtime);
12731: }
12732:
12733: sub ask_embedded_js {
12734: return <<"END";
12735: <script type="text/javascript"">
12736: // <![CDATA[
12737: function toggleBrowse(counter) {
12738: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
12739: var fileid = document.getElementById('embedded_item_'+counter);
12740: var uploaddivid = document.getElementById('moduploaddep_'+counter);
12741: if (chkboxid.checked == true) {
12742: uploaddivid.style.display='block';
12743: } else {
12744: uploaddivid.style.display='none';
12745: fileid.value = '';
12746: }
12747: }
12748: // ]]>
12749: </script>
12750:
12751: END
12752: }
12753:
1.661 raeburn 12754: sub upload_embedded {
12755: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 12756: $current_disk_usage,$hiddenstate,$actionurl) = @_;
12757: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 12758: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
12759: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
12760: my $orig_uploaded_filename =
12761: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 12762: foreach my $type ('orig','ref','attrib','codebase') {
12763: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
12764: $env{'form.embedded_'.$type.'_'.$i} =
12765: &unescape($env{'form.embedded_'.$type.'_'.$i});
12766: }
12767: }
1.661 raeburn 12768: my ($path,$fname) =
12769: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
12770: # no path, whole string is fname
12771: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
12772: $fname = &Apache::lonnet::clean_filename($fname);
12773: # See if there is anything left
12774: next if ($fname eq '');
12775:
12776: # Check if file already exists as a file or directory.
12777: my ($state,$msg);
12778: if ($context eq 'portfolio') {
12779: my $port_path = $dirpath;
12780: if ($group ne '') {
12781: $port_path = "groups/$group/$port_path";
12782: }
1.987 raeburn 12783: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
12784: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 12785: $dir_root,$port_path,$disk_quota,
12786: $current_disk_usage,$uname,$udom);
12787: if ($state eq 'will_exceed_quota'
1.984 raeburn 12788: || $state eq 'file_locked') {
1.661 raeburn 12789: $output .= $msg;
12790: next;
12791: }
12792: } elsif (($context eq 'author') || ($context eq 'testbank')) {
12793: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
12794: if ($state eq 'exists') {
12795: $output .= $msg;
12796: next;
12797: }
12798: }
12799: # Check if extension is valid
12800: if (($fname =~ /\.(\w+)$/) &&
12801: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 12802: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
12803: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 12804: next;
12805: } elsif (($fname =~ /\.(\w+)$/) &&
12806: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 12807: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 12808: next;
12809: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 12810: $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 12811: next;
12812: }
12813: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 12814: my $subdir = $path;
12815: $subdir =~ s{/+$}{};
1.661 raeburn 12816: if ($context eq 'portfolio') {
1.984 raeburn 12817: my $result;
12818: if ($state eq 'existingfile') {
12819: $result=
12820: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 12821: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 12822: } else {
1.984 raeburn 12823: $result=
12824: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 12825: $dirpath.
1.1123 raeburn 12826: $env{'form.currentpath'}.$subdir);
1.984 raeburn 12827: if ($result !~ m|^/uploaded/|) {
12828: $output .= '<span class="LC_error">'
12829: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12830: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12831: .'</span><br />';
12832: next;
12833: } else {
1.987 raeburn 12834: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12835: $path.$fname.'</span>').'<br />';
1.984 raeburn 12836: }
1.661 raeburn 12837: }
1.1123 raeburn 12838: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 12839: my $extendedsubdir = $dirpath.'/'.$subdir;
12840: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 12841: my $result =
1.1126 raeburn 12842: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 12843: if ($result !~ m|^/uploaded/|) {
12844: $output .= '<span class="LC_error">'
12845: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12846: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12847: .'</span><br />';
12848: next;
12849: } else {
12850: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12851: $path.$fname.'</span>').'<br />';
1.1125 raeburn 12852: if ($context eq 'syllabus') {
12853: &Apache::lonnet::make_public_indefinitely($result);
12854: }
1.987 raeburn 12855: }
1.661 raeburn 12856: } else {
12857: # Save the file
12858: my $target = $env{'form.embedded_item_'.$i};
12859: my $fullpath = $dir_root.$dirpath.'/'.$path;
12860: my $dest = $fullpath.$fname;
12861: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 12862: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 12863: my $count;
12864: my $filepath = $dir_root;
1.1027 raeburn 12865: foreach my $subdir (@parts) {
12866: $filepath .= "/$subdir";
12867: if (!-e $filepath) {
1.661 raeburn 12868: mkdir($filepath,0770);
12869: }
12870: }
12871: my $fh;
12872: if (!open($fh,'>'.$dest)) {
12873: &Apache::lonnet::logthis('Failed to create '.$dest);
12874: $output .= '<span class="LC_error">'.
1.1071 raeburn 12875: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
12876: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12877: '</span><br />';
12878: } else {
12879: if (!print $fh $env{'form.embedded_item_'.$i}) {
12880: &Apache::lonnet::logthis('Failed to write to '.$dest);
12881: $output .= '<span class="LC_error">'.
1.1071 raeburn 12882: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
12883: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12884: '</span><br />';
12885: } else {
1.987 raeburn 12886: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12887: $url.'</span>').'<br />';
12888: unless ($context eq 'testbank') {
12889: $footer .= &mt('View embedded file: [_1]',
12890: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
12891: }
12892: }
12893: close($fh);
12894: }
12895: }
12896: if ($env{'form.embedded_ref_'.$i}) {
12897: $pathchange{$i} = 1;
12898: }
12899: }
12900: if ($output) {
12901: $output = '<p>'.$output.'</p>';
12902: }
12903: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
12904: $returnflag = 'ok';
1.1071 raeburn 12905: my $numpathchgs = scalar(keys(%pathchange));
12906: if ($numpathchgs > 0) {
1.987 raeburn 12907: if ($context eq 'portfolio') {
12908: $output .= '<p>'.&mt('or').'</p>';
12909: } elsif ($context eq 'testbank') {
1.1071 raeburn 12910: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
12911: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 12912: $returnflag = 'modify_orightml';
12913: }
12914: }
1.1071 raeburn 12915: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 12916: }
12917:
12918: sub modify_html_form {
12919: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
12920: my $end = 0;
12921: my $modifyform;
12922: if ($context eq 'upload_embedded') {
12923: return unless (ref($pathchange) eq 'HASH');
12924: if ($env{'form.number_embedded_items'}) {
12925: $end += $env{'form.number_embedded_items'};
12926: }
12927: if ($env{'form.number_pathchange_items'}) {
12928: $end += $env{'form.number_pathchange_items'};
12929: }
12930: if ($end) {
12931: for (my $i=0; $i<$end; $i++) {
12932: if ($i < $env{'form.number_embedded_items'}) {
12933: next unless($pathchange->{$i});
12934: }
12935: $modifyform .=
12936: &start_data_table_row().
12937: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
12938: 'checked="checked" /></td>'.
12939: '<td>'.$env{'form.embedded_ref_'.$i}.
12940: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
12941: &escape($env{'form.embedded_ref_'.$i}).'" />'.
12942: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
12943: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
12944: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
12945: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
12946: '<td>'.$env{'form.embedded_orig_'.$i}.
12947: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
12948: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
12949: &end_data_table_row();
1.1071 raeburn 12950: }
1.987 raeburn 12951: }
12952: } else {
12953: $modifyform = $pathchgtable;
12954: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
12955: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
12956: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12957: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
12958: }
12959: }
12960: if ($modifyform) {
1.1071 raeburn 12961: if ($actionurl eq '/adm/dependencies') {
12962: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
12963: }
1.987 raeburn 12964: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
12965: '<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".
12966: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
12967: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
12968: '</ol></p>'."\n".'<p>'.
12969: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
12970: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
12971: &start_data_table()."\n".
12972: &start_data_table_header_row().
12973: '<th>'.&mt('Change?').'</th>'.
12974: '<th>'.&mt('Current reference').'</th>'.
12975: '<th>'.&mt('Required reference').'</th>'.
12976: &end_data_table_header_row()."\n".
12977: $modifyform.
12978: &end_data_table().'<br />'."\n".$hiddenstate.
12979: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
12980: '</form>'."\n";
12981: }
12982: return;
12983: }
12984:
12985: sub modify_html_refs {
1.1123 raeburn 12986: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 12987: my $container;
12988: if ($context eq 'portfolio') {
12989: $container = $env{'form.container'};
12990: } elsif ($context eq 'coursedoc') {
12991: $container = $env{'form.primaryurl'};
1.1071 raeburn 12992: } elsif ($context eq 'manage_dependencies') {
12993: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
12994: $container = "/$container";
1.1123 raeburn 12995: } elsif ($context eq 'syllabus') {
12996: $container = $url;
1.987 raeburn 12997: } else {
1.1027 raeburn 12998: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 12999: }
13000: my (%allfiles,%codebase,$output,$content);
13001: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 13002: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 13003: if (wantarray) {
13004: return ('',0,0);
13005: } else {
13006: return;
13007: }
13008: }
13009: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 13010: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 13011: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
13012: if (wantarray) {
13013: return ('',0,0);
13014: } else {
13015: return;
13016: }
13017: }
1.987 raeburn 13018: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 13019: if ($content eq '-1') {
13020: if (wantarray) {
13021: return ('',0,0);
13022: } else {
13023: return;
13024: }
13025: }
1.987 raeburn 13026: } else {
1.1071 raeburn 13027: unless ($container =~ /^\Q$dir_root\E/) {
13028: if (wantarray) {
13029: return ('',0,0);
13030: } else {
13031: return;
13032: }
13033: }
1.1317 raeburn 13034: if (open(my $fh,'<',$container)) {
1.987 raeburn 13035: $content = join('', <$fh>);
13036: close($fh);
13037: } else {
1.1071 raeburn 13038: if (wantarray) {
13039: return ('',0,0);
13040: } else {
13041: return;
13042: }
1.987 raeburn 13043: }
13044: }
13045: my ($count,$codebasecount) = (0,0);
13046: my $mm = new File::MMagic;
13047: my $mime_type = $mm->checktype_contents($content);
13048: if ($mime_type eq 'text/html') {
13049: my $parse_result =
13050: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
13051: \%codebase,\$content);
13052: if ($parse_result eq 'ok') {
13053: foreach my $i (@changes) {
13054: my $orig = &unescape($env{'form.embedded_orig_'.$i});
13055: my $ref = &unescape($env{'form.embedded_ref_'.$i});
13056: if ($allfiles{$ref}) {
13057: my $newname = $orig;
13058: my ($attrib_regexp,$codebase);
1.1006 raeburn 13059: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 13060: if ($attrib_regexp =~ /:/) {
13061: $attrib_regexp =~ s/\:/|/g;
13062: }
13063: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13064: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13065: $count += $numchg;
1.1123 raeburn 13066: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 13067: delete($allfiles{$ref});
1.987 raeburn 13068: }
13069: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 13070: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 13071: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
13072: $codebasecount ++;
13073: }
13074: }
13075: }
1.1123 raeburn 13076: my $skiprewrites;
1.987 raeburn 13077: if ($count || $codebasecount) {
13078: my $saveresult;
1.1071 raeburn 13079: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 13080: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 13081: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13082: if ($url eq $container) {
13083: my ($fname) = ($container =~ m{/([^/]+)$});
13084: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13085: $count,'<span class="LC_filename">'.
1.1071 raeburn 13086: $fname.'</span>').'</p>';
1.987 raeburn 13087: } else {
13088: $output = '<p class="LC_error">'.
13089: &mt('Error: update failed for: [_1].',
13090: '<span class="LC_filename">'.
13091: $container.'</span>').'</p>';
13092: }
1.1123 raeburn 13093: if ($context eq 'syllabus') {
13094: unless ($saveresult eq 'ok') {
13095: $skiprewrites = 1;
13096: }
13097: }
1.987 raeburn 13098: } else {
1.1317 raeburn 13099: if (open(my $fh,'>',$container)) {
1.987 raeburn 13100: print $fh $content;
13101: close($fh);
13102: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13103: $count,'<span class="LC_filename">'.
13104: $container.'</span>').'</p>';
1.661 raeburn 13105: } else {
1.987 raeburn 13106: $output = '<p class="LC_error">'.
13107: &mt('Error: could not update [_1].',
13108: '<span class="LC_filename">'.
13109: $container.'</span>').'</p>';
1.661 raeburn 13110: }
13111: }
13112: }
1.1123 raeburn 13113: if (($context eq 'syllabus') && (!$skiprewrites)) {
13114: my ($actionurl,$state);
13115: $actionurl = "/public/$udom/$uname/syllabus";
13116: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
13117: &ask_for_embedded_content($actionurl,$state,\%allfiles,
13118: \%codebase,
13119: {'context' => 'rewrites',
13120: 'ignore_remote_references' => 1,});
13121: if (ref($mapping) eq 'HASH') {
13122: my $rewrites = 0;
13123: foreach my $key (keys(%{$mapping})) {
13124: next if ($key =~ m{^https?://});
13125: my $ref = $mapping->{$key};
13126: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
13127: my $attrib;
13128: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
13129: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
13130: }
13131: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13132: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13133: $rewrites += $numchg;
13134: }
13135: }
13136: if ($rewrites) {
13137: my $saveresult;
13138: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13139: if ($url eq $container) {
13140: my ($fname) = ($container =~ m{/([^/]+)$});
13141: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
13142: $count,'<span class="LC_filename">'.
13143: $fname.'</span>').'</p>';
13144: } else {
13145: $output .= '<p class="LC_error">'.
13146: &mt('Error: could not update links in [_1].',
13147: '<span class="LC_filename">'.
13148: $container.'</span>').'</p>';
13149:
13150: }
13151: }
13152: }
13153: }
1.987 raeburn 13154: } else {
13155: &logthis('Failed to parse '.$container.
13156: ' to modify references: '.$parse_result);
1.661 raeburn 13157: }
13158: }
1.1071 raeburn 13159: if (wantarray) {
13160: return ($output,$count,$codebasecount);
13161: } else {
13162: return $output;
13163: }
1.661 raeburn 13164: }
13165:
13166: sub check_for_existing {
13167: my ($path,$fname,$element) = @_;
13168: my ($state,$msg);
13169: if (-d $path.'/'.$fname) {
13170: $state = 'exists';
13171: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13172: } elsif (-e $path.'/'.$fname) {
13173: $state = 'exists';
13174: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13175: }
13176: if ($state eq 'exists') {
13177: $msg = '<span class="LC_error">'.$msg.'</span><br />';
13178: }
13179: return ($state,$msg);
13180: }
13181:
13182: sub check_for_upload {
13183: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
13184: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 13185: my $filesize = length($env{'form.'.$element});
13186: if (!$filesize) {
13187: my $msg = '<span class="LC_error">'.
13188: &mt('Unable to upload [_1]. (size = [_2] bytes)',
13189: '<span class="LC_filename">'.$fname.'</span>',
13190: $filesize).'<br />'.
1.1007 raeburn 13191: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 13192: '</span>';
13193: return ('zero_bytes',$msg);
13194: }
13195: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 13196: my $getpropath = 1;
1.1021 raeburn 13197: my ($dirlistref,$listerror) =
13198: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 13199: my $found_file = 0;
13200: my $locked_file = 0;
1.991 raeburn 13201: my @lockers;
13202: my $navmap;
13203: if ($env{'request.course.id'}) {
13204: $navmap = Apache::lonnavmaps::navmap->new();
13205: }
1.1021 raeburn 13206: if (ref($dirlistref) eq 'ARRAY') {
13207: foreach my $line (@{$dirlistref}) {
13208: my ($file_name,$rest)=split(/\&/,$line,2);
13209: if ($file_name eq $fname){
13210: $file_name = $path.$file_name;
13211: if ($group ne '') {
13212: $file_name = $group.$file_name;
13213: }
13214: $found_file = 1;
13215: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
13216: foreach my $lock (@lockers) {
13217: if (ref($lock) eq 'ARRAY') {
13218: my ($symb,$crsid) = @{$lock};
13219: if ($crsid eq $env{'request.course.id'}) {
13220: if (ref($navmap)) {
13221: my $res = $navmap->getBySymb($symb);
13222: foreach my $part (@{$res->parts()}) {
13223: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
13224: unless (($slot_status == $res->RESERVED) ||
13225: ($slot_status == $res->RESERVED_LOCATION)) {
13226: $locked_file = 1;
13227: }
1.991 raeburn 13228: }
1.1021 raeburn 13229: } else {
13230: $locked_file = 1;
1.991 raeburn 13231: }
13232: } else {
13233: $locked_file = 1;
13234: }
13235: }
1.1021 raeburn 13236: }
13237: } else {
13238: my @info = split(/\&/,$rest);
13239: my $currsize = $info[6]/1000;
13240: if ($currsize < $filesize) {
13241: my $extra = $filesize - $currsize;
13242: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 13243: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 13244: &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 13245: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
13246: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
13247: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 13248: return ('will_exceed_quota',$msg);
13249: }
1.984 raeburn 13250: }
13251: }
1.661 raeburn 13252: }
13253: }
13254: }
13255: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 13256: my $msg = '<p class="LC_warning">'.
13257: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 13258: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 13259: return ('will_exceed_quota',$msg);
13260: } elsif ($found_file) {
13261: if ($locked_file) {
1.1179 bisitz 13262: my $msg = '<p class="LC_warning">';
1.661 raeburn 13263: $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 13264: $msg .= '</p>';
1.661 raeburn 13265: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
13266: return ('file_locked',$msg);
13267: } else {
1.1179 bisitz 13268: my $msg = '<p class="LC_error">';
1.984 raeburn 13269: $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 13270: $msg .= '</p>';
1.984 raeburn 13271: return ('existingfile',$msg);
1.661 raeburn 13272: }
13273: }
13274: }
13275:
1.987 raeburn 13276: sub check_for_traversal {
13277: my ($path,$url,$toplevel) = @_;
13278: my @parts=split(/\//,$path);
13279: my $cleanpath;
13280: my $fullpath = $url;
13281: for (my $i=0;$i<@parts;$i++) {
13282: next if ($parts[$i] eq '.');
13283: if ($parts[$i] eq '..') {
13284: $fullpath =~ s{([^/]+/)$}{};
13285: } else {
13286: $fullpath .= $parts[$i].'/';
13287: }
13288: }
13289: if ($fullpath =~ /^\Q$url\E(.*)$/) {
13290: $cleanpath = $1;
13291: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
13292: my $curr_toprel = $1;
13293: my @parts = split(/\//,$curr_toprel);
13294: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
13295: my @urlparts = split(/\//,$url_toprel);
13296: my $doubledots;
13297: my $startdiff = -1;
13298: for (my $i=0; $i<@urlparts; $i++) {
13299: if ($startdiff == -1) {
13300: unless ($urlparts[$i] eq $parts[$i]) {
13301: $startdiff = $i;
13302: $doubledots .= '../';
13303: }
13304: } else {
13305: $doubledots .= '../';
13306: }
13307: }
13308: if ($startdiff > -1) {
13309: $cleanpath = $doubledots;
13310: for (my $i=$startdiff; $i<@parts; $i++) {
13311: $cleanpath .= $parts[$i].'/';
13312: }
13313: }
13314: }
13315: $cleanpath =~ s{(/)$}{};
13316: return $cleanpath;
13317: }
1.31 albertel 13318:
1.1053 raeburn 13319: sub is_archive_file {
13320: my ($mimetype) = @_;
13321: if (($mimetype eq 'application/octet-stream') ||
13322: ($mimetype eq 'application/x-stuffit') ||
13323: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
13324: return 1;
13325: }
13326: return;
13327: }
13328:
13329: sub decompress_form {
1.1065 raeburn 13330: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 13331: my %lt = &Apache::lonlocal::texthash (
13332: this => 'This file is an archive file.',
1.1067 raeburn 13333: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 13334: itsc => 'Its contents are as follows:',
1.1053 raeburn 13335: youm => 'You may wish to extract its contents.',
13336: extr => 'Extract contents',
1.1067 raeburn 13337: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
13338: proa => 'Process automatically?',
1.1053 raeburn 13339: yes => 'Yes',
13340: no => 'No',
1.1067 raeburn 13341: fold => 'Title for folder containing movie',
13342: movi => 'Title for page containing embedded movie',
1.1053 raeburn 13343: );
1.1065 raeburn 13344: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 13345: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 13346: my $info = &list_archive_contents($fileloc,\@paths);
13347: if (@paths) {
13348: foreach my $path (@paths) {
13349: $path =~ s{^/}{};
1.1067 raeburn 13350: if ($path =~ m{^([^/]+)/$}) {
13351: $topdir = $1;
13352: }
1.1065 raeburn 13353: if ($path =~ m{^([^/]+)/}) {
13354: $toplevel{$1} = $path;
13355: } else {
13356: $toplevel{$path} = $path;
13357: }
13358: }
13359: }
1.1067 raeburn 13360: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 13361: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 13362: "$topdir/media/",
13363: "$topdir/media/$topdir.mp4",
13364: "$topdir/media/FirstFrame.png",
13365: "$topdir/media/player.swf",
13366: "$topdir/media/swfobject.js",
13367: "$topdir/media/expressInstall.swf");
1.1197 raeburn 13368: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 13369: "$topdir/$topdir.mp4",
13370: "$topdir/$topdir\_config.xml",
13371: "$topdir/$topdir\_controller.swf",
13372: "$topdir/$topdir\_embed.css",
13373: "$topdir/$topdir\_First_Frame.png",
13374: "$topdir/$topdir\_player.html",
13375: "$topdir/$topdir\_Thumbnails.png",
13376: "$topdir/playerProductInstall.swf",
13377: "$topdir/scripts/",
13378: "$topdir/scripts/config_xml.js",
13379: "$topdir/scripts/handlebars.js",
13380: "$topdir/scripts/jquery-1.7.1.min.js",
13381: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
13382: "$topdir/scripts/modernizr.js",
13383: "$topdir/scripts/player-min.js",
13384: "$topdir/scripts/swfobject.js",
13385: "$topdir/skins/",
13386: "$topdir/skins/configuration_express.xml",
13387: "$topdir/skins/express_show/",
13388: "$topdir/skins/express_show/player-min.css",
13389: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 13390: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
13391: "$topdir/$topdir.mp4",
13392: "$topdir/$topdir\_config.xml",
13393: "$topdir/$topdir\_controller.swf",
13394: "$topdir/$topdir\_embed.css",
13395: "$topdir/$topdir\_First_Frame.png",
13396: "$topdir/$topdir\_player.html",
13397: "$topdir/$topdir\_Thumbnails.png",
13398: "$topdir/playerProductInstall.swf",
13399: "$topdir/scripts/",
13400: "$topdir/scripts/config_xml.js",
13401: "$topdir/scripts/techsmith-smart-player.min.js",
13402: "$topdir/skins/",
13403: "$topdir/skins/configuration_express.xml",
13404: "$topdir/skins/express_show/",
13405: "$topdir/skins/express_show/spritesheet.min.css",
13406: "$topdir/skins/express_show/spritesheet.png",
13407: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 13408: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 13409: if (@diffs == 0) {
1.1164 raeburn 13410: $is_camtasia = 6;
13411: } else {
1.1197 raeburn 13412: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 13413: if (@diffs == 0) {
13414: $is_camtasia = 8;
1.1197 raeburn 13415: } else {
13416: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
13417: if (@diffs == 0) {
13418: $is_camtasia = 8;
13419: }
1.1164 raeburn 13420: }
1.1067 raeburn 13421: }
13422: }
13423: my $output;
13424: if ($is_camtasia) {
13425: $output = <<"ENDCAM";
13426: <script type="text/javascript" language="Javascript">
13427: // <![CDATA[
13428:
13429: function camtasiaToggle() {
13430: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
13431: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 13432: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 13433: document.getElementById('camtasia_titles').style.display='block';
13434: } else {
13435: document.getElementById('camtasia_titles').style.display='none';
13436: }
13437: }
13438: }
13439: return;
13440: }
13441:
13442: // ]]>
13443: </script>
13444: <p>$lt{'camt'}</p>
13445: ENDCAM
1.1065 raeburn 13446: } else {
1.1067 raeburn 13447: $output = '<p>'.$lt{'this'};
13448: if ($info eq '') {
13449: $output .= ' '.$lt{'youm'}.'</p>'."\n";
13450: } else {
13451: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
13452: '<div><pre>'.$info.'</pre></div>';
13453: }
1.1065 raeburn 13454: }
1.1067 raeburn 13455: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 13456: my $duplicates;
13457: my $num = 0;
13458: if (ref($dirlist) eq 'ARRAY') {
13459: foreach my $item (@{$dirlist}) {
13460: if (ref($item) eq 'ARRAY') {
13461: if (exists($toplevel{$item->[0]})) {
13462: $duplicates .=
13463: &start_data_table_row().
13464: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
13465: 'value="0" checked="checked" />'.&mt('No').'</label>'.
13466: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
13467: 'value="1" />'.&mt('Yes').'</label>'.
13468: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
13469: '<td>'.$item->[0].'</td>';
13470: if ($item->[2]) {
13471: $duplicates .= '<td>'.&mt('Directory').'</td>';
13472: } else {
13473: $duplicates .= '<td>'.&mt('File').'</td>';
13474: }
13475: $duplicates .= '<td>'.$item->[3].'</td>'.
13476: '<td>'.
13477: &Apache::lonlocal::locallocaltime($item->[4]).
13478: '</td>'.
13479: &end_data_table_row();
13480: $num ++;
13481: }
13482: }
13483: }
13484: }
13485: my $itemcount;
13486: if (@paths > 0) {
13487: $itemcount = scalar(@paths);
13488: } else {
13489: $itemcount = 1;
13490: }
1.1067 raeburn 13491: if ($is_camtasia) {
13492: $output .= $lt{'auto'}.'<br />'.
13493: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 13494: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 13495: $lt{'yes'}.'</label> <label>'.
13496: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
13497: $lt{'no'}.'</label></span><br />'.
13498: '<div id="camtasia_titles" style="display:block">'.
13499: &Apache::lonhtmlcommon::start_pick_box().
13500: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
13501: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
13502: &Apache::lonhtmlcommon::row_closure().
13503: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
13504: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
13505: &Apache::lonhtmlcommon::row_closure(1).
13506: &Apache::lonhtmlcommon::end_pick_box().
13507: '</div>';
13508: }
1.1065 raeburn 13509: $output .=
13510: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 13511: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
13512: "\n";
1.1065 raeburn 13513: if ($duplicates ne '') {
13514: $output .= '<p><span class="LC_warning">'.
13515: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
13516: &start_data_table().
13517: &start_data_table_header_row().
13518: '<th>'.&mt('Overwrite?').'</th>'.
13519: '<th>'.&mt('Name').'</th>'.
13520: '<th>'.&mt('Type').'</th>'.
13521: '<th>'.&mt('Size').'</th>'.
13522: '<th>'.&mt('Last modified').'</th>'.
13523: &end_data_table_header_row().
13524: $duplicates.
13525: &end_data_table().
13526: '</p>';
13527: }
1.1067 raeburn 13528: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 13529: if (ref($hiddenelements) eq 'HASH') {
13530: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
13531: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
13532: }
13533: }
13534: $output .= <<"END";
1.1067 raeburn 13535: <br />
1.1053 raeburn 13536: <input type="submit" name="decompress" value="$lt{'extr'}" />
13537: </form>
13538: $noextract
13539: END
13540: return $output;
13541: }
13542:
1.1065 raeburn 13543: sub decompression_utility {
13544: my ($program) = @_;
13545: my @utilities = ('tar','gunzip','bunzip2','unzip');
13546: my $location;
13547: if (grep(/^\Q$program\E$/,@utilities)) {
13548: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
13549: '/usr/sbin/') {
13550: if (-x $dir.$program) {
13551: $location = $dir.$program;
13552: last;
13553: }
13554: }
13555: }
13556: return $location;
13557: }
13558:
13559: sub list_archive_contents {
13560: my ($file,$pathsref) = @_;
13561: my (@cmd,$output);
13562: my $needsregexp;
13563: if ($file =~ /\.zip$/) {
13564: @cmd = (&decompression_utility('unzip'),"-l");
13565: $needsregexp = 1;
13566: } elsif (($file =~ m/\.tar\.gz$/) ||
13567: ($file =~ /\.tgz$/)) {
13568: @cmd = (&decompression_utility('tar'),"-ztf");
13569: } elsif ($file =~ /\.tar\.bz2$/) {
13570: @cmd = (&decompression_utility('tar'),"-jtf");
13571: } elsif ($file =~ m|\.tar$|) {
13572: @cmd = (&decompression_utility('tar'),"-tf");
13573: }
13574: if (@cmd) {
13575: undef($!);
13576: undef($@);
13577: if (open(my $fh,"-|", @cmd, $file)) {
13578: while (my $line = <$fh>) {
13579: $output .= $line;
13580: chomp($line);
13581: my $item;
13582: if ($needsregexp) {
13583: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
13584: } else {
13585: $item = $line;
13586: }
13587: if ($item ne '') {
13588: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
13589: push(@{$pathsref},$item);
13590: }
13591: }
13592: }
13593: close($fh);
13594: }
13595: }
13596: return $output;
13597: }
13598:
1.1053 raeburn 13599: sub decompress_uploaded_file {
13600: my ($file,$dir) = @_;
13601: &Apache::lonnet::appenv({'cgi.file' => $file});
13602: &Apache::lonnet::appenv({'cgi.dir' => $dir});
13603: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
13604: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
13605: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
13606: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
13607: my $decompressed = $env{'cgi.decompressed'};
13608: &Apache::lonnet::delenv('cgi.file');
13609: &Apache::lonnet::delenv('cgi.dir');
13610: &Apache::lonnet::delenv('cgi.decompressed');
13611: return ($decompressed,$result);
13612: }
13613:
1.1055 raeburn 13614: sub process_decompression {
13615: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1292 raeburn 13616: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
13617: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13618: &mt('Unexpected file path.').'</p>'."\n";
13619: }
13620: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
13621: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13622: &mt('Unexpected course context.').'</p>'."\n";
13623: }
1.1293 raeburn 13624: unless ($file eq &Apache::lonnet::clean_filename($file)) {
1.1292 raeburn 13625: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13626: &mt('Filename contained unexpected characters.').'</p>'."\n";
13627: }
1.1055 raeburn 13628: my ($dir,$error,$warning,$output);
1.1180 raeburn 13629: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 13630: $error = &mt('Filename not a supported archive file type.').
13631: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 13632: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
13633: } else {
13634: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13635: if ($docuhome eq 'no_host') {
13636: $error = &mt('Could not determine home server for course.');
13637: } else {
13638: my @ids=&Apache::lonnet::current_machine_ids();
13639: my $currdir = "$dir_root/$destination";
13640: if (grep(/^\Q$docuhome\E$/,@ids)) {
13641: $dir = &LONCAPA::propath($docudom,$docuname).
13642: "$dir_root/$destination";
13643: } else {
13644: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
13645: "$dir_root/$docudom/$docuname/$destination";
13646: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
13647: $error = &mt('Archive file not found.');
13648: }
13649: }
1.1065 raeburn 13650: my (@to_overwrite,@to_skip);
13651: if ($env{'form.archive_overwrite_total'} > 0) {
13652: my $total = $env{'form.archive_overwrite_total'};
13653: for (my $i=0; $i<$total; $i++) {
13654: if ($env{'form.archive_overwrite_'.$i} == 1) {
13655: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
13656: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
13657: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
13658: }
13659: }
13660: }
13661: my $numskip = scalar(@to_skip);
1.1292 raeburn 13662: my $numoverwrite = scalar(@to_overwrite);
13663: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 13664: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
13665: } elsif ($dir eq '') {
1.1055 raeburn 13666: $error = &mt('Directory containing archive file unavailable.');
13667: } elsif (!$error) {
1.1065 raeburn 13668: my ($decompressed,$display);
1.1292 raeburn 13669: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 13670: my $tempdir = time.'_'.$$.int(rand(10000));
13671: mkdir("$dir/$tempdir",0755);
1.1292 raeburn 13672: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
13673: ($decompressed,$display) =
13674: &decompress_uploaded_file($file,"$dir/$tempdir");
13675: foreach my $item (@to_skip) {
13676: if (($item ne '') && ($item !~ /\.\./)) {
13677: if (-f "$dir/$tempdir/$item") {
13678: unlink("$dir/$tempdir/$item");
13679: } elsif (-d "$dir/$tempdir/$item") {
1.1300 raeburn 13680: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
1.1292 raeburn 13681: }
13682: }
13683: }
13684: foreach my $item (@to_overwrite) {
13685: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
13686: if (($item ne '') && ($item !~ /\.\./)) {
13687: if (-f "$dir/$item") {
13688: unlink("$dir/$item");
13689: } elsif (-d "$dir/$item") {
1.1300 raeburn 13690: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
1.1292 raeburn 13691: }
13692: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
13693: }
1.1065 raeburn 13694: }
13695: }
1.1292 raeburn 13696: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
1.1300 raeburn 13697: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
1.1292 raeburn 13698: }
1.1065 raeburn 13699: }
13700: } else {
13701: ($decompressed,$display) =
13702: &decompress_uploaded_file($file,$dir);
13703: }
1.1055 raeburn 13704: if ($decompressed eq 'ok') {
1.1065 raeburn 13705: $output = '<p class="LC_info">'.
13706: &mt('Files extracted successfully from archive.').
13707: '</p>'."\n";
1.1055 raeburn 13708: my ($warning,$result,@contents);
13709: my ($newdirlistref,$newlisterror) =
13710: &Apache::lonnet::dirlist($currdir,$docudom,
13711: $docuname,1);
13712: my (%is_dir,%changes,@newitems);
13713: my $dirptr = 16384;
1.1065 raeburn 13714: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 13715: foreach my $dir_line (@{$newdirlistref}) {
13716: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1292 raeburn 13717: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 13718: push(@newitems,$item);
13719: if ($dirptr&$testdir) {
13720: $is_dir{$item} = 1;
13721: }
13722: $changes{$item} = 1;
13723: }
13724: }
13725: }
13726: if (keys(%changes) > 0) {
13727: foreach my $item (sort(@newitems)) {
13728: if ($changes{$item}) {
13729: push(@contents,$item);
13730: }
13731: }
13732: }
13733: if (@contents > 0) {
1.1067 raeburn 13734: my $wantform;
13735: unless ($env{'form.autoextract_camtasia'}) {
13736: $wantform = 1;
13737: }
1.1056 raeburn 13738: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 13739: my ($count,$datatable) = &get_extracted($docudom,$docuname,
13740: $currdir,\%is_dir,
13741: \%children,\%parent,
1.1056 raeburn 13742: \@contents,\%dirorder,
13743: \%titles,$wantform);
1.1055 raeburn 13744: if ($datatable ne '') {
13745: $output .= &archive_options_form('decompressed',$datatable,
13746: $count,$hiddenelem);
1.1065 raeburn 13747: my $startcount = 6;
1.1055 raeburn 13748: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 13749: \%titles,\%children);
1.1055 raeburn 13750: }
1.1067 raeburn 13751: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 13752: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 13753: my %displayed;
13754: my $total = 1;
13755: $env{'form.archive_directory'} = [];
13756: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
13757: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
13758: $path =~ s{/$}{};
13759: my $item;
13760: if ($path ne '') {
13761: $item = "$path/$titles{$i}";
13762: } else {
13763: $item = $titles{$i};
13764: }
13765: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
13766: if ($item eq $contents[0]) {
13767: push(@{$env{'form.archive_directory'}},$i);
13768: $env{'form.archive_'.$i} = 'display';
13769: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
13770: $displayed{'folder'} = $i;
1.1164 raeburn 13771: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
13772: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 13773: $env{'form.archive_'.$i} = 'display';
13774: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
13775: $displayed{'web'} = $i;
13776: } else {
1.1164 raeburn 13777: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
13778: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
13779: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 13780: push(@{$env{'form.archive_directory'}},$i);
13781: }
13782: $env{'form.archive_'.$i} = 'dependency';
13783: }
13784: $total ++;
13785: }
13786: for (my $i=1; $i<$total; $i++) {
13787: next if ($i == $displayed{'web'});
13788: next if ($i == $displayed{'folder'});
13789: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
13790: }
13791: $env{'form.phase'} = 'decompress_cleanup';
13792: $env{'form.archivedelete'} = 1;
13793: $env{'form.archive_count'} = $total-1;
13794: $output .=
13795: &process_extracted_files('coursedocs',$docudom,
13796: $docuname,$destination,
13797: $dir_root,$hiddenelem);
13798: }
1.1055 raeburn 13799: } else {
13800: $warning = &mt('No new items extracted from archive file.');
13801: }
13802: } else {
13803: $output = $display;
13804: $error = &mt('An error occurred during extraction from the archive file.');
13805: }
13806: }
13807: }
13808: }
13809: if ($error) {
13810: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13811: $error.'</p>'."\n";
13812: }
13813: if ($warning) {
13814: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13815: }
13816: return $output;
13817: }
13818:
13819: sub get_extracted {
1.1056 raeburn 13820: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
13821: $titles,$wantform) = @_;
1.1055 raeburn 13822: my $count = 0;
13823: my $depth = 0;
13824: my $datatable;
1.1056 raeburn 13825: my @hierarchy;
1.1055 raeburn 13826: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 13827: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
13828: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 13829: foreach my $item (@{$contents}) {
13830: $count ++;
1.1056 raeburn 13831: @{$dirorder->{$count}} = @hierarchy;
13832: $titles->{$count} = $item;
1.1055 raeburn 13833: &archive_hierarchy($depth,$count,$parent,$children);
13834: if ($wantform) {
13835: $datatable .= &archive_row($is_dir->{$item},$item,
13836: $currdir,$depth,$count);
13837: }
13838: if ($is_dir->{$item}) {
13839: $depth ++;
1.1056 raeburn 13840: push(@hierarchy,$count);
13841: $parent->{$depth} = $count;
1.1055 raeburn 13842: $datatable .=
13843: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 13844: \$depth,\$count,\@hierarchy,$dirorder,
13845: $children,$parent,$titles,$wantform);
1.1055 raeburn 13846: $depth --;
1.1056 raeburn 13847: pop(@hierarchy);
1.1055 raeburn 13848: }
13849: }
13850: return ($count,$datatable);
13851: }
13852:
13853: sub recurse_extracted_archive {
1.1056 raeburn 13854: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
13855: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 13856: my $result='';
1.1056 raeburn 13857: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
13858: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
13859: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 13860: return $result;
13861: }
13862: my $dirptr = 16384;
13863: my ($newdirlistref,$newlisterror) =
13864: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
13865: if (ref($newdirlistref) eq 'ARRAY') {
13866: foreach my $dir_line (@{$newdirlistref}) {
13867: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
13868: unless ($item =~ /^\.+$/) {
13869: $$count ++;
1.1056 raeburn 13870: @{$dirorder->{$$count}} = @{$hierarchy};
13871: $titles->{$$count} = $item;
1.1055 raeburn 13872: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 13873:
1.1055 raeburn 13874: my $is_dir;
13875: if ($dirptr&$testdir) {
13876: $is_dir = 1;
13877: }
13878: if ($wantform) {
13879: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
13880: }
13881: if ($is_dir) {
13882: $$depth ++;
1.1056 raeburn 13883: push(@{$hierarchy},$$count);
13884: $parent->{$$depth} = $$count;
1.1055 raeburn 13885: $result .=
13886: &recurse_extracted_archive("$currdir/$item",$docudom,
13887: $docuname,$depth,$count,
1.1056 raeburn 13888: $hierarchy,$dirorder,$children,
13889: $parent,$titles,$wantform);
1.1055 raeburn 13890: $$depth --;
1.1056 raeburn 13891: pop(@{$hierarchy});
1.1055 raeburn 13892: }
13893: }
13894: }
13895: }
13896: return $result;
13897: }
13898:
13899: sub archive_hierarchy {
13900: my ($depth,$count,$parent,$children) =@_;
13901: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
13902: if (exists($parent->{$depth})) {
13903: $children->{$parent->{$depth}} .= $count.':';
13904: }
13905: }
13906: return;
13907: }
13908:
13909: sub archive_row {
13910: my ($is_dir,$item,$currdir,$depth,$count) = @_;
13911: my ($name) = ($item =~ m{([^/]+)$});
13912: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 13913: 'display' => 'Add as file',
1.1055 raeburn 13914: 'dependency' => 'Include as dependency',
13915: 'discard' => 'Discard',
13916: );
13917: if ($is_dir) {
1.1059 raeburn 13918: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 13919: }
1.1056 raeburn 13920: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
13921: my $offset = 0;
1.1055 raeburn 13922: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 13923: $offset ++;
1.1065 raeburn 13924: if ($action ne 'display') {
13925: $offset ++;
13926: }
1.1055 raeburn 13927: $output .= '<td><span class="LC_nobreak">'.
13928: '<label><input type="radio" name="archive_'.$count.
13929: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
13930: my $text = $choices{$action};
13931: if ($is_dir) {
13932: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
13933: if ($action eq 'display') {
1.1059 raeburn 13934: $text = &mt('Add as folder');
1.1055 raeburn 13935: }
1.1056 raeburn 13936: } else {
13937: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
13938:
13939: }
13940: $output .= ' /> '.$choices{$action}.'</label></span>';
13941: if ($action eq 'dependency') {
13942: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
13943: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
13944: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
13945: '<option value=""></option>'."\n".
13946: '</select>'."\n".
13947: '</div>';
1.1059 raeburn 13948: } elsif ($action eq 'display') {
13949: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
13950: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
13951: '</div>';
1.1055 raeburn 13952: }
1.1056 raeburn 13953: $output .= '</td>';
1.1055 raeburn 13954: }
13955: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
13956: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
13957: for (my $i=0; $i<$depth; $i++) {
13958: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
13959: }
13960: if ($is_dir) {
13961: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
13962: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
13963: } else {
13964: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
13965: }
13966: $output .= ' '.$name.'</td>'."\n".
13967: &end_data_table_row();
13968: return $output;
13969: }
13970:
13971: sub archive_options_form {
1.1065 raeburn 13972: my ($form,$display,$count,$hiddenelem) = @_;
13973: my %lt = &Apache::lonlocal::texthash(
13974: perm => 'Permanently remove archive file?',
13975: hows => 'How should each extracted item be incorporated in the course?',
13976: cont => 'Content actions for all',
13977: addf => 'Add as folder/file',
13978: incd => 'Include as dependency for a displayed file',
13979: disc => 'Discard',
13980: no => 'No',
13981: yes => 'Yes',
13982: save => 'Save',
13983: );
13984: my $output = <<"END";
13985: <form name="$form" method="post" action="">
13986: <p><span class="LC_nobreak">$lt{'perm'}
13987: <label>
13988: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
13989: </label>
13990:
13991: <label>
13992: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
13993: </span>
13994: </p>
13995: <input type="hidden" name="phase" value="decompress_cleanup" />
13996: <br />$lt{'hows'}
13997: <div class="LC_columnSection">
13998: <fieldset>
13999: <legend>$lt{'cont'}</legend>
14000: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
14001: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
14002: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
14003: </fieldset>
14004: </div>
14005: END
14006: return $output.
1.1055 raeburn 14007: &start_data_table()."\n".
1.1065 raeburn 14008: $display."\n".
1.1055 raeburn 14009: &end_data_table()."\n".
14010: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
14011: $hiddenelem.
1.1065 raeburn 14012: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 14013: '</form>';
14014: }
14015:
14016: sub archive_javascript {
1.1056 raeburn 14017: my ($startcount,$numitems,$titles,$children) = @_;
14018: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 14019: my $maintitle = $env{'form.comment'};
1.1055 raeburn 14020: my $scripttag = <<START;
14021: <script type="text/javascript">
14022: // <![CDATA[
14023:
14024: function checkAll(form,prefix) {
14025: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
14026: for (var i=0; i < form.elements.length; i++) {
14027: var id = form.elements[i].id;
14028: if ((id != '') && (id != undefined)) {
14029: if (idstr.test(id)) {
14030: if (form.elements[i].type == 'radio') {
14031: form.elements[i].checked = true;
1.1056 raeburn 14032: var nostart = i-$startcount;
1.1059 raeburn 14033: var offset = nostart%7;
14034: var count = (nostart-offset)/7;
1.1056 raeburn 14035: dependencyCheck(form,count,offset);
1.1055 raeburn 14036: }
14037: }
14038: }
14039: }
14040: }
14041:
14042: function propagateCheck(form,count) {
14043: if (count > 0) {
1.1059 raeburn 14044: var startelement = $startcount + ((count-1) * 7);
14045: for (var j=1; j<6; j++) {
14046: if ((j != 2) && (j != 4)) {
1.1056 raeburn 14047: var item = startelement + j;
14048: if (form.elements[item].type == 'radio') {
14049: if (form.elements[item].checked) {
14050: containerCheck(form,count,j);
14051: break;
14052: }
1.1055 raeburn 14053: }
14054: }
14055: }
14056: }
14057: }
14058:
14059: numitems = $numitems
1.1056 raeburn 14060: var titles = new Array(numitems);
14061: var parents = new Array(numitems);
1.1055 raeburn 14062: for (var i=0; i<numitems; i++) {
1.1056 raeburn 14063: parents[i] = new Array;
1.1055 raeburn 14064: }
1.1059 raeburn 14065: var maintitle = '$maintitle';
1.1055 raeburn 14066:
14067: START
14068:
1.1056 raeburn 14069: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
14070: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 14071: for (my $i=0; $i<@contents; $i ++) {
14072: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
14073: }
14074: }
14075:
1.1056 raeburn 14076: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
14077: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
14078: }
14079:
1.1055 raeburn 14080: $scripttag .= <<END;
14081:
14082: function containerCheck(form,count,offset) {
14083: if (count > 0) {
1.1056 raeburn 14084: dependencyCheck(form,count,offset);
1.1059 raeburn 14085: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 14086: form.elements[item].checked = true;
14087: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
14088: if (parents[count].length > 0) {
14089: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 14090: containerCheck(form,parents[count][j],offset);
14091: }
14092: }
14093: }
14094: }
14095: }
14096:
14097: function dependencyCheck(form,count,offset) {
14098: if (count > 0) {
1.1059 raeburn 14099: var chosen = (offset+$startcount)+7*(count-1);
14100: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 14101: var currtype = form.elements[depitem].type;
14102: if (form.elements[chosen].value == 'dependency') {
14103: document.getElementById('arc_depon_'+count).style.display='block';
14104: form.elements[depitem].options.length = 0;
14105: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 14106: for (var i=1; i<=numitems; i++) {
14107: if (i == count) {
14108: continue;
14109: }
1.1059 raeburn 14110: var startelement = $startcount + (i-1) * 7;
14111: for (var j=1; j<6; j++) {
14112: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 14113: var item = startelement + j;
14114: if (form.elements[item].type == 'radio') {
14115: if (form.elements[item].checked) {
14116: if (form.elements[item].value == 'display') {
14117: var n = form.elements[depitem].options.length;
14118: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
14119: }
14120: }
14121: }
14122: }
14123: }
14124: }
14125: } else {
14126: document.getElementById('arc_depon_'+count).style.display='none';
14127: form.elements[depitem].options.length = 0;
14128: form.elements[depitem].options[0] = new Option('Select','',true,true);
14129: }
1.1059 raeburn 14130: titleCheck(form,count,offset);
1.1056 raeburn 14131: }
14132: }
14133:
14134: function propagateSelect(form,count,offset) {
14135: if (count > 0) {
1.1065 raeburn 14136: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 14137: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
14138: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14139: if (parents[count].length > 0) {
14140: for (var j=0; j<parents[count].length; j++) {
14141: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 14142: }
14143: }
14144: }
14145: }
14146: }
1.1056 raeburn 14147:
14148: function containerSelect(form,count,offset,picked) {
14149: if (count > 0) {
1.1065 raeburn 14150: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 14151: if (form.elements[item].type == 'radio') {
14152: if (form.elements[item].value == 'dependency') {
14153: if (form.elements[item+1].type == 'select-one') {
14154: for (var i=0; i<form.elements[item+1].options.length; i++) {
14155: if (form.elements[item+1].options[i].value == picked) {
14156: form.elements[item+1].selectedIndex = i;
14157: break;
14158: }
14159: }
14160: }
14161: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14162: if (parents[count].length > 0) {
14163: for (var j=0; j<parents[count].length; j++) {
14164: containerSelect(form,parents[count][j],offset,picked);
14165: }
14166: }
14167: }
14168: }
14169: }
14170: }
14171: }
14172:
1.1059 raeburn 14173: function titleCheck(form,count,offset) {
14174: if (count > 0) {
14175: var chosen = (offset+$startcount)+7*(count-1);
14176: var depitem = $startcount + ((count-1) * 7) + 2;
14177: var currtype = form.elements[depitem].type;
14178: if (form.elements[chosen].value == 'display') {
14179: document.getElementById('arc_title_'+count).style.display='block';
14180: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
14181: document.getElementById('archive_title_'+count).value=maintitle;
14182: }
14183: } else {
14184: document.getElementById('arc_title_'+count).style.display='none';
14185: if (currtype == 'text') {
14186: document.getElementById('archive_title_'+count).value='';
14187: }
14188: }
14189: }
14190: return;
14191: }
14192:
1.1055 raeburn 14193: // ]]>
14194: </script>
14195: END
14196: return $scripttag;
14197: }
14198:
14199: sub process_extracted_files {
1.1067 raeburn 14200: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 14201: my $numitems = $env{'form.archive_count'};
1.1294 raeburn 14202: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 14203: my @ids=&Apache::lonnet::current_machine_ids();
14204: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 14205: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 14206: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14207: if (grep(/^\Q$docuhome\E$/,@ids)) {
14208: $prefix = &LONCAPA::propath($docudom,$docuname);
14209: $pathtocheck = "$dir_root/$destination";
14210: $dir = $dir_root;
14211: $ishome = 1;
14212: } else {
14213: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
14214: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1294 raeburn 14215: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 14216: }
14217: my $currdir = "$dir_root/$destination";
14218: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
14219: if ($env{'form.folderpath'}) {
14220: my @items = split('&',$env{'form.folderpath'});
14221: $folders{'0'} = $items[-2];
1.1099 raeburn 14222: if ($env{'form.folderpath'} =~ /\:1$/) {
14223: $containers{'0'}='page';
14224: } else {
14225: $containers{'0'}='sequence';
14226: }
1.1055 raeburn 14227: }
14228: my @archdirs = &get_env_multiple('form.archive_directory');
14229: if ($numitems) {
14230: for (my $i=1; $i<=$numitems; $i++) {
14231: my $path = $env{'form.archive_content_'.$i};
14232: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
14233: my $item = $1;
14234: $toplevelitems{$item} = $i;
14235: if (grep(/^\Q$i\E$/,@archdirs)) {
14236: $is_dir{$item} = 1;
14237: }
14238: }
14239: }
14240: }
1.1067 raeburn 14241: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 14242: if (keys(%toplevelitems) > 0) {
14243: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 14244: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
14245: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 14246: }
1.1066 raeburn 14247: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 14248: if ($numitems) {
14249: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 14250: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 14251: my $path = $env{'form.archive_content_'.$i};
14252: if ($path =~ /^\Q$pathtocheck\E/) {
14253: if ($env{'form.archive_'.$i} eq 'discard') {
14254: if ($prefix ne '' && $path ne '') {
14255: if (-e $prefix.$path) {
1.1066 raeburn 14256: if ((@archdirs > 0) &&
14257: (grep(/^\Q$i\E$/,@archdirs))) {
14258: $todeletedir{$prefix.$path} = 1;
14259: } else {
14260: $todelete{$prefix.$path} = 1;
14261: }
1.1055 raeburn 14262: }
14263: }
14264: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 14265: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 14266: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 14267: $docstitle = $env{'form.archive_title_'.$i};
14268: if ($docstitle eq '') {
14269: $docstitle = $title;
14270: }
1.1055 raeburn 14271: $outer = 0;
1.1056 raeburn 14272: if (ref($dirorder{$i}) eq 'ARRAY') {
14273: if (@{$dirorder{$i}} > 0) {
14274: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 14275: if ($env{'form.archive_'.$item} eq 'display') {
14276: $outer = $item;
14277: last;
14278: }
14279: }
14280: }
14281: }
14282: my ($errtext,$fatal) =
14283: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
14284: '/'.$folders{$outer}.'.'.
14285: $containers{$outer});
14286: next if ($fatal);
14287: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
14288: if ($context eq 'coursedocs') {
1.1056 raeburn 14289: $mapinner{$i} = time;
1.1055 raeburn 14290: $folders{$i} = 'default_'.$mapinner{$i};
14291: $containers{$i} = 'sequence';
14292: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14293: $folders{$i}.'.'.$containers{$i};
14294: my $newidx = &LONCAPA::map::getresidx();
14295: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 14296: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 14297: push(@LONCAPA::map::order,$newidx);
14298: my ($outtext,$errtext) =
14299: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14300: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 14301: '.'.$containers{$outer},1,1);
1.1056 raeburn 14302: $newseqid{$i} = $newidx;
1.1067 raeburn 14303: unless ($errtext) {
1.1294 raeburn 14304: $result .= '<li>'.&mt('Folder: [_1] added to course',
14305: &HTML::Entities::encode($docstitle,'<>&"')).
14306: '</li>'."\n";
1.1067 raeburn 14307: }
1.1055 raeburn 14308: }
14309: } else {
14310: if ($context eq 'coursedocs') {
14311: my $newidx=&LONCAPA::map::getresidx();
14312: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14313: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
14314: $title;
1.1392 raeburn 14315: if (($outer !~ /\D/) &&
14316: (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
14317: ($newidx !~ /\D/)) {
1.1294 raeburn 14318: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
14319: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
14320: }
14321: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14322: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
14323: }
14324: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14325: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
14326: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
14327: unless ($ishome) {
14328: my $fetch = "$newdest{$i}/$title";
14329: $fetch =~ s/^\Q$prefix$dir\E//;
14330: $prompttofetch{$fetch} = 1;
14331: }
1.1292 raeburn 14332: }
1.1067 raeburn 14333: }
1.1294 raeburn 14334: $LONCAPA::map::resources[$newidx]=
14335: $docstitle.':'.$url.':false:normal:res';
14336: push(@LONCAPA::map::order, $newidx);
14337: my ($outtext,$errtext)=
14338: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14339: $docuname.'/'.$folders{$outer}.
14340: '.'.$containers{$outer},1,1);
14341: unless ($errtext) {
14342: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
14343: $result .= '<li>'.&mt('File: [_1] added to course',
14344: &HTML::Entities::encode($docstitle,'<>&"')).
14345: '</li>'."\n";
14346: }
1.1067 raeburn 14347: }
1.1294 raeburn 14348: } else {
14349: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14350: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1296 raeburn 14351: }
1.1055 raeburn 14352: }
14353: }
1.1086 raeburn 14354: }
14355: } else {
1.1294 raeburn 14356: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14357: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1086 raeburn 14358: }
14359: }
14360: for (my $i=1; $i<=$numitems; $i++) {
14361: next unless ($env{'form.archive_'.$i} eq 'dependency');
14362: my $path = $env{'form.archive_content_'.$i};
14363: if ($path =~ /^\Q$pathtocheck\E/) {
14364: my ($title) = ($path =~ m{/([^/]+)$});
14365: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
14366: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
14367: if (ref($dirorder{$i}) eq 'ARRAY') {
14368: my ($itemidx,$fullpath,$relpath);
14369: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
14370: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 14371: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 14372: if ($dirorder{$i}->[$j] eq $container) {
14373: $itemidx = $j;
1.1056 raeburn 14374: }
14375: }
1.1086 raeburn 14376: }
14377: if ($itemidx eq '') {
14378: $itemidx = 0;
14379: }
14380: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
14381: if ($mapinner{$referrer{$i}}) {
14382: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
14383: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14384: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14385: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14386: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14387: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14388: if (!-e $fullpath) {
14389: mkdir($fullpath,0755);
1.1056 raeburn 14390: }
14391: }
1.1086 raeburn 14392: } else {
14393: last;
1.1056 raeburn 14394: }
1.1086 raeburn 14395: }
14396: }
14397: } elsif ($newdest{$referrer{$i}}) {
14398: $fullpath = $newdest{$referrer{$i}};
14399: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14400: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
14401: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
14402: last;
14403: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14404: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14405: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14406: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14407: if (!-e $fullpath) {
14408: mkdir($fullpath,0755);
1.1056 raeburn 14409: }
14410: }
1.1086 raeburn 14411: } else {
14412: last;
1.1056 raeburn 14413: }
1.1055 raeburn 14414: }
14415: }
1.1086 raeburn 14416: if ($fullpath ne '') {
14417: if (-e "$prefix$path") {
1.1292 raeburn 14418: unless (rename("$prefix$path","$fullpath/$title")) {
14419: $warning .= &mt('Failed to rename dependency').'<br />';
14420: }
1.1086 raeburn 14421: }
14422: if (-e "$fullpath/$title") {
14423: my $showpath;
14424: if ($relpath ne '') {
14425: $showpath = "$relpath/$title";
14426: } else {
14427: $showpath = "/$title";
14428: }
1.1294 raeburn 14429: $result .= '<li>'.&mt('[_1] included as a dependency',
14430: &HTML::Entities::encode($showpath,'<>&"')).
14431: '</li>'."\n";
1.1292 raeburn 14432: unless ($ishome) {
14433: my $fetch = "$fullpath/$title";
14434: $fetch =~ s/^\Q$prefix$dir\E//;
14435: $prompttofetch{$fetch} = 1;
14436: }
1.1086 raeburn 14437: }
14438: }
1.1055 raeburn 14439: }
1.1086 raeburn 14440: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
14441: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1294 raeburn 14442: &HTML::Entities::encode($path,'<>&"'),
14443: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
14444: '<br />';
1.1055 raeburn 14445: }
14446: } else {
1.1294 raeburn 14447: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
1.1296 raeburn 14448: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 14449: }
14450: }
14451: if (keys(%todelete)) {
14452: foreach my $key (keys(%todelete)) {
14453: unlink($key);
1.1066 raeburn 14454: }
14455: }
14456: if (keys(%todeletedir)) {
14457: foreach my $key (keys(%todeletedir)) {
14458: rmdir($key);
14459: }
14460: }
14461: foreach my $dir (sort(keys(%is_dir))) {
14462: if (($pathtocheck ne '') && ($dir ne '')) {
14463: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 14464: }
14465: }
1.1067 raeburn 14466: if ($result ne '') {
14467: $output .= '<ul>'."\n".
14468: $result."\n".
14469: '</ul>';
14470: }
14471: unless ($ishome) {
14472: my $replicationfail;
14473: foreach my $item (keys(%prompttofetch)) {
14474: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
14475: unless ($fetchresult eq 'ok') {
14476: $replicationfail .= '<li>'.$item.'</li>'."\n";
14477: }
14478: }
14479: if ($replicationfail) {
14480: $output .= '<p class="LC_error">'.
14481: &mt('Course home server failed to retrieve:').'<ul>'.
14482: $replicationfail.
14483: '</ul></p>';
14484: }
14485: }
1.1055 raeburn 14486: } else {
14487: $warning = &mt('No items found in archive.');
14488: }
14489: if ($error) {
14490: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14491: $error.'</p>'."\n";
14492: }
14493: if ($warning) {
14494: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14495: }
14496: return $output;
14497: }
14498:
1.1066 raeburn 14499: sub cleanup_empty_dirs {
14500: my ($path) = @_;
14501: if (($path ne '') && (-d $path)) {
14502: if (opendir(my $dirh,$path)) {
14503: my @dircontents = grep(!/^\./,readdir($dirh));
14504: my $numitems = 0;
14505: foreach my $item (@dircontents) {
14506: if (-d "$path/$item") {
1.1111 raeburn 14507: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 14508: if (-e "$path/$item") {
14509: $numitems ++;
14510: }
14511: } else {
14512: $numitems ++;
14513: }
14514: }
14515: if ($numitems == 0) {
14516: rmdir($path);
14517: }
14518: closedir($dirh);
14519: }
14520: }
14521: return;
14522: }
14523:
1.41 ng 14524: =pod
1.45 matthew 14525:
1.1162 raeburn 14526: =item * &get_folder_hierarchy()
1.1068 raeburn 14527:
14528: Provides hierarchy of names of folders/sub-folders containing the current
14529: item,
14530:
14531: Inputs: 3
14532: - $navmap - navmaps object
14533:
14534: - $map - url for map (either the trigger itself, or map containing
14535: the resource, which is the trigger).
14536:
14537: - $showitem - 1 => show title for map itself; 0 => do not show.
14538:
14539: Outputs: 1 @pathitems - array of folder/subfolder names.
14540:
14541: =cut
14542:
14543: sub get_folder_hierarchy {
14544: my ($navmap,$map,$showitem) = @_;
14545: my @pathitems;
14546: if (ref($navmap)) {
14547: my $mapres = $navmap->getResourceByUrl($map);
14548: if (ref($mapres)) {
14549: my $pcslist = $mapres->map_hierarchy();
14550: if ($pcslist ne '') {
14551: my @pcs = split(/,/,$pcslist);
14552: foreach my $pc (@pcs) {
14553: if ($pc == 1) {
1.1129 raeburn 14554: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 14555: } else {
14556: my $res = $navmap->getByMapPc($pc);
14557: if (ref($res)) {
14558: my $title = $res->compTitle();
14559: $title =~ s/\W+/_/g;
14560: if ($title ne '') {
14561: push(@pathitems,$title);
14562: }
14563: }
14564: }
14565: }
14566: }
1.1071 raeburn 14567: if ($showitem) {
14568: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 14569: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 14570: } else {
14571: my $maptitle = $mapres->compTitle();
14572: $maptitle =~ s/\W+/_/g;
14573: if ($maptitle ne '') {
14574: push(@pathitems,$maptitle);
14575: }
1.1068 raeburn 14576: }
14577: }
14578: }
14579: }
14580: return @pathitems;
14581: }
14582:
14583: =pod
14584:
1.1015 raeburn 14585: =item * &get_turnedin_filepath()
14586:
14587: Determines path in a user's portfolio file for storage of files uploaded
14588: to a specific essayresponse or dropbox item.
14589:
14590: Inputs: 3 required + 1 optional.
14591: $symb is symb for resource, $uname and $udom are for current user (required).
14592: $caller is optional (can be "submission", if routine is called when storing
14593: an upoaded file when "Submit Answer" button was pressed).
14594:
14595: Returns array containing $path and $multiresp.
14596: $path is path in portfolio. $multiresp is 1 if this resource contains more
14597: than one file upload item. Callers of routine should append partid as a
14598: subdirectory to $path in cases where $multiresp is 1.
14599:
14600: Called by: homework/essayresponse.pm and homework/structuretags.pm
14601:
14602: =cut
14603:
14604: sub get_turnedin_filepath {
14605: my ($symb,$uname,$udom,$caller) = @_;
14606: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
14607: my $turnindir;
14608: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
14609: $turnindir = $userhash{'turnindir'};
14610: my ($path,$multiresp);
14611: if ($turnindir eq '') {
14612: if ($caller eq 'submission') {
14613: $turnindir = &mt('turned in');
14614: $turnindir =~ s/\W+/_/g;
14615: my %newhash = (
14616: 'turnindir' => $turnindir,
14617: );
14618: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
14619: }
14620: }
14621: if ($turnindir ne '') {
14622: $path = '/'.$turnindir.'/';
14623: my ($multipart,$turnin,@pathitems);
14624: my $navmap = Apache::lonnavmaps::navmap->new();
14625: if (defined($navmap)) {
14626: my $mapres = $navmap->getResourceByUrl($map);
14627: if (ref($mapres)) {
14628: my $pcslist = $mapres->map_hierarchy();
14629: if ($pcslist ne '') {
14630: foreach my $pc (split(/,/,$pcslist)) {
14631: my $res = $navmap->getByMapPc($pc);
14632: if (ref($res)) {
14633: my $title = $res->compTitle();
14634: $title =~ s/\W+/_/g;
14635: if ($title ne '') {
1.1149 raeburn 14636: if (($pc > 1) && (length($title) > 12)) {
14637: $title = substr($title,0,12);
14638: }
1.1015 raeburn 14639: push(@pathitems,$title);
14640: }
14641: }
14642: }
14643: }
14644: my $maptitle = $mapres->compTitle();
14645: $maptitle =~ s/\W+/_/g;
14646: if ($maptitle ne '') {
1.1149 raeburn 14647: if (length($maptitle) > 12) {
14648: $maptitle = substr($maptitle,0,12);
14649: }
1.1015 raeburn 14650: push(@pathitems,$maptitle);
14651: }
14652: unless ($env{'request.state'} eq 'construct') {
14653: my $res = $navmap->getBySymb($symb);
14654: if (ref($res)) {
14655: my $partlist = $res->parts();
14656: my $totaluploads = 0;
14657: if (ref($partlist) eq 'ARRAY') {
14658: foreach my $part (@{$partlist}) {
14659: my @types = $res->responseType($part);
14660: my @ids = $res->responseIds($part);
14661: for (my $i=0; $i < scalar(@ids); $i++) {
14662: if ($types[$i] eq 'essay') {
14663: my $partid = $part.'_'.$ids[$i];
14664: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
14665: $totaluploads ++;
14666: }
14667: }
14668: }
14669: }
14670: if ($totaluploads > 1) {
14671: $multiresp = 1;
14672: }
14673: }
14674: }
14675: }
14676: } else {
14677: return;
14678: }
14679: } else {
14680: return;
14681: }
14682: my $restitle=&Apache::lonnet::gettitle($symb);
14683: $restitle =~ s/\W+/_/g;
14684: if ($restitle eq '') {
14685: $restitle = ($resurl =~ m{/[^/]+$});
14686: if ($restitle eq '') {
14687: $restitle = time;
14688: }
14689: }
1.1149 raeburn 14690: if (length($restitle) > 12) {
14691: $restitle = substr($restitle,0,12);
14692: }
1.1015 raeburn 14693: push(@pathitems,$restitle);
14694: $path .= join('/',@pathitems);
14695: }
14696: return ($path,$multiresp);
14697: }
14698:
14699: =pod
14700:
1.464 albertel 14701: =back
1.41 ng 14702:
1.112 bowersj2 14703: =head1 CSV Upload/Handling functions
1.38 albertel 14704:
1.41 ng 14705: =over 4
14706:
1.648 raeburn 14707: =item * &upfile_store($r)
1.41 ng 14708:
14709: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 14710: needs $env{'form.upfile'}
1.41 ng 14711: returns $datatoken to be put into hidden field
14712:
14713: =cut
1.31 albertel 14714:
14715: sub upfile_store {
14716: my $r=shift;
1.258 albertel 14717: $env{'form.upfile'}=~s/\r/\n/gs;
14718: $env{'form.upfile'}=~s/\f/\n/gs;
14719: $env{'form.upfile'}=~s/\n+/\n/gs;
14720: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 14721:
1.1299 raeburn 14722: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
14723: '_enroll_'.$env{'request.course.id'}.'_'.
14724: time.'_'.$$);
14725: return if ($datatoken eq '');
14726:
1.31 albertel 14727: {
1.158 raeburn 14728: my $datafile = $r->dir_config('lonDaemons').
14729: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 14730: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 14731: print $fh $env{'form.upfile'};
1.158 raeburn 14732: close($fh);
14733: }
1.31 albertel 14734: }
14735: return $datatoken;
14736: }
14737:
1.56 matthew 14738: =pod
14739:
1.1290 raeburn 14740: =item * &load_tmp_file($r,$datatoken)
1.41 ng 14741:
14742: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1290 raeburn 14743: $datatoken is the name to assign to the temporary file.
1.258 albertel 14744: sets $env{'form.upfile'} to the contents of the file
1.41 ng 14745:
14746: =cut
1.31 albertel 14747:
14748: sub load_tmp_file {
1.1290 raeburn 14749: my ($r,$datatoken) = @_;
14750: return if ($datatoken eq '');
1.31 albertel 14751: my @studentdata=();
14752: {
1.158 raeburn 14753: my $studentfile = $r->dir_config('lonDaemons').
1.1290 raeburn 14754: '/tmp/'.$datatoken.'.tmp';
1.1317 raeburn 14755: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 14756: @studentdata=<$fh>;
14757: close($fh);
14758: }
1.31 albertel 14759: }
1.258 albertel 14760: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 14761: }
14762:
1.1290 raeburn 14763: sub valid_datatoken {
14764: my ($datatoken) = @_;
1.1325 raeburn 14765: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1290 raeburn 14766: return $datatoken;
14767: }
14768: return;
14769: }
14770:
1.56 matthew 14771: =pod
14772:
1.648 raeburn 14773: =item * &upfile_record_sep()
1.41 ng 14774:
14775: Separate uploaded file into records
14776: returns array of records,
1.258 albertel 14777: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 14778:
14779: =cut
1.31 albertel 14780:
14781: sub upfile_record_sep {
1.258 albertel 14782: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 14783: } else {
1.248 albertel 14784: my @records;
1.258 albertel 14785: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 14786: if ($line=~/^\s*$/) { next; }
14787: push(@records,$line);
14788: }
14789: return @records;
1.31 albertel 14790: }
14791: }
14792:
1.56 matthew 14793: =pod
14794:
1.648 raeburn 14795: =item * &record_sep($record)
1.41 ng 14796:
1.258 albertel 14797: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 14798:
14799: =cut
14800:
1.263 www 14801: sub takeleft {
14802: my $index=shift;
14803: return substr('0000'.$index,-4,4);
14804: }
14805:
1.31 albertel 14806: sub record_sep {
14807: my $record=shift;
14808: my %components=();
1.258 albertel 14809: if ($env{'form.upfiletype'} eq 'xml') {
14810: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 14811: my $i=0;
1.356 albertel 14812: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 14813: $field=~s/^(\"|\')//;
14814: $field=~s/(\"|\')$//;
1.263 www 14815: $components{&takeleft($i)}=$field;
1.31 albertel 14816: $i++;
14817: }
1.258 albertel 14818: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 14819: my $i=0;
1.356 albertel 14820: foreach my $field (split(/\t/,$record)) {
1.31 albertel 14821: $field=~s/^(\"|\')//;
14822: $field=~s/(\"|\')$//;
1.263 www 14823: $components{&takeleft($i)}=$field;
1.31 albertel 14824: $i++;
14825: }
14826: } else {
1.561 www 14827: my $separator=',';
1.480 banghart 14828: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 14829: $separator=';';
1.480 banghart 14830: }
1.31 albertel 14831: my $i=0;
1.561 www 14832: # the character we are looking for to indicate the end of a quote or a record
14833: my $looking_for=$separator;
14834: # do not add the characters to the fields
14835: my $ignore=0;
14836: # we just encountered a separator (or the beginning of the record)
14837: my $just_found_separator=1;
14838: # store the field we are working on here
14839: my $field='';
14840: # work our way through all characters in record
14841: foreach my $character ($record=~/(.)/g) {
14842: if ($character eq $looking_for) {
14843: if ($character ne $separator) {
14844: # Found the end of a quote, again looking for separator
14845: $looking_for=$separator;
14846: $ignore=1;
14847: } else {
14848: # Found a separator, store away what we got
14849: $components{&takeleft($i)}=$field;
14850: $i++;
14851: $just_found_separator=1;
14852: $ignore=0;
14853: $field='';
14854: }
14855: next;
14856: }
14857: # single or double quotation marks after a separator indicate beginning of a quote
14858: # we are now looking for the end of the quote and need to ignore separators
14859: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
14860: $looking_for=$character;
14861: next;
14862: }
14863: # ignore would be true after we reached the end of a quote
14864: if ($ignore) { next; }
14865: if (($just_found_separator) && ($character=~/\s/)) { next; }
14866: $field.=$character;
14867: $just_found_separator=0;
1.31 albertel 14868: }
1.561 www 14869: # catch the very last entry, since we never encountered the separator
14870: $components{&takeleft($i)}=$field;
1.31 albertel 14871: }
14872: return %components;
14873: }
14874:
1.144 matthew 14875: ######################################################
14876: ######################################################
14877:
1.56 matthew 14878: =pod
14879:
1.648 raeburn 14880: =item * &upfile_select_html()
1.41 ng 14881:
1.144 matthew 14882: Return HTML code to select a file from the users machine and specify
14883: the file type.
1.41 ng 14884:
14885: =cut
14886:
1.144 matthew 14887: ######################################################
14888: ######################################################
1.31 albertel 14889: sub upfile_select_html {
1.144 matthew 14890: my %Types = (
14891: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 14892: semisv => &mt('Semicolon separated values'),
1.144 matthew 14893: space => &mt('Space separated'),
14894: tab => &mt('Tabulator separated'),
14895: # xml => &mt('HTML/XML'),
14896: );
14897: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 14898: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 14899: foreach my $type (sort(keys(%Types))) {
14900: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
14901: }
14902: $Str .= "</select>\n";
14903: return $Str;
1.31 albertel 14904: }
14905:
1.301 albertel 14906: sub get_samples {
14907: my ($records,$toget) = @_;
14908: my @samples=({});
14909: my $got=0;
14910: foreach my $rec (@$records) {
14911: my %temp = &record_sep($rec);
14912: if (! grep(/\S/, values(%temp))) { next; }
14913: if (%temp) {
14914: $samples[$got]=\%temp;
14915: $got++;
14916: if ($got == $toget) { last; }
14917: }
14918: }
14919: return \@samples;
14920: }
14921:
1.144 matthew 14922: ######################################################
14923: ######################################################
14924:
1.56 matthew 14925: =pod
14926:
1.648 raeburn 14927: =item * &csv_print_samples($r,$records)
1.41 ng 14928:
14929: Prints a table of sample values from each column uploaded $r is an
14930: Apache Request ref, $records is an arrayref from
14931: &Apache::loncommon::upfile_record_sep
14932:
14933: =cut
14934:
1.144 matthew 14935: ######################################################
14936: ######################################################
1.31 albertel 14937: sub csv_print_samples {
14938: my ($r,$records) = @_;
1.662 bisitz 14939: my $samples = &get_samples($records,5);
1.301 albertel 14940:
1.594 raeburn 14941: $r->print(&mt('Samples').'<br />'.&start_data_table().
14942: &start_data_table_header_row());
1.356 albertel 14943: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 14944: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 14945: $r->print(&end_data_table_header_row());
1.301 albertel 14946: foreach my $hash (@$samples) {
1.594 raeburn 14947: $r->print(&start_data_table_row());
1.356 albertel 14948: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 14949: $r->print('<td>');
1.356 albertel 14950: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 14951: $r->print('</td>');
14952: }
1.594 raeburn 14953: $r->print(&end_data_table_row());
1.31 albertel 14954: }
1.594 raeburn 14955: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 14956: }
14957:
1.144 matthew 14958: ######################################################
14959: ######################################################
14960:
1.56 matthew 14961: =pod
14962:
1.648 raeburn 14963: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 14964:
14965: Prints a table to create associations between values and table columns.
1.144 matthew 14966:
1.41 ng 14967: $r is an Apache Request ref,
14968: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 14969: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 14970:
14971: =cut
14972:
1.144 matthew 14973: ######################################################
14974: ######################################################
1.31 albertel 14975: sub csv_print_select_table {
14976: my ($r,$records,$d) = @_;
1.301 albertel 14977: my $i=0;
14978: my $samples = &get_samples($records,1);
1.144 matthew 14979: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 14980: &start_data_table().&start_data_table_header_row().
1.144 matthew 14981: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 14982: '<th>'.&mt('Column').'</th>'.
14983: &end_data_table_header_row()."\n");
1.356 albertel 14984: foreach my $array_ref (@$d) {
14985: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 14986: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 14987:
1.875 bisitz 14988: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 14989: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 14990: $r->print('<option value="none"></option>');
1.356 albertel 14991: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
14992: $r->print('<option value="'.$sample.'"'.
14993: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 14994: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 14995: }
1.594 raeburn 14996: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 14997: $i++;
14998: }
1.594 raeburn 14999: $r->print(&end_data_table());
1.31 albertel 15000: $i--;
15001: return $i;
15002: }
1.56 matthew 15003:
1.144 matthew 15004: ######################################################
15005: ######################################################
15006:
1.56 matthew 15007: =pod
1.31 albertel 15008:
1.648 raeburn 15009: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 15010:
15011: Prints a table of sample values from the upload and can make associate samples to internal names.
15012:
15013: $r is an Apache Request ref,
15014: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
15015: $d is an array of 2 element arrays (internal name, displayed name)
15016:
15017: =cut
15018:
1.144 matthew 15019: ######################################################
15020: ######################################################
1.31 albertel 15021: sub csv_samples_select_table {
15022: my ($r,$records,$d) = @_;
15023: my $i=0;
1.144 matthew 15024: #
1.662 bisitz 15025: my $max_samples = 5;
15026: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 15027: $r->print(&start_data_table().
15028: &start_data_table_header_row().'<th>'.
15029: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
15030: &end_data_table_header_row());
1.301 albertel 15031:
15032: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 15033: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 15034: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 15035: foreach my $option (@$d) {
15036: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 15037: $r->print('<option value="'.$value.'"'.
1.253 albertel 15038: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 15039: $display.'</option>');
1.31 albertel 15040: }
15041: $r->print('</select></td><td>');
1.662 bisitz 15042: foreach my $line (0..($max_samples-1)) {
1.301 albertel 15043: if (defined($samples->[$line]{$key})) {
15044: $r->print($samples->[$line]{$key}."<br />\n");
15045: }
15046: }
1.594 raeburn 15047: $r->print('</td>'.&end_data_table_row());
1.31 albertel 15048: $i++;
15049: }
1.594 raeburn 15050: $r->print(&end_data_table());
1.31 albertel 15051: $i--;
15052: return($i);
1.115 matthew 15053: }
15054:
1.144 matthew 15055: ######################################################
15056: ######################################################
15057:
1.115 matthew 15058: =pod
15059:
1.648 raeburn 15060: =item * &clean_excel_name($name)
1.115 matthew 15061:
15062: Returns a replacement for $name which does not contain any illegal characters.
15063:
15064: =cut
15065:
1.144 matthew 15066: ######################################################
15067: ######################################################
1.115 matthew 15068: sub clean_excel_name {
15069: my ($name) = @_;
15070: $name =~ s/[:\*\?\/\\]//g;
15071: if (length($name) > 31) {
15072: $name = substr($name,0,31);
15073: }
15074: return $name;
1.25 albertel 15075: }
1.84 albertel 15076:
1.85 albertel 15077: =pod
15078:
1.648 raeburn 15079: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 15080:
15081: Returns either 1 or undef
15082:
15083: 1 if the part is to be hidden, undef if it is to be shown
15084:
15085: Arguments are:
15086:
15087: $id the id of the part to be checked
15088: $symb, optional the symb of the resource to check
15089: $udom, optional the domain of the user to check for
15090: $uname, optional the username of the user to check for
15091:
15092: =cut
1.84 albertel 15093:
15094: sub check_if_partid_hidden {
15095: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 15096: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 15097: $symb,$udom,$uname);
1.141 albertel 15098: my $truth=1;
15099: #if the string starts with !, then the list is the list to show not hide
15100: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 15101: my @hiddenlist=split(/,/,$hiddenparts);
15102: foreach my $checkid (@hiddenlist) {
1.141 albertel 15103: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 15104: }
1.141 albertel 15105: return !$truth;
1.84 albertel 15106: }
1.127 matthew 15107:
1.138 matthew 15108:
15109: ############################################################
15110: ############################################################
15111:
15112: =pod
15113:
1.157 matthew 15114: =back
15115:
1.138 matthew 15116: =head1 cgi-bin script and graphing routines
15117:
1.157 matthew 15118: =over 4
15119:
1.648 raeburn 15120: =item * &get_cgi_id()
1.138 matthew 15121:
15122: Inputs: none
15123:
15124: Returns an id which can be used to pass environment variables
15125: to various cgi-bin scripts. These environment variables will
15126: be removed from the users environment after a given time by
15127: the routine &Apache::lonnet::transfer_profile_to_env.
15128:
15129: =cut
15130:
15131: ############################################################
15132: ############################################################
1.152 albertel 15133: my $uniq=0;
1.136 matthew 15134: sub get_cgi_id {
1.154 albertel 15135: $uniq=($uniq+1)%100000;
1.280 albertel 15136: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 15137: }
15138:
1.127 matthew 15139: ############################################################
15140: ############################################################
15141:
15142: =pod
15143:
1.648 raeburn 15144: =item * &DrawBarGraph()
1.127 matthew 15145:
1.138 matthew 15146: Facilitates the plotting of data in a (stacked) bar graph.
15147: Puts plot definition data into the users environment in order for
15148: graph.png to plot it. Returns an <img> tag for the plot.
15149: The bars on the plot are labeled '1','2',...,'n'.
15150:
15151: Inputs:
15152:
15153: =over 4
15154:
15155: =item $Title: string, the title of the plot
15156:
15157: =item $xlabel: string, text describing the X-axis of the plot
15158:
15159: =item $ylabel: string, text describing the Y-axis of the plot
15160:
15161: =item $Max: scalar, the maximum Y value to use in the plot
15162: If $Max is < any data point, the graph will not be rendered.
15163:
1.140 matthew 15164: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 15165: they are plotted. If undefined, default values will be used.
15166:
1.178 matthew 15167: =item $labels: array ref holding the labels to use on the x-axis for the bars.
15168:
1.138 matthew 15169: =item @Values: An array of array references. Each array reference holds data
15170: to be plotted in a stacked bar chart.
15171:
1.239 matthew 15172: =item If the final element of @Values is a hash reference the key/value
15173: pairs will be added to the graph definition.
15174:
1.138 matthew 15175: =back
15176:
15177: Returns:
15178:
15179: An <img> tag which references graph.png and the appropriate identifying
15180: information for the plot.
15181:
1.127 matthew 15182: =cut
15183:
15184: ############################################################
15185: ############################################################
1.134 matthew 15186: sub DrawBarGraph {
1.178 matthew 15187: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 15188: #
15189: if (! defined($colors)) {
15190: $colors = ['#33ff00',
15191: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
15192: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
15193: ];
15194: }
1.228 matthew 15195: my $extra_settings = {};
15196: if (ref($Values[-1]) eq 'HASH') {
15197: $extra_settings = pop(@Values);
15198: }
1.127 matthew 15199: #
1.136 matthew 15200: my $identifier = &get_cgi_id();
15201: my $id = 'cgi.'.$identifier;
1.129 matthew 15202: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 15203: return '';
15204: }
1.225 matthew 15205: #
15206: my @Labels;
15207: if (defined($labels)) {
15208: @Labels = @$labels;
15209: } else {
15210: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1263 raeburn 15211: push(@Labels,$i+1);
1.225 matthew 15212: }
15213: }
15214: #
1.129 matthew 15215: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 15216: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 15217: my %ValuesHash;
15218: my $NumSets=1;
15219: foreach my $array (@Values) {
15220: next if (! ref($array));
1.136 matthew 15221: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 15222: join(',',@$array);
1.129 matthew 15223: }
1.127 matthew 15224: #
1.136 matthew 15225: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 15226: if ($NumBars < 3) {
15227: $width = 120+$NumBars*32;
1.220 matthew 15228: $xskip = 1;
1.225 matthew 15229: $bar_width = 30;
15230: } elsif ($NumBars < 5) {
15231: $width = 120+$NumBars*20;
15232: $xskip = 1;
15233: $bar_width = 20;
1.220 matthew 15234: } elsif ($NumBars < 10) {
1.136 matthew 15235: $width = 120+$NumBars*15;
15236: $xskip = 1;
15237: $bar_width = 15;
15238: } elsif ($NumBars <= 25) {
15239: $width = 120+$NumBars*11;
15240: $xskip = 5;
15241: $bar_width = 8;
15242: } elsif ($NumBars <= 50) {
15243: $width = 120+$NumBars*8;
15244: $xskip = 5;
15245: $bar_width = 4;
15246: } else {
15247: $width = 120+$NumBars*8;
15248: $xskip = 5;
15249: $bar_width = 4;
15250: }
15251: #
1.137 matthew 15252: $Max = 1 if ($Max < 1);
15253: if ( int($Max) < $Max ) {
15254: $Max++;
15255: $Max = int($Max);
15256: }
1.127 matthew 15257: $Title = '' if (! defined($Title));
15258: $xlabel = '' if (! defined($xlabel));
15259: $ylabel = '' if (! defined($ylabel));
1.369 www 15260: $ValuesHash{$id.'.title'} = &escape($Title);
15261: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
15262: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 15263: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 15264: $ValuesHash{$id.'.NumBars'} = $NumBars;
15265: $ValuesHash{$id.'.NumSets'} = $NumSets;
15266: $ValuesHash{$id.'.PlotType'} = 'bar';
15267: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15268: $ValuesHash{$id.'.height'} = $height;
15269: $ValuesHash{$id.'.width'} = $width;
15270: $ValuesHash{$id.'.xskip'} = $xskip;
15271: $ValuesHash{$id.'.bar_width'} = $bar_width;
15272: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 15273: #
1.228 matthew 15274: # Deal with other parameters
15275: while (my ($key,$value) = each(%$extra_settings)) {
15276: $ValuesHash{$id.'.'.$key} = $value;
15277: }
15278: #
1.646 raeburn 15279: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 15280: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15281: }
15282:
15283: ############################################################
15284: ############################################################
15285:
15286: =pod
15287:
1.648 raeburn 15288: =item * &DrawXYGraph()
1.137 matthew 15289:
1.138 matthew 15290: Facilitates the plotting of data in an XY graph.
15291: Puts plot definition data into the users environment in order for
15292: graph.png to plot it. Returns an <img> tag for the plot.
15293:
15294: Inputs:
15295:
15296: =over 4
15297:
15298: =item $Title: string, the title of the plot
15299:
15300: =item $xlabel: string, text describing the X-axis of the plot
15301:
15302: =item $ylabel: string, text describing the Y-axis of the plot
15303:
15304: =item $Max: scalar, the maximum Y value to use in the plot
15305: If $Max is < any data point, the graph will not be rendered.
15306:
15307: =item $colors: Array ref containing the hex color codes for the data to be
15308: plotted in. If undefined, default values will be used.
15309:
15310: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15311:
15312: =item $Ydata: Array ref containing Array refs.
1.185 www 15313: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 15314:
15315: =item %Values: hash indicating or overriding any default values which are
15316: passed to graph.png.
15317: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15318:
15319: =back
15320:
15321: Returns:
15322:
15323: An <img> tag which references graph.png and the appropriate identifying
15324: information for the plot.
15325:
1.137 matthew 15326: =cut
15327:
15328: ############################################################
15329: ############################################################
15330: sub DrawXYGraph {
15331: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
15332: #
15333: # Create the identifier for the graph
15334: my $identifier = &get_cgi_id();
15335: my $id = 'cgi.'.$identifier;
15336: #
15337: $Title = '' if (! defined($Title));
15338: $xlabel = '' if (! defined($xlabel));
15339: $ylabel = '' if (! defined($ylabel));
15340: my %ValuesHash =
15341: (
1.369 www 15342: $id.'.title' => &escape($Title),
15343: $id.'.xlabel' => &escape($xlabel),
15344: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 15345: $id.'.y_max_value'=> $Max,
15346: $id.'.labels' => join(',',@$Xlabels),
15347: $id.'.PlotType' => 'XY',
15348: );
15349: #
15350: if (defined($colors) && ref($colors) eq 'ARRAY') {
15351: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15352: }
15353: #
15354: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
15355: return '';
15356: }
15357: my $NumSets=1;
1.138 matthew 15358: foreach my $array (@{$Ydata}){
1.137 matthew 15359: next if (! ref($array));
15360: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
15361: }
1.138 matthew 15362: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 15363: #
15364: # Deal with other parameters
15365: while (my ($key,$value) = each(%Values)) {
15366: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 15367: }
15368: #
1.646 raeburn 15369: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 15370: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15371: }
15372:
15373: ############################################################
15374: ############################################################
15375:
15376: =pod
15377:
1.648 raeburn 15378: =item * &DrawXYYGraph()
1.138 matthew 15379:
15380: Facilitates the plotting of data in an XY graph with two Y axes.
15381: Puts plot definition data into the users environment in order for
15382: graph.png to plot it. Returns an <img> tag for the plot.
15383:
15384: Inputs:
15385:
15386: =over 4
15387:
15388: =item $Title: string, the title of the plot
15389:
15390: =item $xlabel: string, text describing the X-axis of the plot
15391:
15392: =item $ylabel: string, text describing the Y-axis of the plot
15393:
15394: =item $colors: Array ref containing the hex color codes for the data to be
15395: plotted in. If undefined, default values will be used.
15396:
15397: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15398:
15399: =item $Ydata1: The first data set
15400:
15401: =item $Min1: The minimum value of the left Y-axis
15402:
15403: =item $Max1: The maximum value of the left Y-axis
15404:
15405: =item $Ydata2: The second data set
15406:
15407: =item $Min2: The minimum value of the right Y-axis
15408:
15409: =item $Max2: The maximum value of the left Y-axis
15410:
15411: =item %Values: hash indicating or overriding any default values which are
15412: passed to graph.png.
15413: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15414:
15415: =back
15416:
15417: Returns:
15418:
15419: An <img> tag which references graph.png and the appropriate identifying
15420: information for the plot.
1.136 matthew 15421:
15422: =cut
15423:
15424: ############################################################
15425: ############################################################
1.137 matthew 15426: sub DrawXYYGraph {
15427: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
15428: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 15429: #
15430: # Create the identifier for the graph
15431: my $identifier = &get_cgi_id();
15432: my $id = 'cgi.'.$identifier;
15433: #
15434: $Title = '' if (! defined($Title));
15435: $xlabel = '' if (! defined($xlabel));
15436: $ylabel = '' if (! defined($ylabel));
15437: my %ValuesHash =
15438: (
1.369 www 15439: $id.'.title' => &escape($Title),
15440: $id.'.xlabel' => &escape($xlabel),
15441: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 15442: $id.'.labels' => join(',',@$Xlabels),
15443: $id.'.PlotType' => 'XY',
15444: $id.'.NumSets' => 2,
1.137 matthew 15445: $id.'.two_axes' => 1,
15446: $id.'.y1_max_value' => $Max1,
15447: $id.'.y1_min_value' => $Min1,
15448: $id.'.y2_max_value' => $Max2,
15449: $id.'.y2_min_value' => $Min2,
1.136 matthew 15450: );
15451: #
1.137 matthew 15452: if (defined($colors) && ref($colors) eq 'ARRAY') {
15453: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15454: }
15455: #
15456: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
15457: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 15458: return '';
15459: }
15460: my $NumSets=1;
1.137 matthew 15461: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 15462: next if (! ref($array));
15463: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 15464: }
15465: #
15466: # Deal with other parameters
15467: while (my ($key,$value) = each(%Values)) {
15468: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 15469: }
15470: #
1.646 raeburn 15471: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 15472: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 15473: }
15474:
15475: ############################################################
15476: ############################################################
15477:
15478: =pod
15479:
1.157 matthew 15480: =back
15481:
1.139 matthew 15482: =head1 Statistics helper routines?
15483:
15484: Bad place for them but what the hell.
15485:
1.157 matthew 15486: =over 4
15487:
1.648 raeburn 15488: =item * &chartlink()
1.139 matthew 15489:
15490: Returns a link to the chart for a specific student.
15491:
15492: Inputs:
15493:
15494: =over 4
15495:
15496: =item $linktext: The text of the link
15497:
15498: =item $sname: The students username
15499:
15500: =item $sdomain: The students domain
15501:
15502: =back
15503:
1.157 matthew 15504: =back
15505:
1.139 matthew 15506: =cut
15507:
15508: ############################################################
15509: ############################################################
15510: sub chartlink {
15511: my ($linktext, $sname, $sdomain) = @_;
15512: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 15513: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 15514: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 15515: '">'.$linktext.'</a>';
1.153 matthew 15516: }
15517:
15518: #######################################################
15519: #######################################################
15520:
15521: =pod
15522:
15523: =head1 Course Environment Routines
1.157 matthew 15524:
15525: =over 4
1.153 matthew 15526:
1.648 raeburn 15527: =item * &restore_course_settings()
1.153 matthew 15528:
1.648 raeburn 15529: =item * &store_course_settings()
1.153 matthew 15530:
15531: Restores/Store indicated form parameters from the course environment.
15532: Will not overwrite existing values of the form parameters.
15533:
15534: Inputs:
15535: a scalar describing the data (e.g. 'chart', 'problem_analysis')
15536:
15537: a hash ref describing the data to be stored. For example:
15538:
15539: %Save_Parameters = ('Status' => 'scalar',
15540: 'chartoutputmode' => 'scalar',
15541: 'chartoutputdata' => 'scalar',
15542: 'Section' => 'array',
1.373 raeburn 15543: 'Group' => 'array',
1.153 matthew 15544: 'StudentData' => 'array',
15545: 'Maps' => 'array');
15546:
15547: Returns: both routines return nothing
15548:
1.631 raeburn 15549: =back
15550:
1.153 matthew 15551: =cut
15552:
15553: #######################################################
15554: #######################################################
15555: sub store_course_settings {
1.496 albertel 15556: return &store_settings($env{'request.course.id'},@_);
15557: }
15558:
15559: sub store_settings {
1.153 matthew 15560: # save to the environment
15561: # appenv the same items, just to be safe
1.300 albertel 15562: my $udom = $env{'user.domain'};
15563: my $uname = $env{'user.name'};
1.496 albertel 15564: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15565: my %SaveHash;
15566: my %AppHash;
15567: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 15568: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 15569: my $envname = 'environment.'.$basename;
1.258 albertel 15570: if (exists($env{'form.'.$setting})) {
1.153 matthew 15571: # Save this value away
15572: if ($type eq 'scalar' &&
1.258 albertel 15573: (! exists($env{$envname}) ||
15574: $env{$envname} ne $env{'form.'.$setting})) {
15575: $SaveHash{$basename} = $env{'form.'.$setting};
15576: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 15577: } elsif ($type eq 'array') {
15578: my $stored_form;
1.258 albertel 15579: if (ref($env{'form.'.$setting})) {
1.153 matthew 15580: $stored_form = join(',',
15581: map {
1.369 www 15582: &escape($_);
1.258 albertel 15583: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 15584: } else {
15585: $stored_form =
1.369 www 15586: &escape($env{'form.'.$setting});
1.153 matthew 15587: }
15588: # Determine if the array contents are the same.
1.258 albertel 15589: if ($stored_form ne $env{$envname}) {
1.153 matthew 15590: $SaveHash{$basename} = $stored_form;
15591: $AppHash{$envname} = $stored_form;
15592: }
15593: }
15594: }
15595: }
15596: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 15597: $udom,$uname);
1.153 matthew 15598: if ($put_result !~ /^(ok|delayed)/) {
15599: &Apache::lonnet::logthis('unable to save form parameters, '.
15600: 'got error:'.$put_result);
15601: }
15602: # Make sure these settings stick around in this session, too
1.646 raeburn 15603: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 15604: return;
15605: }
15606:
15607: sub restore_course_settings {
1.499 albertel 15608: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 15609: }
15610:
15611: sub restore_settings {
15612: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15613: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 15614: next if (exists($env{'form.'.$setting}));
1.496 albertel 15615: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 15616: '.'.$setting;
1.258 albertel 15617: if (exists($env{$envname})) {
1.153 matthew 15618: if ($type eq 'scalar') {
1.258 albertel 15619: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 15620: } elsif ($type eq 'array') {
1.258 albertel 15621: $env{'form.'.$setting} = [
1.153 matthew 15622: map {
1.369 www 15623: &unescape($_);
1.258 albertel 15624: } split(',',$env{$envname})
1.153 matthew 15625: ];
15626: }
15627: }
15628: }
1.127 matthew 15629: }
15630:
1.618 raeburn 15631: #######################################################
15632: #######################################################
15633:
15634: =pod
15635:
15636: =head1 Domain E-mail Routines
15637:
15638: =over 4
15639:
1.648 raeburn 15640: =item * &build_recipient_list()
1.618 raeburn 15641:
1.1144 raeburn 15642: Build recipient lists for following types of e-mail:
1.766 raeburn 15643: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 15644: (d) Help requests, (e) Course requests needing approval, (f) loncapa
15645: module change checking, student/employee ID conflict checks, as
15646: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
15647: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 15648:
15649: Inputs:
1.619 raeburn 15650: defmail (scalar - email address of default recipient),
1.1144 raeburn 15651: mailing type (scalar: errormail, packagesmail, helpdeskmail,
15652: requestsmail, updatesmail, or idconflictsmail).
15653:
1.619 raeburn 15654: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 15655:
1.619 raeburn 15656: origmail (scalar - email address of recipient from loncapa.conf,
1.1297 raeburn 15657: i.e., predates configuration by DC via domainprefs.pm
15658:
15659: $requname username of requester (if mailing type is helpdeskmail)
15660:
15661: $requdom domain of requester (if mailing type is helpdeskmail)
15662:
15663: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
15664:
1.618 raeburn 15665:
1.655 raeburn 15666: Returns: comma separated list of addresses to which to send e-mail.
15667:
15668: =back
1.618 raeburn 15669:
15670: =cut
15671:
15672: ############################################################
15673: ############################################################
15674: sub build_recipient_list {
1.1297 raeburn 15675: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 15676: my @recipients;
1.1270 raeburn 15677: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 15678: my %domconfig =
1.1270 raeburn 15679: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 15680: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 15681: if (exists($domconfig{'contacts'}{$mailing})) {
15682: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
15683: my @contacts = ('adminemail','supportemail');
15684: foreach my $item (@contacts) {
15685: if ($domconfig{'contacts'}{$mailing}{$item}) {
15686: my $addr = $domconfig{'contacts'}{$item};
15687: if (!grep(/^\Q$addr\E$/,@recipients)) {
15688: push(@recipients,$addr);
15689: }
1.619 raeburn 15690: }
1.1270 raeburn 15691: }
15692: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
15693: if ($mailing eq 'helpdeskmail') {
15694: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
15695: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
15696: my @ok_bccs;
15697: foreach my $bcc (@bccs) {
15698: $bcc =~ s/^\s+//g;
15699: $bcc =~ s/\s+$//g;
15700: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15701: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15702: push(@ok_bccs,$bcc);
15703: }
15704: }
15705: }
15706: if (@ok_bccs > 0) {
15707: $allbcc = join(', ',@ok_bccs);
15708: }
15709: }
15710: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 15711: }
15712: }
1.766 raeburn 15713: } elsif ($origmail ne '') {
1.1270 raeburn 15714: $lastresort = $origmail;
1.618 raeburn 15715: }
1.1297 raeburn 15716: if ($mailing eq 'helpdeskmail') {
15717: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
15718: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
15719: my ($inststatus,$inststatus_checked);
15720: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
15721: ($env{'user.domain'} ne 'public')) {
15722: $inststatus_checked = 1;
15723: $inststatus = $env{'environment.inststatus'};
15724: }
15725: unless ($inststatus_checked) {
15726: if (($requname ne '') && ($requdom ne '')) {
15727: if (($requname =~ /^$match_username$/) &&
15728: ($requdom =~ /^$match_domain$/) &&
15729: (&Apache::lonnet::domain($requdom))) {
15730: my $requhome = &Apache::lonnet::homeserver($requname,
15731: $requdom);
15732: unless ($requhome eq 'no_host') {
15733: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
15734: $inststatus = $userenv{'inststatus'};
15735: $inststatus_checked = 1;
15736: }
15737: }
15738: }
15739: }
15740: unless ($inststatus_checked) {
15741: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
15742: my %srch = (srchby => 'email',
15743: srchdomain => $defdom,
15744: srchterm => $reqemail,
15745: srchtype => 'exact');
15746: my %srch_results = &Apache::lonnet::usersearch(\%srch);
15747: foreach my $uname (keys(%srch_results)) {
15748: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15749: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15750: $inststatus_checked = 1;
15751: last;
15752: }
15753: }
15754: unless ($inststatus_checked) {
15755: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
15756: if ($dirsrchres eq 'ok') {
15757: foreach my $uname (keys(%srch_results)) {
15758: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15759: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15760: $inststatus_checked = 1;
15761: last;
15762: }
15763: }
15764: }
15765: }
15766: }
15767: }
15768: if ($inststatus ne '') {
15769: foreach my $status (split(/\:/,$inststatus)) {
15770: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
15771: my @contacts = ('adminemail','supportemail');
15772: foreach my $item (@contacts) {
15773: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
15774: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
15775: if (!grep(/^\Q$addr\E$/,@recipients)) {
15776: push(@recipients,$addr);
15777: }
15778: }
15779: }
15780: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
15781: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
15782: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
15783: my @ok_bccs;
15784: foreach my $bcc (@bccs) {
15785: $bcc =~ s/^\s+//g;
15786: $bcc =~ s/\s+$//g;
15787: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15788: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15789: push(@ok_bccs,$bcc);
15790: }
15791: }
15792: }
15793: if (@ok_bccs > 0) {
15794: $allbcc = join(', ',@ok_bccs);
15795: }
15796: }
15797: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
15798: last;
15799: }
15800: }
15801: }
15802: }
15803: }
1.619 raeburn 15804: } elsif ($origmail ne '') {
1.1270 raeburn 15805: $lastresort = $origmail;
15806: }
1.1297 raeburn 15807: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1270 raeburn 15808: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
15809: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
15810: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
15811: my %what = (
15812: perlvar => 1,
15813: );
15814: my $primary = &Apache::lonnet::domain($defdom,'primary');
15815: if ($primary) {
15816: my $gotaddr;
15817: my ($result,$returnhash) =
15818: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
15819: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
15820: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
15821: $lastresort = $returnhash->{'lonSupportEMail'};
15822: $gotaddr = 1;
15823: }
15824: }
15825: unless ($gotaddr) {
15826: my $uintdom = &Apache::lonnet::internet_dom($primary);
15827: my $intdom = &Apache::lonnet::internet_dom($lonhost);
15828: unless ($uintdom eq $intdom) {
15829: my %domconfig =
15830: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
15831: if (ref($domconfig{'contacts'}) eq 'HASH') {
15832: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
15833: my @contacts = ('adminemail','supportemail');
15834: foreach my $item (@contacts) {
15835: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
15836: my $addr = $domconfig{'contacts'}{$item};
15837: if (!grep(/^\Q$addr\E$/,@recipients)) {
15838: push(@recipients,$addr);
15839: }
15840: }
15841: }
15842: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
15843: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
15844: }
15845: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
15846: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
15847: my @ok_bccs;
15848: foreach my $bcc (@bccs) {
15849: $bcc =~ s/^\s+//g;
15850: $bcc =~ s/\s+$//g;
15851: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15852: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15853: push(@ok_bccs,$bcc);
15854: }
15855: }
15856: }
15857: if (@ok_bccs > 0) {
15858: $allbcc = join(', ',@ok_bccs);
15859: }
15860: }
15861: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
15862: }
15863: }
15864: }
15865: }
15866: }
15867: }
1.618 raeburn 15868: }
1.688 raeburn 15869: if (defined($defmail)) {
15870: if ($defmail ne '') {
15871: push(@recipients,$defmail);
15872: }
1.618 raeburn 15873: }
15874: if ($otheremails) {
1.619 raeburn 15875: my @others;
15876: if ($otheremails =~ /,/) {
15877: @others = split(/,/,$otheremails);
1.618 raeburn 15878: } else {
1.619 raeburn 15879: push(@others,$otheremails);
15880: }
15881: foreach my $addr (@others) {
15882: if (!grep(/^\Q$addr\E$/,@recipients)) {
15883: push(@recipients,$addr);
15884: }
1.618 raeburn 15885: }
15886: }
1.1298 raeburn 15887: if ($mailing eq 'helpdeskmail') {
1.1270 raeburn 15888: if ((!@recipients) && ($lastresort ne '')) {
15889: push(@recipients,$lastresort);
15890: }
15891: } elsif ($lastresort ne '') {
15892: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
15893: push(@recipients,$lastresort);
15894: }
15895: }
1.1271 raeburn 15896: my $recipientlist = join(',',@recipients);
1.1270 raeburn 15897: if (wantarray) {
15898: return ($recipientlist,$allbcc,$addtext);
15899: } else {
15900: return $recipientlist;
15901: }
1.618 raeburn 15902: }
15903:
1.127 matthew 15904: ############################################################
15905: ############################################################
1.154 albertel 15906:
1.655 raeburn 15907: =pod
15908:
1.1224 musolffc 15909: =over 4
15910:
1.1223 musolffc 15911: =item * &mime_email()
15912:
15913: Sends an email with a possible attachment
15914:
15915: Inputs:
15916:
15917: =over 4
15918:
15919: from - Sender's email address
15920:
1.1343 raeburn 15921: replyto - Reply-To email address
15922:
1.1223 musolffc 15923: to - Email address of recipient
15924:
15925: subject - Subject of email
15926:
15927: body - Body of email
15928:
15929: cc_string - Carbon copy email address
15930:
15931: bcc - Blind carbon copy email address
15932:
15933: attachment_path - Path of file to be attached
15934:
15935: file_name - Name of file to be attached
15936:
15937: attachment_text - The body of an attachment of type "TEXT"
15938:
15939: =back
15940:
15941: =back
15942:
15943: =cut
15944:
15945: ############################################################
15946: ############################################################
15947:
15948: sub mime_email {
1.1343 raeburn 15949: my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
15950: $file_name,$attachment_text) = @_;
15951:
1.1223 musolffc 15952: my $msg = MIME::Lite->new(
15953: From => $from,
15954: To => $to,
15955: Subject => $subject,
15956: Type =>'TEXT',
15957: Data => $body,
15958: );
1.1343 raeburn 15959: if ($replyto ne '') {
15960: $msg->add("Reply-To" => $replyto);
15961: }
1.1223 musolffc 15962: if ($cc_string ne '') {
15963: $msg->add("Cc" => $cc_string);
15964: }
15965: if ($bcc ne '') {
15966: $msg->add("Bcc" => $bcc);
15967: }
15968: $msg->attr("content-type" => "text/plain");
15969: $msg->attr("content-type.charset" => "UTF-8");
15970: # Attach file if given
15971: if ($attachment_path) {
15972: unless ($file_name) {
15973: if ($attachment_path =~ m-/([^/]+)$-) { $file_name = $1; }
15974: }
15975: my ($type, $encoding) = MIME::Types::by_suffix($attachment_path);
15976: $msg->attach(Type => $type,
15977: Path => $attachment_path,
15978: Filename => $file_name
15979: );
15980: # Otherwise attach text if given
15981: } elsif ($attachment_text) {
15982: $msg->attach(Type => 'TEXT',
15983: Data => $attachment_text);
15984: }
15985: # Send it
15986: $msg->send('sendmail');
15987: }
15988:
15989: ############################################################
15990: ############################################################
15991:
15992: =pod
15993:
1.655 raeburn 15994: =head1 Course Catalog Routines
15995:
15996: =over 4
15997:
15998: =item * &gather_categories()
15999:
16000: Converts category definitions - keys of categories hash stored in
16001: coursecategories in configuration.db on the primary library server in a
16002: domain - to an array. Also generates javascript and idx hash used to
16003: generate Domain Coordinator interface for editing Course Categories.
16004:
16005: Inputs:
1.663 raeburn 16006:
1.655 raeburn 16007: categories (reference to hash of category definitions).
1.663 raeburn 16008:
1.655 raeburn 16009: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16010: categories and subcategories).
1.663 raeburn 16011:
1.655 raeburn 16012: idx (reference to hash of counters used in Domain Coordinator interface for
16013: editing Course Categories).
1.663 raeburn 16014:
1.655 raeburn 16015: jsarray (reference to array of categories used to create Javascript arrays for
16016: Domain Coordinator interface for editing Course Categories).
16017:
16018: Returns: nothing
16019:
16020: Side effects: populates cats, idx and jsarray.
16021:
16022: =cut
16023:
16024: sub gather_categories {
16025: my ($categories,$cats,$idx,$jsarray) = @_;
16026: my %counters;
16027: my $num = 0;
16028: foreach my $item (keys(%{$categories})) {
16029: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
16030: if ($container eq '' && $depth == 0) {
16031: $cats->[$depth][$categories->{$item}] = $cat;
16032: } else {
16033: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
16034: }
16035: my ($escitem,$tail) = split(/:/,$item,2);
16036: if ($counters{$tail} eq '') {
16037: $counters{$tail} = $num;
16038: $num ++;
16039: }
16040: if (ref($idx) eq 'HASH') {
16041: $idx->{$item} = $counters{$tail};
16042: }
16043: if (ref($jsarray) eq 'ARRAY') {
16044: push(@{$jsarray->[$counters{$tail}]},$item);
16045: }
16046: }
16047: return;
16048: }
16049:
16050: =pod
16051:
16052: =item * &extract_categories()
16053:
16054: Used to generate breadcrumb trails for course categories.
16055:
16056: Inputs:
1.663 raeburn 16057:
1.655 raeburn 16058: categories (reference to hash of category definitions).
1.663 raeburn 16059:
1.655 raeburn 16060: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16061: categories and subcategories).
1.663 raeburn 16062:
1.655 raeburn 16063: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 16064:
1.655 raeburn 16065: allitems (reference to hash - key is category key
16066: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16067:
1.655 raeburn 16068: idx (reference to hash of counters used in Domain Coordinator interface for
16069: editing Course Categories).
1.663 raeburn 16070:
1.655 raeburn 16071: jsarray (reference to array of categories used to create Javascript arrays for
16072: Domain Coordinator interface for editing Course Categories).
16073:
1.665 raeburn 16074: subcats (reference to hash of arrays containing all subcategories within each
16075: category, -recursive)
16076:
1.1321 raeburn 16077: maxd (reference to hash used to hold max depth for all top-level categories).
16078:
1.655 raeburn 16079: Returns: nothing
16080:
16081: Side effects: populates trails and allitems hash references.
16082:
16083: =cut
16084:
16085: sub extract_categories {
1.1321 raeburn 16086: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 16087: if (ref($categories) eq 'HASH') {
16088: &gather_categories($categories,$cats,$idx,$jsarray);
16089: if (ref($cats->[0]) eq 'ARRAY') {
16090: for (my $i=0; $i<@{$cats->[0]}; $i++) {
16091: my $name = $cats->[0][$i];
16092: my $item = &escape($name).'::0';
16093: my $trailstr;
16094: if ($name eq 'instcode') {
16095: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 16096: } elsif ($name eq 'communities') {
16097: $trailstr = &mt('Communities');
1.1239 raeburn 16098: } elsif ($name eq 'placement') {
16099: $trailstr = &mt('Placement Tests');
1.655 raeburn 16100: } else {
16101: $trailstr = $name;
16102: }
16103: if ($allitems->{$item} eq '') {
16104: push(@{$trails},$trailstr);
16105: $allitems->{$item} = scalar(@{$trails})-1;
16106: }
16107: my @parents = ($name);
16108: if (ref($cats->[1]{$name}) eq 'ARRAY') {
16109: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
16110: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 16111: if (ref($subcats) eq 'HASH') {
16112: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
16113: }
1.1321 raeburn 16114: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 16115: }
16116: } else {
16117: if (ref($subcats) eq 'HASH') {
16118: $subcats->{$item} = [];
1.655 raeburn 16119: }
1.1321 raeburn 16120: if (ref($maxd) eq 'HASH') {
16121: $maxd->{$name} = 1;
16122: }
1.655 raeburn 16123: }
16124: }
16125: }
16126: }
16127: return;
16128: }
16129:
16130: =pod
16131:
1.1162 raeburn 16132: =item * &recurse_categories()
1.655 raeburn 16133:
16134: Recursively used to generate breadcrumb trails for course categories.
16135:
16136: Inputs:
1.663 raeburn 16137:
1.655 raeburn 16138: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16139: categories and subcategories).
1.663 raeburn 16140:
1.655 raeburn 16141: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 16142:
16143: category (current course category, for which breadcrumb trail is being generated).
16144:
16145: trails (reference to array of breadcrumb trails for each category).
16146:
1.655 raeburn 16147: allitems (reference to hash - key is category key
16148: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16149:
1.655 raeburn 16150: parents (array containing containers directories for current category,
16151: back to top level).
16152:
16153: Returns: nothing
16154:
16155: Side effects: populates trails and allitems hash references
16156:
16157: =cut
16158:
16159: sub recurse_categories {
1.1321 raeburn 16160: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 16161: my $shallower = $depth - 1;
16162: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
16163: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
16164: my $name = $cats->[$depth]{$category}[$k];
16165: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16166: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16167: if ($allitems->{$item} eq '') {
16168: push(@{$trails},$trailstr);
16169: $allitems->{$item} = scalar(@{$trails})-1;
16170: }
16171: my $deeper = $depth+1;
16172: push(@{$parents},$category);
1.665 raeburn 16173: if (ref($subcats) eq 'HASH') {
16174: my $subcat = &escape($name).':'.$category.':'.$depth;
16175: for (my $j=@{$parents}; $j>=0; $j--) {
16176: my $higher;
16177: if ($j > 0) {
16178: $higher = &escape($parents->[$j]).':'.
16179: &escape($parents->[$j-1]).':'.$j;
16180: } else {
16181: $higher = &escape($parents->[$j]).'::'.$j;
16182: }
16183: push(@{$subcats->{$higher}},$subcat);
16184: }
16185: }
16186: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1321 raeburn 16187: $subcats,$maxd);
1.655 raeburn 16188: pop(@{$parents});
16189: }
16190: } else {
16191: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1321 raeburn 16192: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16193: if ($allitems->{$item} eq '') {
16194: push(@{$trails},$trailstr);
16195: $allitems->{$item} = scalar(@{$trails})-1;
16196: }
1.1321 raeburn 16197: if (ref($maxd) eq 'HASH') {
16198: if ($depth > $maxd->{$parents->[0]}) {
16199: $maxd->{$parents->[0]} = $depth;
16200: }
16201: }
1.655 raeburn 16202: }
16203: return;
16204: }
16205:
1.663 raeburn 16206: =pod
16207:
1.1162 raeburn 16208: =item * &assign_categories_table()
1.663 raeburn 16209:
16210: Create a datatable for display of hierarchical categories in a domain,
16211: with checkboxes to allow a course to be categorized.
16212:
16213: Inputs:
16214:
16215: cathash - reference to hash of categories defined for the domain (from
16216: configuration.db)
16217:
16218: currcat - scalar with an & separated list of categories assigned to a course.
16219:
1.919 raeburn 16220: type - scalar contains course type (Course or Community).
16221:
1.1260 raeburn 16222: disabled - scalar (optional) contains disabled="disabled" if input elements are
16223: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16224:
1.663 raeburn 16225: Returns: $output (markup to be displayed)
16226:
16227: =cut
16228:
16229: sub assign_categories_table {
1.1259 raeburn 16230: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 16231: my $output;
16232: if (ref($cathash) eq 'HASH') {
1.1321 raeburn 16233: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
16234: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 16235: $maxdepth = scalar(@cats);
16236: if (@cats > 0) {
16237: my $itemcount = 0;
16238: if (ref($cats[0]) eq 'ARRAY') {
16239: my @currcategories;
16240: if ($currcat ne '') {
16241: @currcategories = split('&',$currcat);
16242: }
1.919 raeburn 16243: my $table;
1.663 raeburn 16244: for (my $i=0; $i<@{$cats[0]}; $i++) {
16245: my $parent = $cats[0][$i];
1.919 raeburn 16246: next if ($parent eq 'instcode');
16247: if ($type eq 'Community') {
16248: next unless ($parent eq 'communities');
1.1239 raeburn 16249: } elsif ($type eq 'Placement') {
16250: next unless ($parent eq 'placement');
1.919 raeburn 16251: } else {
1.1239 raeburn 16252: next if (($parent eq 'communities') || ($parent eq 'placement'));
1.919 raeburn 16253: }
1.663 raeburn 16254: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
16255: my $item = &escape($parent).'::0';
16256: my $checked = '';
16257: if (@currcategories > 0) {
16258: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 16259: $checked = ' checked="checked"';
1.663 raeburn 16260: }
16261: }
1.919 raeburn 16262: my $parent_title = $parent;
16263: if ($parent eq 'communities') {
16264: $parent_title = &mt('Communities');
1.1239 raeburn 16265: } elsif ($parent eq 'placement') {
16266: $parent_title = &mt('Placement Tests');
1.919 raeburn 16267: }
16268: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
16269: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16270: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 16271: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 16272: my $depth = 1;
16273: push(@path,$parent);
1.1259 raeburn 16274: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 16275: pop(@path);
1.919 raeburn 16276: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 16277: $itemcount ++;
16278: }
1.919 raeburn 16279: if ($itemcount) {
16280: $output = &Apache::loncommon::start_data_table().
16281: $table.
16282: &Apache::loncommon::end_data_table();
16283: }
1.663 raeburn 16284: }
16285: }
16286: }
16287: return $output;
16288: }
16289:
16290: =pod
16291:
1.1162 raeburn 16292: =item * &assign_category_rows()
1.663 raeburn 16293:
16294: Create a datatable row for display of nested categories in a domain,
16295: with checkboxes to allow a course to be categorized,called recursively.
16296:
16297: Inputs:
16298:
16299: itemcount - track row number for alternating colors
16300:
16301: cats - reference to array of arrays/hashes which encapsulates hierarchy of
16302: categories and subcategories.
16303:
16304: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
16305:
16306: parent - parent of current category item
16307:
16308: path - Array containing all categories back up through the hierarchy from the
16309: current category to the top level.
16310:
16311: currcategories - reference to array of current categories assigned to the course
16312:
1.1260 raeburn 16313: disabled - scalar (optional) contains disabled="disabled" if input elements are
16314: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16315:
1.663 raeburn 16316: Returns: $output (markup to be displayed).
16317:
16318: =cut
16319:
16320: sub assign_category_rows {
1.1259 raeburn 16321: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 16322: my ($text,$name,$item,$chgstr);
16323: if (ref($cats) eq 'ARRAY') {
16324: my $maxdepth = scalar(@{$cats});
16325: if (ref($cats->[$depth]) eq 'HASH') {
16326: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
16327: my $numchildren = @{$cats->[$depth]{$parent}};
16328: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 16329: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 16330: for (my $j=0; $j<$numchildren; $j++) {
16331: $name = $cats->[$depth]{$parent}[$j];
16332: $item = &escape($name).':'.&escape($parent).':'.$depth;
16333: my $deeper = $depth+1;
16334: my $checked = '';
16335: if (ref($currcategories) eq 'ARRAY') {
16336: if (@{$currcategories} > 0) {
16337: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 16338: $checked = ' checked="checked"';
1.663 raeburn 16339: }
16340: }
16341: }
1.664 raeburn 16342: $text .= '<tr><td><span class="LC_nobreak"><label>'.
16343: '<input type="checkbox" name="usecategory" value="'.
1.1259 raeburn 16344: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 16345: '<input type="hidden" name="catname" value="'.$name.'" />'.
16346: '</td><td>';
1.663 raeburn 16347: if (ref($path) eq 'ARRAY') {
16348: push(@{$path},$name);
1.1259 raeburn 16349: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 16350: pop(@{$path});
16351: }
16352: $text .= '</td></tr>';
16353: }
16354: $text .= '</table></td>';
16355: }
16356: }
16357: }
16358: return $text;
16359: }
16360:
1.1181 raeburn 16361: =pod
16362:
16363: =back
16364:
16365: =cut
16366:
1.655 raeburn 16367: ############################################################
16368: ############################################################
16369:
16370:
1.443 albertel 16371: sub commit_customrole {
1.664 raeburn 16372: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.1399 ! raeburn 16373: my $result = &Apache::lonnet::assigncustomrole(
! 16374: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context);
1.630 raeburn 16375: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 16376: ($start?', '.&mt('starting').' '.localtime($start):'').
1.1399 ! raeburn 16377: ($end?', ending '.localtime($end):'').': <b>'.$result.'</b><br />';
! 16378: if (wantarray) {
! 16379: return ($output,$result);
! 16380: } else {
! 16381: return $output;
! 16382: }
1.443 albertel 16383: }
16384:
16385: sub commit_standardrole {
1.1116 raeburn 16386: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.1399 ! raeburn 16387: my ($output,$logmsg,$linefeed,$result);
1.541 raeburn 16388: if ($context eq 'auto') {
16389: $linefeed = "\n";
16390: } else {
16391: $linefeed = "<br />\n";
16392: }
1.443 albertel 16393: if ($three eq 'st') {
1.1399 ! raeburn 16394: $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
! 16395: $one,$two,$sec,$context,$credits);
1.541 raeburn 16396: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 16397: ($result eq 'unknown_course') || ($result eq 'refused')) {
16398: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 16399: } else {
1.541 raeburn 16400: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 16401: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16402: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
16403: if ($context eq 'auto') {
16404: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
16405: } else {
16406: $output .= '<b>'.$result.'</b>'.$linefeed.
16407: &mt('Add to classlist').': <b>ok</b>';
16408: }
16409: $output .= $linefeed;
1.443 albertel 16410: }
16411: } else {
16412: $output = &mt('Assigning').' '.$three.' in '.$url.
16413: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16414: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.1399 ! raeburn 16415: $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 16416: if ($context eq 'auto') {
16417: $output .= $result.$linefeed;
16418: } else {
16419: $output .= '<b>'.$result.'</b>'.$linefeed;
16420: }
1.443 albertel 16421: }
1.1399 ! raeburn 16422: if (wantarray) {
! 16423: return ($output,$result);
! 16424: } else {
! 16425: return $output;
! 16426: }
1.443 albertel 16427: }
16428:
16429: sub commit_studentrole {
1.1116 raeburn 16430: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
16431: $credits) = @_;
1.626 raeburn 16432: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 16433: if ($context eq 'auto') {
16434: $linefeed = "\n";
16435: } else {
16436: $linefeed = '<br />'."\n";
16437: }
1.443 albertel 16438: if (defined($one) && defined($two)) {
16439: my $cid=$one.'_'.$two;
16440: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
16441: my $secchange = 0;
16442: my $expire_role_result;
16443: my $modify_section_result;
1.628 raeburn 16444: if ($oldsec ne '-1') {
16445: if ($oldsec ne $sec) {
1.443 albertel 16446: $secchange = 1;
1.628 raeburn 16447: my $now = time;
1.443 albertel 16448: my $uurl='/'.$cid;
16449: $uurl=~s/\_/\//g;
16450: if ($oldsec) {
16451: $uurl.='/'.$oldsec;
16452: }
1.626 raeburn 16453: $oldsecurl = $uurl;
1.628 raeburn 16454: $expire_role_result =
1.1398 raeburn 16455: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','','',$context);
1.628 raeburn 16456: if ($env{'request.course.sec'} ne '') {
16457: if ($expire_role_result eq 'refused') {
16458: my @roles = ('st');
16459: my @statuses = ('previous');
16460: my @roledoms = ($one);
16461: my $withsec = 1;
16462: my %roleshash =
16463: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
16464: \@statuses,\@roles,\@roledoms,$withsec);
16465: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
16466: my ($oldstart,$oldend) =
16467: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
16468: if ($oldend > 0 && $oldend <= $now) {
16469: $expire_role_result = 'ok';
16470: }
16471: }
16472: }
16473: }
1.443 albertel 16474: $result = $expire_role_result;
16475: }
16476: }
16477: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 16478: $modify_section_result =
16479: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
16480: undef,undef,undef,$sec,
16481: $end,$start,'','',$cid,
16482: '',$context,$credits);
1.443 albertel 16483: if ($modify_section_result =~ /^ok/) {
16484: if ($secchange == 1) {
1.628 raeburn 16485: if ($sec eq '') {
16486: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
16487: } else {
16488: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
16489: }
1.443 albertel 16490: } elsif ($oldsec eq '-1') {
1.628 raeburn 16491: if ($sec eq '') {
16492: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
16493: } else {
16494: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16495: }
1.443 albertel 16496: } else {
1.628 raeburn 16497: if ($sec eq '') {
16498: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
16499: } else {
16500: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16501: }
1.443 albertel 16502: }
16503: } else {
1.1115 raeburn 16504: if ($secchange) {
1.628 raeburn 16505: $$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;
16506: } else {
16507: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
16508: }
1.443 albertel 16509: }
16510: $result = $modify_section_result;
16511: } elsif ($secchange == 1) {
1.628 raeburn 16512: if ($oldsec eq '') {
1.1103 raeburn 16513: $$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 16514: } else {
16515: $$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;
16516: }
1.626 raeburn 16517: if ($expire_role_result eq 'refused') {
16518: my $newsecurl = '/'.$cid;
16519: $newsecurl =~ s/\_/\//g;
16520: if ($sec ne '') {
16521: $newsecurl.='/'.$sec;
16522: }
16523: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
16524: if ($sec eq '') {
16525: $$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;
16526: } else {
16527: $$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;
16528: }
16529: }
16530: }
1.443 albertel 16531: }
16532: } else {
1.626 raeburn 16533: $$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 16534: $result = "error: incomplete course id\n";
16535: }
16536: return $result;
16537: }
16538:
1.1108 raeburn 16539: sub show_role_extent {
16540: my ($scope,$context,$role) = @_;
16541: $scope =~ s{^/}{};
16542: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
16543: push(@courseroles,'co');
16544: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
16545: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
16546: $scope =~ s{/}{_};
16547: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
16548: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
16549: my ($audom,$auname) = split(/\//,$scope);
16550: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
16551: &Apache::loncommon::plainname($auname,$audom).'</span>');
16552: } else {
16553: $scope =~ s{/$}{};
16554: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
16555: &Apache::lonnet::domain($scope,'description').'</span>');
16556: }
16557: }
16558:
1.443 albertel 16559: ############################################################
16560: ############################################################
16561:
1.566 albertel 16562: sub check_clone {
1.578 raeburn 16563: my ($args,$linefeed) = @_;
1.566 albertel 16564: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
16565: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
16566: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1344 raeburn 16567: my $clonetitle;
16568: my @clonemsg;
1.566 albertel 16569: my $can_clone = 0;
1.944 raeburn 16570: my $lctype = lc($args->{'crstype'});
1.908 raeburn 16571: if ($lctype ne 'community') {
16572: $lctype = 'course';
16573: }
1.566 albertel 16574: if ($clonehome eq 'no_host') {
1.944 raeburn 16575: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16576: push(@clonemsg,({
16577: mt => 'No new community created.',
16578: args => [],
16579: },
16580: {
16581: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
16582: args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
16583: }));
1.908 raeburn 16584: } else {
1.1344 raeburn 16585: push(@clonemsg,({
16586: mt => 'No new course created.',
16587: args => [],
16588: },
16589: {
16590: mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
16591: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16592: }));
16593: }
1.566 albertel 16594: } else {
16595: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1344 raeburn 16596: $clonetitle = $clonedesc{'description'};
1.944 raeburn 16597: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 16598: if ($clonedesc{'type'} ne 'Community') {
1.1344 raeburn 16599: push(@clonemsg,({
16600: mt => 'No new community created.',
16601: args => [],
16602: },
16603: {
16604: mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
16605: args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16606: }));
16607: return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 16608: }
16609: }
1.1262 raeburn 16610: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 16611: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 16612: $can_clone = 1;
16613: } else {
1.1221 raeburn 16614: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 16615: $args->{'clonedomain'},$args->{'clonecourse'});
1.1221 raeburn 16616: if ($clonehash{'cloners'} eq '') {
16617: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
16618: if ($domdefs{'canclone'}) {
16619: unless ($domdefs{'canclone'} eq 'none') {
16620: if ($domdefs{'canclone'} eq 'domain') {
16621: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
16622: $can_clone = 1;
16623: }
16624: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16625: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
16626: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
16627: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
16628: $can_clone = 1;
16629: }
16630: }
16631: }
16632: }
1.578 raeburn 16633: } else {
1.1221 raeburn 16634: my @cloners = split(/,/,$clonehash{'cloners'});
16635: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 16636: $can_clone = 1;
1.1221 raeburn 16637: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 16638: $can_clone = 1;
1.1225 raeburn 16639: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
16640: $can_clone = 1;
1.1221 raeburn 16641: }
16642: unless ($can_clone) {
1.1225 raeburn 16643: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16644: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1221 raeburn 16645: my (%gotdomdefaults,%gotcodedefaults);
16646: foreach my $cloner (@cloners) {
16647: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
16648: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
16649: my (%codedefaults,@code_order);
16650: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
16651: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
16652: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
16653: }
16654: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
16655: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
16656: }
16657: } else {
16658: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
16659: \%codedefaults,
16660: \@code_order);
16661: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
16662: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
16663: }
16664: if (@code_order > 0) {
16665: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
16666: $cloner,$clonehash{'internal.coursecode'},
16667: $args->{'crscode'})) {
16668: $can_clone = 1;
16669: last;
16670: }
16671: }
16672: }
16673: }
16674: }
1.1225 raeburn 16675: }
16676: }
16677: unless ($can_clone) {
16678: my $ccrole = 'cc';
16679: if ($args->{'crstype'} eq 'Community') {
16680: $ccrole = 'co';
16681: }
16682: my %roleshash =
16683: &Apache::lonnet::get_my_roles($args->{'ccuname'},
16684: $args->{'ccdomain'},
16685: 'userroles',['active'],[$ccrole],
16686: [$args->{'clonedomain'}]);
16687: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
16688: $can_clone = 1;
16689: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
16690: $args->{'ccuname'},$args->{'ccdomain'})) {
16691: $can_clone = 1;
1.1221 raeburn 16692: }
16693: }
16694: unless ($can_clone) {
16695: if ($args->{'crstype'} eq 'Community') {
1.1344 raeburn 16696: push(@clonemsg,({
16697: mt => 'No new community created.',
16698: args => [],
16699: },
16700: {
16701: 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]).',
16702: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16703: }));
1.942 raeburn 16704: } else {
1.1344 raeburn 16705: push(@clonemsg,({
16706: mt => 'No new course created.',
16707: args => [],
16708: },
16709: {
16710: 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]).',
16711: args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16712: }));
1.1221 raeburn 16713: }
1.566 albertel 16714: }
1.578 raeburn 16715: }
1.566 albertel 16716: }
1.1344 raeburn 16717: return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16718: }
16719:
1.444 albertel 16720: sub construct_course {
1.1262 raeburn 16721: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1344 raeburn 16722: $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
16723: my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 16724: my $linefeed = '<br />'."\n";
16725: if ($context eq 'auto') {
16726: $linefeed = "\n";
16727: }
1.566 albertel 16728:
16729: #
16730: # Are we cloning?
16731: #
1.1344 raeburn 16732: my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16733: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1344 raeburn 16734: ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 16735: if (!$can_clone) {
1.1344 raeburn 16736: return (0,$outcome,$clonemsgref);
1.566 albertel 16737: }
16738: }
16739:
1.444 albertel 16740: #
16741: # Open course
16742: #
1.1239 raeburn 16743: my $showncrstype;
16744: if ($args->{'crstype'} eq 'Placement') {
16745: $showncrstype = 'placement test';
16746: } else {
16747: $showncrstype = lc($args->{'crstype'});
16748: }
1.444 albertel 16749: my %cenv=();
16750: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
16751: $args->{'cdescr'},
16752: $args->{'curl'},
16753: $args->{'course_home'},
16754: $args->{'nonstandard'},
16755: $args->{'crscode'},
16756: $args->{'ccuname'}.':'.
16757: $args->{'ccdomain'},
1.882 raeburn 16758: $args->{'crstype'},
1.1344 raeburn 16759: $cnum,$context,$category,
16760: $callercontext);
1.444 albertel 16761:
16762: # Note: The testing routines depend on this being output; see
16763: # Utils::Course. This needs to at least be output as a comment
16764: # if anyone ever decides to not show this, and Utils::Course::new
16765: # will need to be suitably modified.
1.1344 raeburn 16766: if (($callercontext eq 'auto') && ($user_lh ne '')) {
16767: $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
16768: } else {
16769: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
16770: }
1.943 raeburn 16771: if ($$courseid =~ /^error:/) {
1.1344 raeburn 16772: return (0,$outcome,$clonemsgref);
1.943 raeburn 16773: }
16774:
1.444 albertel 16775: #
16776: # Check if created correctly
16777: #
1.479 albertel 16778: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 16779: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 16780: if ($crsuhome eq 'no_host') {
1.1344 raeburn 16781: if (($callercontext eq 'auto') && ($user_lh ne '')) {
16782: $outcome .= &mt_user($user_lh,
16783: 'Course creation failed, unrecognized course home server.');
16784: } else {
16785: $outcome .= &mt('Course creation failed, unrecognized course home server.');
16786: }
16787: $outcome .= $linefeed;
16788: return (0,$outcome,$clonemsgref);
1.943 raeburn 16789: }
1.541 raeburn 16790: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 16791:
1.444 albertel 16792: #
1.566 albertel 16793: # Do the cloning
16794: #
1.1344 raeburn 16795: my @clonemsg;
1.566 albertel 16796: if ($can_clone && $cloneid) {
1.1344 raeburn 16797: push(@clonemsg,
16798: {
16799: mt => 'Created [_1] by cloning from [_2]',
16800: args => [$showncrstype,$clonetitle],
16801: });
1.566 albertel 16802: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 16803: # Copy all files
1.1344 raeburn 16804: my @info =
16805: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
16806: $args->{'dateshift'},$args->{'crscode'},
16807: $args->{'ccuname'}.':'.$args->{'ccdomain'},
16808: $args->{'tinyurls'});
16809: if (@info) {
16810: push(@clonemsg,@info);
16811: }
1.444 albertel 16812: # Restore URL
1.566 albertel 16813: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 16814: # Restore title
1.566 albertel 16815: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 16816: # Restore creation date, creator and creation context.
16817: $cenv{'internal.created'}=$oldcenv{'internal.created'};
16818: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
16819: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 16820: # Mark as cloned
1.566 albertel 16821: $cenv{'clonedfrom'}=$cloneid;
1.638 www 16822: # Need to clone grading mode
16823: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
16824: $cenv{'grading'}=$newenv{'grading'};
16825: # Do not clone these environment entries
16826: &Apache::lonnet::del('environment',
16827: ['default_enrollment_start_date',
16828: 'default_enrollment_end_date',
16829: 'question.email',
16830: 'policy.email',
16831: 'comment.email',
16832: 'pch.users.denied',
1.725 raeburn 16833: 'plc.users.denied',
16834: 'hidefromcat',
1.1121 raeburn 16835: 'checkforpriv',
1.1355 raeburn 16836: 'categories'],
1.638 www 16837: $$crsudom,$$crsunum);
1.1170 raeburn 16838: if ($args->{'textbook'}) {
16839: $cenv{'internal.textbook'} = $args->{'textbook'};
16840: }
1.444 albertel 16841: }
1.566 albertel 16842:
1.444 albertel 16843: #
16844: # Set environment (will override cloned, if existing)
16845: #
16846: my @sections = ();
16847: my @xlists = ();
16848: if ($args->{'crstype'}) {
16849: $cenv{'type'}=$args->{'crstype'};
16850: }
1.1371 raeburn 16851: if ($args->{'lti'}) {
16852: $cenv{'internal.lti'}=$args->{'lti'};
16853: }
1.444 albertel 16854: if ($args->{'crsid'}) {
16855: $cenv{'courseid'}=$args->{'crsid'};
16856: }
16857: if ($args->{'crscode'}) {
16858: $cenv{'internal.coursecode'}=$args->{'crscode'};
16859: }
16860: if ($args->{'crsquota'} ne '') {
16861: $cenv{'internal.coursequota'}=$args->{'crsquota'};
16862: } else {
16863: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
16864: }
16865: if ($args->{'ccuname'}) {
16866: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
16867: ':'.$args->{'ccdomain'};
16868: } else {
16869: $cenv{'internal.courseowner'} = $args->{'curruser'};
16870: }
1.1116 raeburn 16871: if ($args->{'defaultcredits'}) {
16872: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
16873: }
1.444 albertel 16874: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
16875: if ($args->{'crssections'}) {
16876: $cenv{'internal.sectionnums'} = '';
16877: if ($args->{'crssections'} =~ m/,/) {
16878: @sections = split/,/,$args->{'crssections'};
16879: } else {
16880: $sections[0] = $args->{'crssections'};
16881: }
16882: if (@sections > 0) {
16883: foreach my $item (@sections) {
16884: my ($sec,$gp) = split/:/,$item;
16885: my $class = $args->{'crscode'}.$sec;
16886: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
16887: $cenv{'internal.sectionnums'} .= $item.',';
16888: unless ($addcheck eq 'ok') {
1.1263 raeburn 16889: push(@badclasses,$class);
1.444 albertel 16890: }
16891: }
16892: $cenv{'internal.sectionnums'} =~ s/,$//;
16893: }
16894: }
16895: # do not hide course coordinator from staff listing,
16896: # even if privileged
16897: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 16898: # add course coordinator's domain to domains to check for privileged users
16899: # if different to course domain
16900: if ($$crsudom ne $args->{'ccdomain'}) {
16901: $cenv{'checkforpriv'} = $args->{'ccdomain'};
16902: }
1.444 albertel 16903: # add crosslistings
16904: if ($args->{'crsxlist'}) {
16905: $cenv{'internal.crosslistings'}='';
16906: if ($args->{'crsxlist'} =~ m/,/) {
16907: @xlists = split/,/,$args->{'crsxlist'};
16908: } else {
16909: $xlists[0] = $args->{'crsxlist'};
16910: }
16911: if (@xlists > 0) {
16912: foreach my $item (@xlists) {
16913: my ($xl,$gp) = split/:/,$item;
16914: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
16915: $cenv{'internal.crosslistings'} .= $item.',';
16916: unless ($addcheck eq 'ok') {
1.1263 raeburn 16917: push(@badclasses,$xl);
1.444 albertel 16918: }
16919: }
16920: $cenv{'internal.crosslistings'} =~ s/,$//;
16921: }
16922: }
16923: if ($args->{'autoadds'}) {
16924: $cenv{'internal.autoadds'}=$args->{'autoadds'};
16925: }
16926: if ($args->{'autodrops'}) {
16927: $cenv{'internal.autodrops'}=$args->{'autodrops'};
16928: }
16929: # check for notification of enrollment changes
16930: my @notified = ();
16931: if ($args->{'notify_owner'}) {
16932: if ($args->{'ccuname'} ne '') {
16933: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
16934: }
16935: }
16936: if ($args->{'notify_dc'}) {
16937: if ($uname ne '') {
1.630 raeburn 16938: push(@notified,$uname.':'.$udom);
1.444 albertel 16939: }
16940: }
16941: if (@notified > 0) {
16942: my $notifylist;
16943: if (@notified > 1) {
16944: $notifylist = join(',',@notified);
16945: } else {
16946: $notifylist = $notified[0];
16947: }
16948: $cenv{'internal.notifylist'} = $notifylist;
16949: }
16950: if (@badclasses > 0) {
16951: my %lt=&Apache::lonlocal::texthash(
1.1264 raeburn 16952: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
16953: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
16954: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 16955: );
1.1264 raeburn 16956: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
16957: &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 16958: if ($context eq 'auto') {
16959: $outcome .= $badclass_msg.$linefeed;
1.1261 raeburn 16960: } else {
1.566 albertel 16961: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1261 raeburn 16962: }
16963: foreach my $item (@badclasses) {
1.541 raeburn 16964: if ($context eq 'auto') {
1.1261 raeburn 16965: $outcome .= " - $item\n";
1.541 raeburn 16966: } else {
1.1261 raeburn 16967: $outcome .= "<li>$item</li>\n";
1.541 raeburn 16968: }
1.1261 raeburn 16969: }
16970: if ($context eq 'auto') {
16971: $outcome .= $linefeed;
16972: } else {
16973: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 16974: }
1.444 albertel 16975: }
16976: if ($args->{'no_end_date'}) {
16977: $args->{'endaccess'} = 0;
16978: }
16979: $cenv{'internal.autostart'}=$args->{'enrollstart'};
16980: $cenv{'internal.autoend'}=$args->{'enrollend'};
16981: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
16982: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
16983: if ($args->{'showphotos'}) {
16984: $cenv{'internal.showphotos'}=$args->{'showphotos'};
16985: }
16986: $cenv{'internal.authtype'} = $args->{'authtype'};
16987: $cenv{'internal.autharg'} = $args->{'autharg'};
16988: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
16989: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 16990: 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');
16991: if ($context eq 'auto') {
16992: $outcome .= $krb_msg;
16993: } else {
1.566 albertel 16994: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 16995: }
16996: $outcome .= $linefeed;
1.444 albertel 16997: }
16998: }
16999: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
17000: if ($args->{'setpolicy'}) {
17001: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17002: }
17003: if ($args->{'setcontent'}) {
17004: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17005: }
1.1251 raeburn 17006: if ($args->{'setcomment'}) {
17007: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
17008: }
1.444 albertel 17009: }
17010: if ($args->{'reshome'}) {
17011: $cenv{'reshome'}=$args->{'reshome'}.'/';
17012: $cenv{'reshome'}=~s/\/+$/\//;
17013: }
17014: #
17015: # course has keyed access
17016: #
17017: if ($args->{'setkeys'}) {
17018: $cenv{'keyaccess'}='yes';
17019: }
17020: # if specified, key authority is not course, but user
17021: # only active if keyaccess is yes
17022: if ($args->{'keyauth'}) {
1.487 albertel 17023: my ($user,$domain) = split(':',$args->{'keyauth'});
17024: $user = &LONCAPA::clean_username($user);
17025: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 17026: if ($user ne '' && $domain ne '') {
1.487 albertel 17027: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 17028: }
17029: }
17030:
1.1166 raeburn 17031: #
1.1167 raeburn 17032: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 17033: #
17034: if ($args->{'uniquecode'}) {
17035: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
17036: if ($code) {
17037: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 17038: my %crsinfo =
17039: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
17040: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
17041: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
17042: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
17043: }
1.1166 raeburn 17044: if (ref($coderef)) {
17045: $$coderef = $code;
17046: }
17047: }
17048: }
17049:
1.444 albertel 17050: if ($args->{'disresdis'}) {
17051: $cenv{'pch.roles.denied'}='st';
17052: }
17053: if ($args->{'disablechat'}) {
17054: $cenv{'plc.roles.denied'}='st';
17055: }
17056:
17057: # Record we've not yet viewed the Course Initialization Helper for this
17058: # course
17059: $cenv{'course.helper.not.run'} = 1;
17060: #
17061: # Use new Randomseed
17062: #
17063: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
17064: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
17065: #
17066: # The encryption code and receipt prefix for this course
17067: #
17068: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
17069: $cenv{'internal.encpref'}=100+int(9*rand(99));
17070: #
17071: # By default, use standard grading
17072: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
17073:
1.541 raeburn 17074: $outcome .= $linefeed.&mt('Setting environment').': '.
17075: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 17076: #
17077: # Open all assignments
17078: #
17079: if ($args->{'openall'}) {
1.1341 raeburn 17080: my $opendate = time;
17081: if ($args->{'openallfrom'} =~ /^\d+$/) {
17082: $opendate = $args->{'openallfrom'};
17083: }
1.444 albertel 17084: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1341 raeburn 17085: my %storecontent = ($storeunder => $opendate,
1.444 albertel 17086: $storeunder.'.type' => 'date_start');
1.1341 raeburn 17087: $outcome .= &mt('All assignments open starting [_1]',
17088: &Apache::lonlocal::locallocaltime($opendate)).': '.
17089: &Apache::lonnet::cput
17090: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 17091: }
17092: #
17093: # Set first page
17094: #
17095: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
17096: || ($cloneid)) {
17097: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 17098:
17099: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
17100: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
17101:
1.444 albertel 17102: $outcome .= ($fatal?$errtext:'read ok').' - ';
17103: my $title; my $url;
17104: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 17105: $title=&mt('Syllabus');
1.444 albertel 17106: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
17107: } else {
1.963 raeburn 17108: $title=&mt('Table of Contents');
1.444 albertel 17109: $url='/adm/navmaps';
17110: }
1.445 albertel 17111:
17112: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
17113: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
17114:
17115: if ($errtext) { $fatal=2; }
1.541 raeburn 17116: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 17117: }
1.566 albertel 17118:
1.1237 raeburn 17119: #
17120: # Set params for Placement Tests
17121: #
1.1239 raeburn 17122: if ($args->{'crstype'} eq 'Placement') {
17123: my %storecontent;
17124: my $prefix=$$crsudom.'_'.$$crsunum.'.0.';
17125: my %defaults = (
17126: buttonshide => { value => 'yes',
17127: type => 'string_yesno',},
17128: type => { value => 'randomizetry',
17129: type => 'string_questiontype',},
17130: maxtries => { value => 1,
17131: type => 'int_pos',},
17132: problemstatus => { value => 'no',
17133: type => 'string_problemstatus',},
17134: );
17135: foreach my $key (keys(%defaults)) {
17136: $storecontent{$prefix.$key} = $defaults{$key}{'value'};
17137: $storecontent{$prefix.$key.'.type'} = $defaults{$key}{'type'};
17138: }
1.1237 raeburn 17139: &Apache::lonnet::cput
17140: ('resourcedata',\%storecontent,$$crsudom,$$crsunum);
17141: }
17142:
1.1344 raeburn 17143: return (1,$outcome,\@clonemsg);
1.444 albertel 17144: }
17145:
1.1166 raeburn 17146: sub make_unique_code {
17147: my ($cdom,$cnum) = @_;
17148: # get lock on uniquecodes db
17149: my $lockhash = {
17150: $cnum."\0".'uniquecodes' => $env{'user.name'}.
17151: ':'.$env{'user.domain'},
17152: };
17153: my $tries = 0;
17154: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17155: my ($code,$error);
17156:
17157: while (($gotlock ne 'ok') && ($tries<3)) {
17158: $tries ++;
17159: sleep 1;
17160: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17161: }
17162: if ($gotlock eq 'ok') {
17163: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
17164: my $gotcode;
17165: my $attempts = 0;
17166: while ((!$gotcode) && ($attempts < 100)) {
17167: $code = &generate_code();
17168: if (!exists($currcodes{$code})) {
17169: $gotcode = 1;
17170: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
17171: $error = 'nostore';
17172: }
17173: }
17174: $attempts ++;
17175: }
17176: my @del_lock = ($cnum."\0".'uniquecodes');
17177: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
17178: } else {
17179: $error = 'nolock';
17180: }
17181: return ($code,$error);
17182: }
17183:
17184: sub generate_code {
17185: my $code;
17186: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
17187: for (my $i=0; $i<6; $i++) {
17188: my $lettnum = int (rand 2);
17189: my $item = '';
17190: if ($lettnum) {
17191: $item = $letts[int( rand(18) )];
17192: } else {
17193: $item = 1+int( rand(8) );
17194: }
17195: $code .= $item;
17196: }
17197: return $code;
17198: }
17199:
1.444 albertel 17200: ############################################################
17201: ############################################################
17202:
1.1237 raeburn 17203: # Community, Course and Placement Test
1.378 raeburn 17204: sub course_type {
17205: my ($cid) = @_;
17206: if (!defined($cid)) {
17207: $cid = $env{'request.course.id'};
17208: }
1.404 albertel 17209: if (defined($env{'course.'.$cid.'.type'})) {
17210: return $env{'course.'.$cid.'.type'};
1.378 raeburn 17211: } else {
17212: return 'Course';
1.377 raeburn 17213: }
17214: }
1.156 albertel 17215:
1.406 raeburn 17216: sub group_term {
17217: my $crstype = &course_type();
17218: my %names = (
17219: 'Course' => 'group',
1.865 raeburn 17220: 'Community' => 'group',
1.1237 raeburn 17221: 'Placement' => 'group',
1.406 raeburn 17222: );
17223: return $names{$crstype};
17224: }
17225:
1.902 raeburn 17226: sub course_types {
1.1310 raeburn 17227: my @types = ('official','unofficial','community','textbook','placement','lti');
1.902 raeburn 17228: my %typename = (
17229: official => 'Official course',
17230: unofficial => 'Unofficial course',
17231: community => 'Community',
1.1165 raeburn 17232: textbook => 'Textbook course',
1.1237 raeburn 17233: placement => 'Placement test',
1.1310 raeburn 17234: lti => 'LTI provider',
1.902 raeburn 17235: );
17236: return (\@types,\%typename);
17237: }
17238:
1.156 albertel 17239: sub icon {
17240: my ($file)=@_;
1.505 albertel 17241: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 17242: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 17243: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 17244: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
17245: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
17246: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17247: $curfext.".gif") {
17248: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17249: $curfext.".gif";
17250: }
17251: }
1.249 albertel 17252: return &lonhttpdurl($iconname);
1.154 albertel 17253: }
1.84 albertel 17254:
1.575 albertel 17255: sub lonhttpdurl {
1.692 www 17256: #
17257: # Had been used for "small fry" static images on separate port 8080.
17258: # Modify here if lightweight http functionality desired again.
17259: # Currently eliminated due to increasing firewall issues.
17260: #
1.575 albertel 17261: my ($url)=@_;
1.692 www 17262: return $url;
1.215 albertel 17263: }
17264:
1.213 albertel 17265: sub connection_aborted {
17266: my ($r)=@_;
17267: $r->print(" ");$r->rflush();
17268: my $c = $r->connection;
17269: return $c->aborted();
17270: }
17271:
1.221 foxr 17272: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 17273: # strings as 'strings'.
17274: sub escape_single {
1.221 foxr 17275: my ($input) = @_;
1.223 albertel 17276: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 17277: $input =~ s/\'/\\\'/g; # Esacpe the 's....
17278: return $input;
17279: }
1.223 albertel 17280:
1.222 foxr 17281: # Same as escape_single, but escape's "'s This
17282: # can be used for "strings"
17283: sub escape_double {
17284: my ($input) = @_;
17285: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
17286: $input =~ s/\"/\\\"/g; # Esacpe the "s....
17287: return $input;
17288: }
1.223 albertel 17289:
1.222 foxr 17290: # Escapes the last element of a full URL.
17291: sub escape_url {
17292: my ($url) = @_;
1.238 raeburn 17293: my @urlslices = split(/\//, $url,-1);
1.369 www 17294: my $lastitem = &escape(pop(@urlslices));
1.1203 raeburn 17295: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 17296: }
1.462 albertel 17297:
1.820 raeburn 17298: sub compare_arrays {
17299: my ($arrayref1,$arrayref2) = @_;
17300: my (@difference,%count);
17301: @difference = ();
17302: %count = ();
17303: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
17304: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
17305: foreach my $element (keys(%count)) {
17306: if ($count{$element} == 1) {
17307: push(@difference,$element);
17308: }
17309: }
17310: }
17311: return @difference;
17312: }
17313:
1.1322 raeburn 17314: sub lon_status_items {
17315: my %defaults = (
17316: E => 100,
17317: W => 4,
17318: N => 1,
1.1324 raeburn 17319: U => 5,
1.1322 raeburn 17320: threshold => 200,
17321: sysmail => 2500,
17322: );
17323: my %names = (
17324: E => 'Errors',
17325: W => 'Warnings',
17326: N => 'Notices',
1.1324 raeburn 17327: U => 'Unsent',
1.1322 raeburn 17328: );
17329: return (\%defaults,\%names);
17330: }
17331:
1.817 bisitz 17332: # -------------------------------------------------------- Initialize user login
1.462 albertel 17333: sub init_user_environment {
1.463 albertel 17334: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 17335: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
17336:
17337: my $public=($username eq 'public' && $domain eq 'public');
17338:
1.1062 raeburn 17339: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 17340: my $now=time;
17341:
17342: if ($public) {
17343: my $max_public=100;
17344: my $oldest;
17345: my $oldest_time=0;
17346: for(my $next=1;$next<=$max_public;$next++) {
17347: if (-e $lonids."/publicuser_$next.id") {
17348: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
17349: if ($mtime<$oldest_time || !$oldest_time) {
17350: $oldest_time=$mtime;
17351: $oldest=$next;
17352: }
17353: } else {
17354: $cookie="publicuser_$next";
17355: last;
17356: }
17357: }
17358: if (!$cookie) { $cookie="publicuser_$oldest"; }
17359: } else {
1.1275 raeburn 17360: # See if old ID present, if so, remove if this isn't a robot,
17361: # killing any existing non-robot sessions
1.463 albertel 17362: if (!$args->{'robot'}) {
17363: opendir(DIR,$lonids);
17364: while ($filename=readdir(DIR)) {
17365: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1320 raeburn 17366: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
17367: &GDBM_READER(),0640)) {
1.1295 raeburn 17368: my $linkedfile;
1.1320 raeburn 17369: if (exists($oldenv{'user.linkedenv'})) {
17370: $linkedfile = $oldenv{'user.linkedenv'};
1.1295 raeburn 17371: }
1.1320 raeburn 17372: untie(%oldenv);
17373: if (unlink("$lonids/$filename")) {
17374: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
17375: if (-l "$lonids/$linkedfile.id") {
17376: unlink("$lonids/$linkedfile.id");
17377: }
1.1295 raeburn 17378: }
17379: }
17380: } else {
17381: unlink($lonids.'/'.$filename);
17382: }
1.463 albertel 17383: }
1.462 albertel 17384: }
1.463 albertel 17385: closedir(DIR);
1.1204 raeburn 17386: # If there is a undeleted lockfile for the user's paste buffer remove it.
17387: my $namespace = 'nohist_courseeditor';
17388: my $lockingkey = 'paste'."\0".'locked_num';
17389: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
17390: $domain,$username);
17391: if (exists($lockhash{$lockingkey})) {
17392: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
17393: unless ($delresult eq 'ok') {
17394: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
17395: }
17396: }
1.462 albertel 17397: }
17398: # Give them a new cookie
1.463 albertel 17399: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 17400: : $now.$$.int(rand(10000)));
1.463 albertel 17401: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 17402:
17403: # Initialize roles
17404:
1.1062 raeburn 17405: ($userroles,$firstaccenv,$timerintenv) =
17406: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 17407: }
17408: # ------------------------------------ Check browser type and MathML capability
17409:
1.1194 raeburn 17410: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
17411: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 17412:
17413: # ------------------------------------------------------------- Get environment
17414:
17415: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
17416: my ($tmp) = keys(%userenv);
1.1275 raeburn 17417: if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
1.462 albertel 17418: undef(%userenv);
17419: }
17420: if (($userenv{'interface'}) && (!$form->{'interface'})) {
17421: $form->{'interface'}=$userenv{'interface'};
17422: }
17423: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
17424:
17425: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 17426: foreach my $option ('interface','localpath','localres') {
17427: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 17428: }
17429: # --------------------------------------------------------- Write first profile
17430:
17431: {
1.1350 raeburn 17432: my $ip = &Apache::lonnet::get_requestor_ip($r);
1.462 albertel 17433: my %initial_env =
17434: ("user.name" => $username,
17435: "user.domain" => $domain,
17436: "user.home" => $authhost,
17437: "browser.type" => $clientbrowser,
17438: "browser.version" => $clientversion,
17439: "browser.mathml" => $clientmathml,
17440: "browser.unicode" => $clientunicode,
17441: "browser.os" => $clientos,
1.1137 raeburn 17442: "browser.mobile" => $clientmobile,
1.1141 raeburn 17443: "browser.info" => $clientinfo,
1.1194 raeburn 17444: "browser.osversion" => $clientosversion,
1.462 albertel 17445: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
17446: "request.course.fn" => '',
17447: "request.course.uri" => '',
17448: "request.course.sec" => '',
17449: "request.role" => 'cm',
17450: "request.role.adv" => $env{'user.adv'},
1.1350 raeburn 17451: "request.host" => $ip,);
1.462 albertel 17452:
17453: if ($form->{'localpath'}) {
17454: $initial_env{"browser.localpath"} = $form->{'localpath'};
17455: $initial_env{"browser.localres"} = $form->{'localres'};
17456: }
17457:
17458: if ($form->{'interface'}) {
17459: $form->{'interface'}=~s/\W//gs;
17460: $initial_env{"browser.interface"} = $form->{'interface'};
17461: $env{'browser.interface'}=$form->{'interface'};
17462: }
17463:
1.1157 raeburn 17464: if ($form->{'iptoken'}) {
17465: my $lonhost = $r->dir_config('lonHostID');
17466: $initial_env{"user.noloadbalance"} = $lonhost;
17467: $env{'user.noloadbalance'} = $lonhost;
17468: }
17469:
1.1268 raeburn 17470: if ($form->{'noloadbalance'}) {
17471: my @hosts = &Apache::lonnet::current_machine_ids();
17472: my $hosthere = $form->{'noloadbalance'};
17473: if (grep(/^\Q$hosthere\E$/,@hosts)) {
17474: $initial_env{"user.noloadbalance"} = $hosthere;
17475: $env{'user.noloadbalance'} = $hosthere;
17476: }
17477: }
17478:
1.1016 raeburn 17479: unless ($domain eq 'public') {
1.1273 raeburn 17480: my %is_adv = ( is_adv => $env{'user.adv'} );
17481: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
17482:
1.1387 raeburn 17483: foreach my $tool ('aboutme','blog','webdav','portfolio','timezone') {
1.1273 raeburn 17484: $userenv{'availabletools.'.$tool} =
17485: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
17486: undef,\%userenv,\%domdef,\%is_adv);
17487: }
1.980 raeburn 17488:
1.1311 raeburn 17489: foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
1.1273 raeburn 17490: $userenv{'canrequest.'.$crstype} =
17491: &Apache::lonnet::usertools_access($username,$domain,$crstype,
17492: 'reload','requestcourses',
17493: \%userenv,\%domdef,\%is_adv);
17494: }
1.724 raeburn 17495:
1.1273 raeburn 17496: $userenv{'canrequest.author'} =
17497: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
17498: 'reload','requestauthor',
1.980 raeburn 17499: \%userenv,\%domdef,\%is_adv);
1.1273 raeburn 17500: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
17501: $domain,$username);
17502: my $reqstatus = $reqauthor{'author_status'};
17503: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
17504: if (ref($reqauthor{'author'}) eq 'HASH') {
17505: $userenv{'requestauthorqueued'} = $reqstatus.':'.
17506: $reqauthor{'author'}{'timestamp'};
17507: }
1.1092 raeburn 17508: }
1.1287 raeburn 17509: my ($types,$typename) = &course_types();
17510: if (ref($types) eq 'ARRAY') {
17511: my @options = ('approval','validate','autolimit');
17512: my $optregex = join('|',@options);
17513: my (%willtrust,%trustchecked);
17514: foreach my $type (@{$types}) {
17515: my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
17516: if ($dom_str ne '') {
17517: my $updatedstr = '';
17518: my @possdomains = split(',',$dom_str);
17519: foreach my $entry (@possdomains) {
17520: my ($extdom,$extopt) = split(':',$entry);
17521: unless ($trustchecked{$extdom}) {
17522: $willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
17523: $trustchecked{$extdom} = 1;
17524: }
17525: if ($willtrust{$extdom}) {
17526: $updatedstr .= $entry.',';
17527: }
17528: }
17529: $updatedstr =~ s/,$//;
17530: if ($updatedstr) {
17531: $userenv{'reqcrsotherdom.'.$type} = $updatedstr;
17532: } else {
17533: delete($userenv{'reqcrsotherdom.'.$type});
17534: }
17535: }
17536: }
17537: }
1.1092 raeburn 17538: }
1.462 albertel 17539: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 17540:
1.462 albertel 17541: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
17542: &GDBM_WRCREAT(),0640)) {
17543: &_add_to_env(\%disk_env,\%initial_env);
17544: &_add_to_env(\%disk_env,\%userenv,'environment.');
17545: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 17546: if (ref($firstaccenv) eq 'HASH') {
17547: &_add_to_env(\%disk_env,$firstaccenv);
17548: }
17549: if (ref($timerintenv) eq 'HASH') {
17550: &_add_to_env(\%disk_env,$timerintenv);
17551: }
1.463 albertel 17552: if (ref($args->{'extra_env'})) {
17553: &_add_to_env(\%disk_env,$args->{'extra_env'});
17554: }
1.462 albertel 17555: untie(%disk_env);
17556: } else {
1.705 tempelho 17557: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
17558: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 17559: return 'error: '.$!;
17560: }
17561: }
17562: $env{'request.role'}='cm';
17563: $env{'request.role.adv'}=$env{'user.adv'};
17564: $env{'browser.type'}=$clientbrowser;
17565:
17566: return $cookie;
17567:
17568: }
17569:
17570: sub _add_to_env {
17571: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 17572: if (ref($env_data) eq 'HASH') {
17573: while (my ($key,$value) = each(%$env_data)) {
17574: $idf->{$prefix.$key} = $value;
17575: $env{$prefix.$key} = $value;
17576: }
1.462 albertel 17577: }
17578: }
17579:
1.685 tempelho 17580: # --- Get the symbolic name of a problem and the url
17581: sub get_symb {
17582: my ($request,$silent) = @_;
1.726 raeburn 17583: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 17584: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
17585: if ($symb eq '') {
17586: if (!$silent) {
1.1071 raeburn 17587: if (ref($request)) {
17588: $request->print("Unable to handle ambiguous references:$url:.");
17589: }
1.685 tempelho 17590: return ();
17591: }
17592: }
17593: &Apache::lonenc::check_decrypt(\$symb);
17594: return ($symb);
17595: }
17596:
17597: # --------------------------------------------------------------Get annotation
17598:
17599: sub get_annotation {
17600: my ($symb,$enc) = @_;
17601:
17602: my $key = $symb;
17603: if (!$enc) {
17604: $key =
17605: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
17606: }
17607: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
17608: return $annotation{$key};
17609: }
17610:
17611: sub clean_symb {
1.731 raeburn 17612: my ($symb,$delete_enc) = @_;
1.685 tempelho 17613:
17614: &Apache::lonenc::check_decrypt(\$symb);
17615: my $enc = $env{'request.enc'};
1.731 raeburn 17616: if ($delete_enc) {
1.730 raeburn 17617: delete($env{'request.enc'});
17618: }
1.685 tempelho 17619:
17620: return ($symb,$enc);
17621: }
1.462 albertel 17622:
1.1181 raeburn 17623: ############################################################
17624: ############################################################
17625:
17626: =pod
17627:
17628: =head1 Routines for building display used to search for courses
17629:
17630:
17631: =over 4
17632:
17633: =item * &build_filters()
17634:
17635: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 17636: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
17637: and quotacheck.pl
17638:
1.1181 raeburn 17639:
17640: Inputs:
17641:
17642: filterlist - anonymous array of fields to include as potential filters
17643:
17644: crstype - course type
17645:
17646: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
17647: to pop-open a course selector (will contain "extra element").
17648:
17649: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
17650:
17651: filter - anonymous hash of criteria and their values
17652:
17653: action - form action
17654:
17655: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
17656:
1.1182 raeburn 17657: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 17658:
17659: cloneruname - username of owner of new course who wants to clone
17660:
17661: clonerudom - domain of owner of new course who wants to clone
17662:
17663: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
17664:
17665: codetitlesref - reference to array of titles of components in institutional codes (official courses)
17666:
17667: codedom - domain
17668:
17669: formname - value of form element named "form".
17670:
17671: fixeddom - domain, if fixed.
17672:
17673: prevphase - value to assign to form element named "phase" when going back to the previous screen
17674:
17675: cnameelement - name of form element in form on opener page which will receive title of selected course
17676:
17677: cnumelement - name of form element in form on opener page which will receive courseID of selected course
17678:
17679: cdomelement - name of form element in form on opener page which will receive domain of selected course
17680:
17681: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
17682:
17683: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
17684:
17685: clonewarning - warning message about missing information for intended course owner when DC creates a course
17686:
1.1182 raeburn 17687:
1.1181 raeburn 17688: Returns: $output - HTML for display of search criteria, and hidden form elements.
17689:
1.1182 raeburn 17690:
1.1181 raeburn 17691: Side Effects: None
17692:
17693: =cut
17694:
17695: # ---------------------------------------------- search for courses based on last activity etc.
17696:
17697: sub build_filters {
17698: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
17699: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
17700: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
17701: $cnameelement,$cnumelement,$cdomelement,$setroles,
17702: $clonetext,$clonewarning) = @_;
1.1182 raeburn 17703: my ($list,$jscript);
1.1181 raeburn 17704: my $onchange = 'javascript:updateFilters(this)';
17705: my ($domainselectform,$sincefilterform,$createdfilterform,
17706: $ownerdomselectform,$persondomselectform,$instcodeform,
17707: $typeselectform,$instcodetitle);
17708: if ($formname eq '') {
17709: $formname = $caller;
17710: }
17711: foreach my $item (@{$filterlist}) {
17712: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
17713: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
17714: if ($item eq 'domainfilter') {
17715: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
17716: } elsif ($item eq 'coursefilter') {
17717: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
17718: } elsif ($item eq 'ownerfilter') {
17719: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17720: } elsif ($item eq 'ownerdomfilter') {
17721: $filter->{'ownerdomfilter'} =
17722: &LONCAPA::clean_domain($filter->{$item});
17723: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
17724: 'ownerdomfilter',1);
17725: } elsif ($item eq 'personfilter') {
17726: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17727: } elsif ($item eq 'persondomfilter') {
17728: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
17729: 'persondomfilter',1);
17730: } else {
17731: $filter->{$item} =~ s/\W//g;
17732: }
17733: if (!$filter->{$item}) {
17734: $filter->{$item} = '';
17735: }
17736: }
17737: if ($item eq 'domainfilter') {
17738: my $allow_blank = 1;
17739: if ($formname eq 'portform') {
17740: $allow_blank=0;
17741: } elsif ($formname eq 'studentform') {
17742: $allow_blank=0;
17743: }
17744: if ($fixeddom) {
17745: $domainselectform = '<input type="hidden" name="domainfilter"'.
17746: ' value="'.$codedom.'" />'.
17747: &Apache::lonnet::domain($codedom,'description');
17748: } else {
17749: $domainselectform = &select_dom_form($filter->{$item},
17750: 'domainfilter',
17751: $allow_blank,'',$onchange);
17752: }
17753: } else {
17754: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
17755: }
17756: }
17757:
17758: # last course activity filter and selection
17759: $sincefilterform = &timebased_select_form('sincefilter',$filter);
17760:
17761: # course created filter and selection
17762: if (exists($filter->{'createdfilter'})) {
17763: $createdfilterform = &timebased_select_form('createdfilter',$filter);
17764: }
17765:
1.1239 raeburn 17766: my $prefix = $crstype;
17767: if ($crstype eq 'Placement') {
17768: $prefix = 'Placement Test'
17769: }
1.1181 raeburn 17770: my %lt = &Apache::lonlocal::texthash(
1.1239 raeburn 17771: 'cac' => "$prefix Activity",
17772: 'ccr' => "$prefix Created",
17773: 'cde' => "$prefix Title",
17774: 'cdo' => "$prefix Domain",
1.1181 raeburn 17775: 'ins' => 'Institutional Code',
17776: 'inc' => 'Institutional Categorization',
1.1239 raeburn 17777: 'cow' => "$prefix Owner/Co-owner",
17778: 'cop' => "$prefix Personnel Includes",
1.1181 raeburn 17779: 'cog' => 'Type',
17780: );
17781:
17782: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17783: my $typeval = 'Course';
17784: if ($crstype eq 'Community') {
17785: $typeval = 'Community';
1.1239 raeburn 17786: } elsif ($crstype eq 'Placement') {
17787: $typeval = 'Placement';
1.1181 raeburn 17788: }
17789: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
17790: } else {
17791: $typeselectform = '<select name="type" size="1"';
17792: if ($onchange) {
17793: $typeselectform .= ' onchange="'.$onchange.'"';
17794: }
17795: $typeselectform .= '>'."\n";
1.1237 raeburn 17796: foreach my $posstype ('Course','Community','Placement') {
1.1239 raeburn 17797: my $shown;
17798: if ($posstype eq 'Placement') {
17799: $shown = &mt('Placement Test');
17800: } else {
17801: $shown = &mt($posstype);
17802: }
1.1181 raeburn 17803: $typeselectform.='<option value="'.$posstype.'"'.
1.1239 raeburn 17804: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".$shown."</option>\n";
1.1181 raeburn 17805: }
17806: $typeselectform.="</select>";
17807: }
17808:
17809: my ($cloneableonlyform,$cloneabletitle);
17810: if (exists($filter->{'cloneableonly'})) {
17811: my $cloneableon = '';
17812: my $cloneableoff = ' checked="checked"';
17813: if ($filter->{'cloneableonly'}) {
17814: $cloneableon = $cloneableoff;
17815: $cloneableoff = '';
17816: }
17817: $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>';
17818: if ($formname eq 'ccrs') {
1.1187 bisitz 17819: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 17820: } else {
17821: $cloneabletitle = &mt('Cloneable by you');
17822: }
17823: }
17824: my $officialjs;
17825: if ($crstype eq 'Course') {
17826: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 17827: # if (($fixeddom) || ($formname eq 'requestcrs') ||
17828: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
17829: if ($codedom) {
1.1181 raeburn 17830: $officialjs = 1;
17831: ($instcodeform,$jscript,$$numtitlesref) =
17832: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
17833: $officialjs,$codetitlesref);
17834: if ($jscript) {
1.1182 raeburn 17835: $jscript = '<script type="text/javascript">'."\n".
17836: '// <![CDATA['."\n".
17837: $jscript."\n".
17838: '// ]]>'."\n".
17839: '</script>'."\n";
1.1181 raeburn 17840: }
17841: }
17842: if ($instcodeform eq '') {
17843: $instcodeform =
17844: '<input type="text" name="instcodefilter" size="10" value="'.
17845: $list->{'instcodefilter'}.'" />';
17846: $instcodetitle = $lt{'ins'};
17847: } else {
17848: $instcodetitle = $lt{'inc'};
17849: }
17850: if ($fixeddom) {
17851: $instcodetitle .= '<br />('.$codedom.')';
17852: }
17853: }
17854: }
17855: my $output = qq|
17856: <form method="post" name="filterpicker" action="$action">
17857: <input type="hidden" name="form" value="$formname" />
17858: |;
17859: if ($formname eq 'modifycourse') {
17860: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
17861: '<input type="hidden" name="prevphase" value="'.
17862: $prevphase.'" />'."\n";
1.1198 musolffc 17863: } elsif ($formname eq 'quotacheck') {
17864: $output .= qq|
17865: <input type="hidden" name="sortby" value="" />
17866: <input type="hidden" name="sortorder" value="" />
17867: |;
17868: } else {
1.1181 raeburn 17869: my $name_input;
17870: if ($cnameelement ne '') {
17871: $name_input = '<input type="hidden" name="cnameelement" value="'.
17872: $cnameelement.'" />';
17873: }
17874: $output .= qq|
1.1182 raeburn 17875: <input type="hidden" name="cnumelement" value="$cnumelement" />
17876: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 17877: $name_input
17878: $roleelement
17879: $multelement
17880: $typeelement
17881: |;
17882: if ($formname eq 'portform') {
17883: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
17884: }
17885: }
17886: if ($fixeddom) {
17887: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
17888: }
17889: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
17890: if ($sincefilterform) {
17891: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
17892: .$sincefilterform
17893: .&Apache::lonhtmlcommon::row_closure();
17894: }
17895: if ($createdfilterform) {
17896: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
17897: .$createdfilterform
17898: .&Apache::lonhtmlcommon::row_closure();
17899: }
17900: if ($domainselectform) {
17901: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
17902: .$domainselectform
17903: .&Apache::lonhtmlcommon::row_closure();
17904: }
17905: if ($typeselectform) {
17906: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17907: $output .= $typeselectform;
17908: } else {
17909: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
17910: .$typeselectform
17911: .&Apache::lonhtmlcommon::row_closure();
17912: }
17913: }
17914: if ($instcodeform) {
17915: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
17916: .$instcodeform
17917: .&Apache::lonhtmlcommon::row_closure();
17918: }
17919: if (exists($filter->{'ownerfilter'})) {
17920: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
17921: '<table><tr><td>'.&mt('Username').'<br />'.
17922: '<input type="text" name="ownerfilter" size="20" value="'.
17923: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17924: $ownerdomselectform.'</td></tr></table>'.
17925: &Apache::lonhtmlcommon::row_closure();
17926: }
17927: if (exists($filter->{'personfilter'})) {
17928: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
17929: '<table><tr><td>'.&mt('Username').'<br />'.
17930: '<input type="text" name="personfilter" size="20" value="'.
17931: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17932: $persondomselectform.'</td></tr></table>'.
17933: &Apache::lonhtmlcommon::row_closure();
17934: }
17935: if (exists($filter->{'coursefilter'})) {
17936: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
17937: .'<input type="text" name="coursefilter" size="25" value="'
17938: .$list->{'coursefilter'}.'" />'
17939: .&Apache::lonhtmlcommon::row_closure();
17940: }
17941: if ($cloneableonlyform) {
17942: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
17943: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
17944: }
17945: if (exists($filter->{'descriptfilter'})) {
17946: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
17947: .'<input type="text" name="descriptfilter" size="40" value="'
17948: .$list->{'descriptfilter'}.'" />'
17949: .&Apache::lonhtmlcommon::row_closure(1);
17950: }
17951: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
17952: '<input type="hidden" name="updater" value="" />'."\n".
17953: '<input type="submit" name="gosearch" value="'.
17954: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
17955: return $jscript.$clonewarning.$output;
17956: }
17957:
17958: =pod
17959:
17960: =item * &timebased_select_form()
17961:
1.1182 raeburn 17962: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 17963: filter e.g., Course Activity, Course Created, when searching for courses
17964: or communities
17965:
17966: Inputs:
17967:
17968: item - name of form element (sincefilter or createdfilter)
17969:
17970: filter - anonymous hash of criteria and their values
17971:
17972: Returns: HTML for a select box contained a blank, then six time selections,
17973: with value set in incoming form variables currently selected.
17974:
17975: Side Effects: None
17976:
17977: =cut
17978:
17979: sub timebased_select_form {
17980: my ($item,$filter) = @_;
17981: if (ref($filter) eq 'HASH') {
17982: $filter->{$item} =~ s/[^\d-]//g;
17983: if (!$filter->{$item}) { $filter->{$item}=-1; }
17984: return &select_form(
17985: $filter->{$item},
17986: $item,
17987: { '-1' => '',
17988: '86400' => &mt('today'),
17989: '604800' => &mt('last week'),
17990: '2592000' => &mt('last month'),
17991: '7776000' => &mt('last three months'),
17992: '15552000' => &mt('last six months'),
17993: '31104000' => &mt('last year'),
17994: 'select_form_order' =>
17995: ['-1','86400','604800','2592000','7776000',
17996: '15552000','31104000']});
17997: }
17998: }
17999:
18000: =pod
18001:
18002: =item * &js_changer()
18003:
18004: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 18005: when course type or domain is changed, and also to hide 'Searching ...' on
18006: page load completion for page showing search result.
1.1181 raeburn 18007:
18008: Inputs: None
18009:
1.1183 raeburn 18010: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 18011:
18012: Side Effects: None
18013:
18014: =cut
18015:
18016: sub js_changer {
18017: return <<ENDJS;
18018: <script type="text/javascript">
18019: // <![CDATA[
18020: function updateFilters(caller) {
18021: if (typeof(caller) != "undefined") {
18022: document.filterpicker.updater.value = caller.name;
18023: }
18024: document.filterpicker.submit();
18025: }
1.1183 raeburn 18026:
18027: function hideSearching() {
18028: if (document.getElementById('searching')) {
18029: document.getElementById('searching').style.display = 'none';
18030: }
18031: return;
18032: }
18033:
1.1181 raeburn 18034: // ]]>
18035: </script>
18036:
18037: ENDJS
18038: }
18039:
18040: =pod
18041:
1.1182 raeburn 18042: =item * &search_courses()
18043:
18044: Process selected filters form course search form and pass to lonnet::courseiddump
18045: to retrieve a hash for which keys are courseIDs which match the selected filters.
18046:
18047: Inputs:
18048:
18049: dom - domain being searched
18050:
18051: type - course type ('Course' or 'Community' or '.' if any).
18052:
18053: filter - anonymous hash of criteria and their values
18054:
18055: numtitles - for institutional codes - number of categories
18056:
18057: cloneruname - optional username of new course owner
18058:
18059: clonerudom - optional domain of new course owner
18060:
1.1221 raeburn 18061: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1182 raeburn 18062: (used when DC is using course creation form)
18063:
18064: codetitles - reference to array of titles of components in institutional codes (official courses).
18065:
1.1221 raeburn 18066: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
18067: (and so can clone automatically)
18068:
18069: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
18070:
18071: reqinstcode - institutional code of new course, where search_courses is used to identify potential
18072: courses to clone
1.1182 raeburn 18073:
18074: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
18075:
18076:
18077: Side Effects: None
18078:
18079: =cut
18080:
18081:
18082: sub search_courses {
1.1221 raeburn 18083: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
18084: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1182 raeburn 18085: my (%courses,%showcourses,$cloner);
18086: if (($filter->{'ownerfilter'} ne '') ||
18087: ($filter->{'ownerdomfilter'} ne '')) {
18088: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
18089: $filter->{'ownerdomfilter'};
18090: }
18091: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
18092: if (!$filter->{$item}) {
18093: $filter->{$item}='.';
18094: }
18095: }
18096: my $now = time;
18097: my $timefilter =
18098: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
18099: my ($createdbefore,$createdafter);
18100: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
18101: $createdbefore = $now;
18102: $createdafter = $now-$filter->{'createdfilter'};
18103: }
18104: my ($instcodefilter,$regexpok);
18105: if ($numtitles) {
18106: if ($env{'form.official'} eq 'on') {
18107: $instcodefilter =
18108: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
18109: $regexpok = 1;
18110: } elsif ($env{'form.official'} eq 'off') {
18111: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
18112: unless ($instcodefilter eq '') {
18113: $regexpok = -1;
18114: }
18115: }
18116: } else {
18117: $instcodefilter = $filter->{'instcodefilter'};
18118: }
18119: if ($instcodefilter eq '') { $instcodefilter = '.'; }
18120: if ($type eq '') { $type = '.'; }
18121:
18122: if (($clonerudom ne '') && ($cloneruname ne '')) {
18123: $cloner = $cloneruname.':'.$clonerudom;
18124: }
18125: %courses = &Apache::lonnet::courseiddump($dom,
18126: $filter->{'descriptfilter'},
18127: $timefilter,
18128: $instcodefilter,
18129: $filter->{'combownerfilter'},
18130: $filter->{'coursefilter'},
18131: undef,undef,$type,$regexpok,undef,undef,
1.1221 raeburn 18132: undef,undef,$cloner,$cc_clone,
1.1182 raeburn 18133: $filter->{'cloneableonly'},
18134: $createdbefore,$createdafter,undef,
1.1221 raeburn 18135: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1182 raeburn 18136: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
18137: my $ccrole;
18138: if ($type eq 'Community') {
18139: $ccrole = 'co';
18140: } else {
18141: $ccrole = 'cc';
18142: }
18143: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
18144: $filter->{'persondomfilter'},
18145: 'userroles',undef,
18146: [$ccrole,'in','ad','ep','ta','cr'],
18147: $dom);
18148: foreach my $role (keys(%rolehash)) {
18149: my ($cnum,$cdom,$courserole) = split(':',$role);
18150: my $cid = $cdom.'_'.$cnum;
18151: if (exists($courses{$cid})) {
18152: if (ref($courses{$cid}) eq 'HASH') {
18153: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
18154: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1263 raeburn 18155: push(@{$courses{$cid}{roles}},$courserole);
1.1182 raeburn 18156: }
18157: } else {
18158: $courses{$cid}{roles} = [$courserole];
18159: }
18160: $showcourses{$cid} = $courses{$cid};
18161: }
18162: }
18163: }
18164: %courses = %showcourses;
18165: }
18166: return %courses;
18167: }
18168:
18169: =pod
18170:
1.1181 raeburn 18171: =back
18172:
1.1207 raeburn 18173: =head1 Routines for version requirements for current course.
18174:
18175: =over 4
18176:
18177: =item * &check_release_required()
18178:
18179: Compares required LON-CAPA version with version on server, and
18180: if required version is newer looks for a server with the required version.
18181:
18182: Looks first at servers in user's owen domain; if none suitable, looks at
18183: servers in course's domain are permitted to host sessions for user's domain.
18184:
18185: Inputs:
18186:
18187: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18188:
18189: $courseid - Course ID of current course
18190:
18191: $rolecode - User's current role in course (for switchserver query string).
18192:
18193: $required - LON-CAPA version needed by course (format: Major.Minor).
18194:
18195:
18196: Returns:
18197:
18198: $switchserver - query string tp append to /adm/switchserver call (if
18199: current server's LON-CAPA version is too old.
18200:
18201: $warning - Message is displayed if no suitable server could be found.
18202:
18203: =cut
18204:
18205: sub check_release_required {
18206: my ($loncaparev,$courseid,$rolecode,$required) = @_;
18207: my ($switchserver,$warning);
18208: if ($required ne '') {
18209: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
18210: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18211: if ($reqdmajor ne '' && $reqdminor ne '') {
18212: my $otherserver;
18213: if (($major eq '' && $minor eq '') ||
18214: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
18215: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
18216: my $switchlcrev =
18217: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
18218: $userdomserver);
18219: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18220: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
18221: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
18222: my $cdom = $env{'course.'.$courseid.'.domain'};
18223: if ($cdom ne $env{'user.domain'}) {
18224: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
18225: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
18226: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
18227: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
18228: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
18229: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
18230: my $canhost =
18231: &Apache::lonnet::can_host_session($env{'user.domain'},
18232: $coursedomserver,
18233: $remoterev,
18234: $udomdefaults{'remotesessions'},
18235: $defdomdefaults{'hostedsessions'});
18236:
18237: if ($canhost) {
18238: $otherserver = $coursedomserver;
18239: } else {
18240: $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.");
18241: }
18242: } else {
18243: $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).");
18244: }
18245: } else {
18246: $otherserver = $userdomserver;
18247: }
18248: }
18249: if ($otherserver ne '') {
18250: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
18251: }
18252: }
18253: }
18254: return ($switchserver,$warning);
18255: }
18256:
18257: =pod
18258:
18259: =item * &check_release_result()
18260:
18261: Inputs:
18262:
18263: $switchwarning - Warning message if no suitable server found to host session.
18264:
18265: $switchserver - query string to append to /adm/switchserver containing lonHostID
18266: and current role.
18267:
18268: Returns: HTML to display with information about requirement to switch server.
18269: Either displaying warning with link to Roles/Courses screen or
18270: display link to switchserver.
18271:
1.1181 raeburn 18272: =cut
18273:
1.1207 raeburn 18274: sub check_release_result {
18275: my ($switchwarning,$switchserver) = @_;
18276: my $output = &start_page('Selected course unavailable on this server').
18277: '<p class="LC_warning">';
18278: if ($switchwarning) {
18279: $output .= $switchwarning.'<br /><a href="/adm/roles">';
18280: if (&show_course()) {
18281: $output .= &mt('Display courses');
18282: } else {
18283: $output .= &mt('Display roles');
18284: }
18285: $output .= '</a>';
18286: } elsif ($switchserver) {
18287: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
18288: '<br />'.
18289: '<a href="/adm/switchserver?'.$switchserver.'">'.
18290: &mt('Switch Server').
18291: '</a>';
18292: }
18293: $output .= '</p>'.&end_page();
18294: return $output;
18295: }
18296:
18297: =pod
18298:
18299: =item * &needs_coursereinit()
18300:
18301: Determine if course contents stored for user's session needs to be
18302: refreshed, because content has changed since "Big Hash" last tied.
18303:
18304: Check for change is made if time last checked is more than 10 minutes ago
18305: (by default).
18306:
18307: Inputs:
18308:
18309: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18310:
18311: $interval (optional) - Time which may elapse (in s) between last check for content
18312: change in current course. (default: 600 s).
18313:
18314: Returns: an array; first element is:
18315:
18316: =over 4
18317:
18318: 'switch' - if content updates mean user's session
18319: needs to be switched to a server running a newer LON-CAPA version
18320:
18321: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
18322: on current server hosting user's session
18323:
18324: '' - if no action required.
18325:
18326: =back
18327:
18328: If first item element is 'switch':
18329:
18330: second item is $switchwarning - Warning message if no suitable server found to host session.
18331:
18332: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
18333: and current role.
18334:
18335: otherwise: no other elements returned.
18336:
18337: =back
18338:
18339: =cut
18340:
18341: sub needs_coursereinit {
18342: my ($loncaparev,$interval) = @_;
18343: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
18344: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18345: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
18346: my $now = time;
18347: if ($interval eq '') {
18348: $interval = 600;
18349: }
18350: if (($now-$env{'request.course.timechecked'})>$interval) {
1.1282 raeburn 18351: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1372 raeburn 18352: my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 18353: if ($blocked) {
18354: return ();
18355: }
1.1391 raeburn 18356: my $update;
18357: my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
18358: my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
18359: if ($lastmainchange > $env{'request.course.tied'}) {
18360: my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
18361: if ($needswitch) {
18362: return ('switch',$switchwarning,$switchserver);
18363: }
18364: $update = 'main';
18365: }
18366: if ($lastsuppchange > $env{'request.course.suppupdated'}) {
18367: if ($update) {
18368: $update = 'both';
18369: } else {
18370: my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
18371: if ($needswitch) {
18372: return ('switch',$switchwarning,$switchserver);
18373: } else {
18374: $update = 'supp';
1.1207 raeburn 18375: }
18376: }
1.1391 raeburn 18377: return ($update);
18378: }
18379: }
18380: return ();
18381: }
18382:
18383: sub switch_for_update {
18384: my ($loncaparev,$cdom,$cnum) = @_;
18385: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18386: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
18387: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
18388: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
18389: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
18390: $curr_reqd_hash{'internal.releaserequired'}});
18391: my ($switchserver,$switchwarning) =
18392: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
18393: $curr_reqd_hash{'internal.releaserequired'});
18394: if ($switchwarning ne '' || $switchserver ne '') {
18395: return ('switch',$switchwarning,$switchserver);
18396: }
1.1207 raeburn 18397: }
18398: }
18399: return ();
18400: }
1.1181 raeburn 18401:
1.1083 raeburn 18402: sub update_content_constraints {
1.1395 raeburn 18403: my ($cdom,$cnum,$chome,$cid) = @_;
1.1083 raeburn 18404: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18405: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
1.1307 raeburn 18406: my (%checkresponsetypes,%checkcrsrestypes);
1.1083 raeburn 18407: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
1.1236 raeburn 18408: my ($item,$name,$value) = split(/:/,$key);
1.1083 raeburn 18409: if ($item eq 'resourcetag') {
18410: if ($name eq 'responsetype') {
18411: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
18412: }
1.1307 raeburn 18413: } elsif ($item eq 'course') {
18414: if ($name eq 'courserestype') {
18415: $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
18416: }
1.1083 raeburn 18417: }
18418: }
18419: my $navmap = Apache::lonnavmaps::navmap->new();
18420: if (defined($navmap)) {
1.1307 raeburn 18421: my (%allresponses,%allcrsrestypes);
18422: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) {
18423: if ($res->is_tool()) {
18424: if ($allcrsrestypes{'exttool'}) {
18425: $allcrsrestypes{'exttool'} ++;
18426: } else {
18427: $allcrsrestypes{'exttool'} = 1;
18428: }
18429: next;
18430: }
1.1083 raeburn 18431: my %responses = $res->responseTypes();
18432: foreach my $key (keys(%responses)) {
18433: next unless(exists($checkresponsetypes{$key}));
18434: $allresponses{$key} += $responses{$key};
18435: }
18436: }
18437: foreach my $key (keys(%allresponses)) {
18438: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
18439: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18440: ($reqdmajor,$reqdminor) = ($major,$minor);
18441: }
18442: }
1.1307 raeburn 18443: foreach my $key (keys(%allcrsrestypes)) {
1.1308 raeburn 18444: my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
1.1307 raeburn 18445: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18446: ($reqdmajor,$reqdminor) = ($major,$minor);
18447: }
18448: }
1.1083 raeburn 18449: undef($navmap);
18450: }
1.1391 raeburn 18451: if (&Apache::lonnet::count_supptools($cnum,$cdom,1)) {
1.1308 raeburn 18452: my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
18453: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18454: ($reqdmajor,$reqdminor) = ($major,$minor);
18455: }
18456: }
1.1083 raeburn 18457: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
18458: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
18459: }
18460: return;
18461: }
18462:
1.1110 raeburn 18463: sub allmaps_incourse {
18464: my ($cdom,$cnum,$chome,$cid) = @_;
18465: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
18466: $cid = $env{'request.course.id'};
18467: $cdom = $env{'course.'.$cid.'.domain'};
18468: $cnum = $env{'course.'.$cid.'.num'};
18469: $chome = $env{'course.'.$cid.'.home'};
18470: }
18471: my %allmaps = ();
18472: my $lastchange =
18473: &Apache::lonnet::get_coursechange($cdom,$cnum);
18474: if ($lastchange > $env{'request.course.tied'}) {
18475: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
18476: unless ($ferr) {
1.1395 raeburn 18477: &update_content_constraints($cdom,$cnum,$chome,$cid);
1.1110 raeburn 18478: }
18479: }
18480: my $navmap = Apache::lonnavmaps::navmap->new();
18481: if (defined($navmap)) {
18482: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
18483: $allmaps{$res->src()} = 1;
18484: }
18485: }
18486: return \%allmaps;
18487: }
18488:
1.1083 raeburn 18489: sub parse_supplemental_title {
18490: my ($title) = @_;
18491:
18492: my ($foldertitle,$renametitle);
18493: if ($title =~ /&&&/) {
18494: $title = &HTML::Entites::decode($title);
18495: }
18496: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
18497: $renametitle=$4;
18498: my ($time,$uname,$udom) = ($1,$2,$3);
18499: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
18500: my $name = &plainname($uname,$udom);
18501: $name = &HTML::Entities::encode($name,'"<>&\'');
18502: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
18503: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
18504: $name.': <br />'.$foldertitle;
18505: }
18506: if (wantarray) {
18507: return ($title,$foldertitle,$renametitle);
18508: }
18509: return $title;
18510: }
18511:
1.1395 raeburn 18512: sub get_supplemental {
18513: my ($cnum,$cdom,$ignorecache,$possdel)=@_;
18514: my $hashid=$cnum.':'.$cdom;
18515: my ($supplemental,$cached,$set_httprefs);
18516: unless ($ignorecache) {
18517: ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
18518: }
18519: unless (defined($cached)) {
18520: my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
18521: unless ($chome eq 'no_host') {
18522: my @order = @LONCAPA::map::order;
18523: my @resources = @LONCAPA::map::resources;
18524: my @resparms = @LONCAPA::map::resparms;
18525: my @zombies = @LONCAPA::map::zombies;
18526: my ($errors,%ids,%hidden);
18527: $errors =
18528: &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
18529: $errors,$possdel,\%ids,\%hidden);
18530: @LONCAPA::map::order = @order;
18531: @LONCAPA::map::resources = @resources;
18532: @LONCAPA::map::resparms = @resparms;
18533: @LONCAPA::map::zombies = @zombies;
18534: $set_httprefs = 1;
18535: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
18536: &Apache::lonnet::appenv({'request.course.suppupdated' => time});
18537: }
18538: $supplemental = {
18539: ids => \%ids,
18540: hidden => \%hidden,
18541: };
18542: &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
18543: }
18544: }
18545: return ($supplemental,$set_httprefs);
18546: }
18547:
1.1143 raeburn 18548: sub recurse_supplemental {
1.1391 raeburn 18549: my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
18550: if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
18551: my $mapnum;
18552: if ($suppmap eq 'supplemental.sequence') {
18553: $mapnum = 0;
18554: } else {
18555: ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
18556: }
1.1143 raeburn 18557: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
18558: if ($fatal) {
18559: $errors ++;
18560: } else {
1.1389 raeburn 18561: my @order = @LONCAPA::map::order;
18562: if (@order > 0) {
18563: my @resources = @LONCAPA::map::resources;
1.1391 raeburn 18564: my @resparms = @LONCAPA::map::resparms;
1.1389 raeburn 18565: foreach my $idx (@order) {
18566: my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1143 raeburn 18567: if (($src ne '') && ($status eq 'res')) {
1.1391 raeburn 18568: my $id = $mapnum.':'.$idx;
18569: push(@{$suppids->{$src}},$id);
18570: if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
18571: $hiddensupp->{$id} = 1;
18572: }
1.1146 raeburn 18573: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1391 raeburn 18574: $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
18575: $hiddensupp,$hiddensupp->{$id});
1.1143 raeburn 18576: } else {
1.1391 raeburn 18577: my $allowed;
18578: if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
18579: $allowed = 1;
18580: } elsif ($possdel) {
18581: foreach my $item (@{$suppids->{$src}}) {
18582: next if ($item eq $id);
18583: unless ($hiddensupp->{$item}) {
18584: $allowed = 1;
18585: last;
18586: }
18587: }
18588: if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
18589: &Apache::lonnet::delenv('httpref.'.$src);
18590: }
18591: }
18592: if ($allowed && (!exists($env{'httpref.'.$src}))) {
18593: &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
1.1308 raeburn 18594: }
1.1143 raeburn 18595: }
18596: }
18597: }
18598: }
18599: }
18600: }
1.1391 raeburn 18601: return $errors;
18602: }
18603:
18604: sub set_supp_httprefs {
18605: my ($cnum,$cdom,$supplemental,$possdel) = @_;
18606: if (ref($supplemental) eq 'HASH') {
18607: if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
18608: foreach my $src (keys(%{$supplemental->{'ids'}})) {
18609: next if ($src =~ /\.sequence$/);
18610: if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
18611: my $allowed;
18612: if ($env{'request.role.adv'}) {
18613: $allowed = 1;
18614: } else {
18615: foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
18616: unless ($supplemental->{'hidden'}->{$id}) {
18617: $allowed = 1;
18618: last;
18619: }
18620: }
18621: }
18622: if (exists($env{'httpref.'.$src})) {
18623: if ($possdel) {
18624: unless ($allowed) {
18625: &Apache::lonnet::delenv('httpref.'.$src);
18626: }
18627: }
18628: } elsif ($allowed) {
18629: &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
18630: }
18631: }
18632: }
18633: if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
18634: &Apache::lonnet::appenv({'request.course.suppupdated' => time});
18635: }
18636: }
18637: }
18638: }
18639:
18640: sub get_supp_parameter {
18641: my ($resparm,$name)=@_;
18642: return if ($resparm eq '');
18643: my $value=undef;
18644: my $ptype=undef;
18645: foreach (split('&&&',$resparm)) {
18646: my ($thistype,$thisname,$thisvalue)=split('___',$_);
18647: if ($thisname eq $name) {
18648: $value=$thisvalue;
18649: $ptype=$thistype;
18650: }
18651: }
18652: return $value;
1.1143 raeburn 18653: }
18654:
1.1101 raeburn 18655: sub symb_to_docspath {
1.1267 raeburn 18656: my ($symb,$navmapref) = @_;
18657: return unless ($symb && ref($navmapref));
1.1101 raeburn 18658: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
18659: if ($resurl=~/\.(sequence|page)$/) {
18660: $mapurl=$resurl;
18661: } elsif ($resurl eq 'adm/navmaps') {
18662: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
18663: }
18664: my $mapresobj;
1.1267 raeburn 18665: unless (ref($$navmapref)) {
18666: $$navmapref = Apache::lonnavmaps::navmap->new();
18667: }
18668: if (ref($$navmapref)) {
18669: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1101 raeburn 18670: }
18671: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
18672: my $type=$2;
18673: my $path;
18674: if (ref($mapresobj)) {
18675: my $pcslist = $mapresobj->map_hierarchy();
18676: if ($pcslist ne '') {
18677: foreach my $pc (split(/,/,$pcslist)) {
18678: next if ($pc <= 1);
1.1267 raeburn 18679: my $res = $$navmapref->getByMapPc($pc);
1.1101 raeburn 18680: if (ref($res)) {
18681: my $thisurl = $res->src();
18682: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
18683: my $thistitle = $res->title();
18684: $path .= '&'.
18685: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 18686: &escape($thistitle).
1.1101 raeburn 18687: ':'.$res->randompick().
18688: ':'.$res->randomout().
18689: ':'.$res->encrypted().
18690: ':'.$res->randomorder().
18691: ':'.$res->is_page();
18692: }
18693: }
18694: }
18695: $path =~ s/^\&//;
18696: my $maptitle = $mapresobj->title();
18697: if ($mapurl eq 'default') {
1.1129 raeburn 18698: $maptitle = 'Main Content';
1.1101 raeburn 18699: }
18700: $path .= (($path ne '')? '&' : '').
18701: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 18702: &escape($maptitle).
1.1101 raeburn 18703: ':'.$mapresobj->randompick().
18704: ':'.$mapresobj->randomout().
18705: ':'.$mapresobj->encrypted().
18706: ':'.$mapresobj->randomorder().
18707: ':'.$mapresobj->is_page();
18708: } else {
18709: my $maptitle = &Apache::lonnet::gettitle($mapurl);
18710: my $ispage = (($type eq 'page')? 1 : '');
18711: if ($mapurl eq 'default') {
1.1129 raeburn 18712: $maptitle = 'Main Content';
1.1101 raeburn 18713: }
18714: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 18715: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 18716: }
18717: unless ($mapurl eq 'default') {
18718: $path = 'default&'.
1.1146 raeburn 18719: &escape('Main Content').
1.1101 raeburn 18720: ':::::&'.$path;
18721: }
18722: return $path;
18723: }
18724:
1.1393 raeburn 18725: sub validate_folderpath {
18726: my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
18727: if ($env{'form.folderpath'} ne '') {
18728: my @items = split(/\&/,$env{'form.folderpath'});
1.1394 raeburn 18729: my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
1.1393 raeburn 18730: for (my $i=0; $i<@items; $i++) {
18731: my $odd = $i%2;
18732: if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
18733: $badpath = 1;
1.1394 raeburn 18734: } elsif ($odd && $supplementalflag) {
1.1393 raeburn 18735: my $idx = $i-1;
1.1394 raeburn 18736: if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
18737: my $esc_name = $1;
18738: if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
18739: $supppath .= '&'.$esc_name;
18740: $changed = 1;
18741: } else {
18742: $supppath .= '&'.$items[$i];
18743: }
18744: } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
18745: $changed = 1;
1.1393 raeburn 18746: my $is_hidden;
18747: unless ($got_supp) {
1.1395 raeburn 18748: my ($supplemental) = &get_supplemental($coursenum,$coursedom);
1.1393 raeburn 18749: if (ref($supplemental) eq 'HASH') {
18750: if (ref($supplemental->{'hidden'}) eq 'HASH') {
18751: %supphidden = %{$supplemental->{'hidden'}};
18752: }
18753: if (ref($supplemental->{'ids'}) eq 'HASH') {
18754: %suppids = %{$supplemental->{'ids'}};
18755: }
18756: }
18757: $got_supp = 1;
18758: }
18759: if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
18760: my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
18761: if ($supphidden{$mapid}) {
18762: $is_hidden = 1;
18763: }
18764: }
1.1394 raeburn 18765: $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
18766: } else {
18767: $supppath .= '&'.$items[$i];
1.1393 raeburn 18768: }
18769: } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
18770: $badpath = 1;
1.1394 raeburn 18771: } elsif ($supplementalflag) {
1.1393 raeburn 18772: $supppath .= '&'.$items[$i];
18773: }
18774: last if ($badpath);
18775: }
18776: if ($badpath) {
18777: delete($env{'form.folderpath'});
1.1394 raeburn 18778: } elsif ($changed && $supplementalflag) {
1.1393 raeburn 18779: $supppath =~ s/^\&//;
18780: $env{'form.folderpath'} = $supppath;
18781: }
18782: }
18783: return;
18784: }
18785:
1.1094 raeburn 18786: sub captcha_display {
1.1327 raeburn 18787: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 18788: my ($output,$error);
1.1234 raeburn 18789: my ($captcha,$pubkey,$privkey,$version) =
1.1327 raeburn 18790: &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 18791: if ($captcha eq 'original') {
1.1094 raeburn 18792: $output = &create_captcha();
18793: unless ($output) {
1.1172 raeburn 18794: $error = 'captcha';
1.1094 raeburn 18795: }
18796: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 18797: $output = &create_recaptcha($pubkey,$version);
1.1094 raeburn 18798: unless ($output) {
1.1172 raeburn 18799: $error = 'recaptcha';
1.1094 raeburn 18800: }
18801: }
1.1234 raeburn 18802: return ($output,$error,$captcha,$version);
1.1094 raeburn 18803: }
18804:
18805: sub captcha_response {
1.1327 raeburn 18806: my ($context,$lonhost,$defdom) = @_;
1.1094 raeburn 18807: my ($captcha_chk,$captcha_error);
1.1327 raeburn 18808: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1095 raeburn 18809: if ($captcha eq 'original') {
1.1094 raeburn 18810: ($captcha_chk,$captcha_error) = &check_captcha();
18811: } elsif ($captcha eq 'recaptcha') {
1.1234 raeburn 18812: $captcha_chk = &check_recaptcha($privkey,$version);
1.1094 raeburn 18813: } else {
18814: $captcha_chk = 1;
18815: }
18816: return ($captcha_chk,$captcha_error);
18817: }
18818:
18819: sub get_captcha_config {
1.1327 raeburn 18820: my ($context,$lonhost,$dom_in_effect) = @_;
1.1234 raeburn 18821: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1094 raeburn 18822: my $hostname = &Apache::lonnet::hostname($lonhost);
18823: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
18824: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 18825: if ($context eq 'usercreation') {
18826: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
18827: if (ref($domconfig{$context}) eq 'HASH') {
18828: $hashtocheck = $domconfig{$context}{'cancreate'};
18829: if (ref($hashtocheck) eq 'HASH') {
18830: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
18831: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
18832: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
18833: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
18834: }
18835: if ($privkey && $pubkey) {
18836: $captcha = 'recaptcha';
1.1234 raeburn 18837: $version = $hashtocheck->{'recaptchaversion'};
18838: if ($version ne '2') {
18839: $version = 1;
18840: }
1.1095 raeburn 18841: } else {
18842: $captcha = 'original';
18843: }
18844: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
18845: $captcha = 'original';
18846: }
1.1094 raeburn 18847: }
1.1095 raeburn 18848: } else {
18849: $captcha = 'captcha';
18850: }
18851: } elsif ($context eq 'login') {
18852: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
18853: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
18854: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
18855: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 18856: if ($privkey && $pubkey) {
18857: $captcha = 'recaptcha';
1.1234 raeburn 18858: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
18859: if ($version ne '2') {
18860: $version = 1;
18861: }
1.1095 raeburn 18862: } else {
18863: $captcha = 'original';
1.1094 raeburn 18864: }
1.1095 raeburn 18865: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
18866: $captcha = 'original';
1.1094 raeburn 18867: }
1.1327 raeburn 18868: } elsif ($context eq 'passwords') {
18869: if ($dom_in_effect) {
18870: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
18871: if ($passwdconf{'captcha'} eq 'recaptcha') {
18872: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
18873: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
18874: $privkey = $passwdconf{'recaptchakeys'}{'private'};
18875: }
18876: if ($privkey && $pubkey) {
18877: $captcha = 'recaptcha';
18878: $version = $passwdconf{'recaptchaversion'};
18879: if ($version ne '2') {
18880: $version = 1;
18881: }
18882: } else {
18883: $captcha = 'original';
18884: }
18885: } elsif ($passwdconf{'captcha'} ne 'notused') {
18886: $captcha = 'original';
18887: }
18888: }
18889: }
1.1234 raeburn 18890: return ($captcha,$pubkey,$privkey,$version);
1.1094 raeburn 18891: }
18892:
18893: sub create_captcha {
18894: my %captcha_params = &captcha_settings();
18895: my ($output,$maxtries,$tries) = ('',10,0);
18896: while ($tries < $maxtries) {
18897: $tries ++;
18898: my $captcha = Authen::Captcha->new (
18899: output_folder => $captcha_params{'output_dir'},
18900: data_folder => $captcha_params{'db_dir'},
18901: );
18902: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
18903:
18904: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
18905: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1367 raeburn 18906: '<span class="LC_nobreak">'.
1.1094 raeburn 18907: &mt('Type in the letters/numbers shown below').' '.
1.1390 raeburn 18908: '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1367 raeburn 18909: '</span><br />'.
1.1176 raeburn 18910: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 18911: last;
18912: }
18913: }
1.1323 raeburn 18914: if ($output eq '') {
18915: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
18916: }
1.1094 raeburn 18917: return $output;
18918: }
18919:
18920: sub captcha_settings {
18921: my %captcha_params = (
18922: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
18923: www_output_dir => "/captchaspool",
18924: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
18925: numchars => '5',
18926: );
18927: return %captcha_params;
18928: }
18929:
18930: sub check_captcha {
18931: my ($captcha_chk,$captcha_error);
18932: my $code = $env{'form.code'};
18933: my $md5sum = $env{'form.crypt'};
18934: my %captcha_params = &captcha_settings();
18935: my $captcha = Authen::Captcha->new(
18936: output_folder => $captcha_params{'output_dir'},
18937: data_folder => $captcha_params{'db_dir'},
18938: );
1.1109 raeburn 18939: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 18940: my %captcha_hash = (
18941: 0 => 'Code not checked (file error)',
18942: -1 => 'Failed: code expired',
18943: -2 => 'Failed: invalid code (not in database)',
18944: -3 => 'Failed: invalid code (code does not match crypt)',
18945: );
18946: if ($captcha_chk != 1) {
18947: $captcha_error = $captcha_hash{$captcha_chk}
18948: }
18949: return ($captcha_chk,$captcha_error);
18950: }
18951:
18952: sub create_recaptcha {
1.1234 raeburn 18953: my ($pubkey,$version) = @_;
18954: if ($version >= 2) {
1.1367 raeburn 18955: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
18956: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1234 raeburn 18957: } else {
18958: my $use_ssl;
18959: if ($ENV{'SERVER_PORT'} == 443) {
18960: $use_ssl = 1;
18961: }
18962: my $captcha = Captcha::reCAPTCHA->new;
18963: return $captcha->get_options_setter({theme => 'white'})."\n".
18964: $captcha->get_html($pubkey,undef,$use_ssl).
18965: &mt('If the text is hard to read, [_1] will replace them.',
18966: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
18967: '<br /><br />';
18968: }
1.1094 raeburn 18969: }
18970:
18971: sub check_recaptcha {
1.1234 raeburn 18972: my ($privkey,$version) = @_;
1.1094 raeburn 18973: my $captcha_chk;
1.1350 raeburn 18974: my $ip = &Apache::lonnet::get_requestor_ip();
1.1234 raeburn 18975: if ($version >= 2) {
18976: my %info = (
18977: secret => $privkey,
18978: response => $env{'form.g-recaptcha-response'},
1.1350 raeburn 18979: remoteip => $ip,
1.1234 raeburn 18980: );
1.1280 raeburn 18981: my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
18982: $request->content(join('&',map {
18983: my $name = escape($_);
18984: "$name=" . ( ref($info{$_}) eq 'ARRAY'
18985: ? join("&$name=", map {escape($_) } @{$info{$_}})
18986: : &escape($info{$_}) );
18987: } keys(%info)));
18988: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
1.1234 raeburn 18989: if ($response->is_success) {
18990: my $data = JSON::DWIW->from_json($response->decoded_content);
18991: if (ref($data) eq 'HASH') {
18992: if ($data->{'success'}) {
18993: $captcha_chk = 1;
18994: }
18995: }
18996: }
18997: } else {
18998: my $captcha = Captcha::reCAPTCHA->new;
18999: my $captcha_result =
19000: $captcha->check_answer(
19001: $privkey,
1.1350 raeburn 19002: $ip,
1.1234 raeburn 19003: $env{'form.recaptcha_challenge_field'},
19004: $env{'form.recaptcha_response_field'},
19005: );
19006: if ($captcha_result->{is_valid}) {
19007: $captcha_chk = 1;
19008: }
1.1094 raeburn 19009: }
19010: return $captcha_chk;
19011: }
19012:
1.1174 raeburn 19013: sub emailusername_info {
1.1244 raeburn 19014: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1174 raeburn 19015: my %titles = &Apache::lonlocal::texthash (
19016: lastname => 'Last Name',
19017: firstname => 'First Name',
19018: institution => 'School/college/university',
19019: location => "School's city, state/province, country",
19020: web => "School's web address",
19021: officialemail => 'E-mail address at institution (if different)',
1.1244 raeburn 19022: id => 'Student/Employee ID',
1.1174 raeburn 19023: );
19024: return (\@fields,\%titles);
19025: }
19026:
1.1161 raeburn 19027: sub cleanup_html {
19028: my ($incoming) = @_;
19029: my $outgoing;
19030: if ($incoming ne '') {
19031: $outgoing = $incoming;
19032: $outgoing =~ s/;/;/g;
19033: $outgoing =~ s/\#/#/g;
19034: $outgoing =~ s/\&/&/g;
19035: $outgoing =~ s/</</g;
19036: $outgoing =~ s/>/>/g;
19037: $outgoing =~ s/\(/(/g;
19038: $outgoing =~ s/\)/)/g;
19039: $outgoing =~ s/"/"/g;
19040: $outgoing =~ s/'/'/g;
19041: $outgoing =~ s/\$/$/g;
19042: $outgoing =~ s{/}{/}g;
19043: $outgoing =~ s/=/=/g;
19044: $outgoing =~ s/\\/\/g
19045: }
19046: return $outgoing;
19047: }
19048:
1.1190 musolffc 19049: # Checks for critical messages and returns a redirect url if one exists.
19050: # $interval indicates how often to check for messages.
1.1282 raeburn 19051: # $context is the calling context -- roles, grades, contents, menu or flip.
1.1190 musolffc 19052: sub critical_redirect {
1.1282 raeburn 19053: my ($interval,$context) = @_;
1.1356 raeburn 19054: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
19055: return ();
19056: }
1.1190 musolffc 19057: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1282 raeburn 19058: if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
19059: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
19060: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1372 raeburn 19061: my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
1.1282 raeburn 19062: if ($blocked) {
19063: my $checkrole = "cm./$cdom/$cnum";
19064: if ($env{'request.course.sec'} ne '') {
19065: $checkrole .= "/$env{'request.course.sec'}";
19066: }
19067: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
19068: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
19069: return;
19070: }
19071: }
19072: }
1.1190 musolffc 19073: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
19074: $env{'user.name'});
19075: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 19076: my $redirecturl;
1.1190 musolffc 19077: if ($what[0]) {
1.1356 raeburn 19078: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1190 musolffc 19079: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 19080: my $url=&Apache::lonnet::absolute_url().$redirecturl;
19081: return (1, $url);
1.1190 musolffc 19082: }
1.1191 raeburn 19083: }
19084: }
19085: return ();
1.1190 musolffc 19086: }
19087:
1.1174 raeburn 19088: # Use:
19089: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
19090: #
19091: ##################################################
19092: # password associated functions #
19093: ##################################################
19094: sub des_keys {
19095: # Make a new key for DES encryption.
19096: # Each key has two parts which are returned separately.
19097: # Please note: Each key must be passed through the &hex function
19098: # before it is output to the web browser. The hex versions cannot
19099: # be used to decrypt.
19100: my @hexstr=('0','1','2','3','4','5','6','7',
19101: '8','9','a','b','c','d','e','f');
19102: my $lkey='';
19103: for (0..7) {
19104: $lkey.=$hexstr[rand(15)];
19105: }
19106: my $ukey='';
19107: for (0..7) {
19108: $ukey.=$hexstr[rand(15)];
19109: }
19110: return ($lkey,$ukey);
19111: }
19112:
19113: sub des_decrypt {
19114: my ($key,$cyphertext) = @_;
19115: my $keybin=pack("H16",$key);
19116: my $cypher;
19117: if ($Crypt::DES::VERSION>=2.03) {
19118: $cypher=new Crypt::DES $keybin;
19119: } else {
19120: $cypher=new DES $keybin;
19121: }
1.1233 raeburn 19122: my $plaintext='';
19123: my $cypherlength = length($cyphertext);
19124: my $numchunks = int($cypherlength/32);
19125: for (my $j=0; $j<$numchunks; $j++) {
19126: my $start = $j*32;
19127: my $cypherblock = substr($cyphertext,$start,32);
19128: my $chunk =
19129: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
19130: $chunk .=
19131: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
19132: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
19133: $plaintext .= $chunk;
19134: }
1.1174 raeburn 19135: return $plaintext;
19136: }
19137:
1.1344 raeburn 19138: sub get_requested_shorturls {
1.1309 raeburn 19139: my ($cdom,$cnum,$navmap) = @_;
19140: return unless (ref($navmap));
1.1344 raeburn 19141: my ($numnew,$errors);
1.1309 raeburn 19142: my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
19143: if (@toshorten) {
19144: my (%maps,%resources,%titles);
19145: &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
19146: 'shorturls',$cdom,$cnum);
19147: if (keys(%resources)) {
1.1344 raeburn 19148: my %tocreate;
1.1309 raeburn 19149: foreach my $item (sort {$a <=> $b} (@toshorten)) {
19150: my $symb = $resources{$item};
19151: if ($symb) {
19152: $tocreate{$cnum.'&'.$symb} = 1;
19153: }
19154: }
1.1344 raeburn 19155: if (keys(%tocreate)) {
19156: ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
19157: \%tocreate);
19158: }
1.1309 raeburn 19159: }
1.1344 raeburn 19160: }
19161: return ($numnew,$errors);
19162: }
19163:
19164: sub make_short_symbs {
19165: my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
19166: my ($numnew,@errors);
19167: if (ref($tocreateref) eq 'HASH') {
19168: my %tocreate = %{$tocreateref};
1.1309 raeburn 19169: if (keys(%tocreate)) {
19170: my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
19171: my $su = Short::URL->new(no_vowels => 1);
19172: my $init = '';
19173: my (%newunique,%addcourse,%courseonly,%failed);
19174: # get lock on tiny db
19175: my $now = time;
1.1344 raeburn 19176: if ($lockuser eq '') {
19177: $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
19178: }
1.1309 raeburn 19179: my $lockhash = {
1.1344 raeburn 19180: "lock\0$now" => $lockuser,
1.1309 raeburn 19181: };
19182: my $tries = 0;
19183: my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
19184: my ($code,$error);
19185: while (($gotlock ne 'ok') && ($tries<3)) {
19186: $tries ++;
19187: sleep 1;
1.1319 raeburn 19188: $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
1.1309 raeburn 19189: }
19190: if ($gotlock eq 'ok') {
19191: $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
19192: \%addcourse,\%courseonly,\%failed);
19193: if (keys(%failed)) {
19194: my $numfailed = scalar(keys(%failed));
19195: push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
19196: }
19197: if (keys(%newunique)) {
19198: my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
19199: if ($putres eq 'ok') {
19200: $numnew = scalar(keys(%newunique));
19201: my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
19202: unless ($newputres eq 'ok') {
19203: push(@errors,&mt('error: could not store course look-up of short URLs'));
19204: }
19205: } else {
19206: push(@errors,&mt('error: could not store unique six character URLs'));
19207: }
19208: }
19209: my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
19210: unless ($dellockres eq 'ok') {
19211: push(@errors,&mt('error: could not release lockfile'));
19212: }
19213: } else {
19214: push(@errors,&mt('error: could not obtain lockfile'));
19215: }
19216: if (keys(%courseonly)) {
19217: my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
19218: if ($result ne 'ok') {
19219: push(@errors,&mt('error: could not update course look-up of short URLs'));
19220: }
19221: }
19222: }
19223: }
19224: return ($numnew,\@errors);
19225: }
19226:
19227: sub shorten_symbs {
19228: my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
19229: return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
19230: (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
19231: (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
19232: my (%possibles,%collisions);
19233: foreach my $key (keys(%{$tocreate})) {
19234: my $num = String::CRC32::crc32($key);
19235: my $tiny = $su->encode($num,$init);
19236: if ($tiny) {
19237: $possibles{$tiny} = $key;
19238: }
19239: }
19240: if (!$init) {
19241: $init = 1;
19242: } else {
19243: $init ++;
19244: }
19245: if (keys(%possibles)) {
19246: my @posstiny = keys(%possibles);
19247: my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
19248: my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
19249: if (keys(%currtiny)) {
19250: foreach my $key (keys(%currtiny)) {
19251: next if ($currtiny{$key} eq '');
19252: if ($currtiny{$key} eq $possibles{$key}) {
19253: my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
19254: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19255: $courseonly->{$tsymb} = $key;
19256: }
19257: } else {
19258: $collisions{$possibles{$key}} = 1;
19259: }
19260: delete($possibles{$key});
19261: }
19262: }
19263: foreach my $key (keys(%possibles)) {
19264: $newunique->{$key} = $possibles{$key};
19265: my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
19266: unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19267: $addcourse->{$tsymb} = $key;
19268: }
19269: }
19270: }
19271: if (keys(%collisions)) {
19272: if ($init <5) {
19273: if (!$init) {
19274: $init = 1;
19275: } else {
19276: $init ++;
19277: }
19278: $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
19279: $newunique,$addcourse,$courseonly,$failed);
19280: } else {
19281: foreach my $key (keys(%collisions)) {
19282: $failed->{$key} = 1;
19283: }
19284: }
19285: }
19286: return $init;
19287: }
19288:
1.1328 raeburn 19289: sub is_nonframeable {
1.1329 raeburn 19290: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
19291: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
1.1330 raeburn 19292: return if (($remprotocol eq '') || ($remhost eq ''));
1.1329 raeburn 19293:
19294: $remprotocol = lc($remprotocol);
19295: $remhost = lc($remhost);
19296: my $remport = 80;
19297: if ($remprotocol eq 'https') {
19298: $remport = 443;
19299: }
1.1330 raeburn 19300: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
1.1329 raeburn 19301: if ($cached) {
19302: unless ($nocache) {
19303: if ($result) {
19304: return 1;
19305: } else {
19306: return 0;
19307: }
19308: }
19309: }
1.1328 raeburn 19310: my $uselink;
19311: my $request = new HTTP::Request('HEAD',$url);
19312: my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5);
19313: if ($response->is_success()) {
19314: my $secpolicy = lc($response->header('content-security-policy'));
19315: my $xframeop = lc($response->header('x-frame-options'));
19316: $secpolicy =~ s/^\s+|\s+$//g;
19317: $xframeop =~ s/^\s+|\s+$//g;
19318: if (($secpolicy ne '') || ($xframeop ne '')) {
1.1329 raeburn 19319: my $remotehost = $remprotocol.'://'.$remhost;
1.1328 raeburn 19320: my ($origin,$protocol,$port);
19321: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
19322: $port = $ENV{'SERVER_PORT'};
19323: } else {
19324: $port = 80;
19325: }
19326: if ($absolute eq '') {
19327: $protocol = 'http:';
19328: if ($port == 443) {
19329: $protocol = 'https:';
19330: }
19331: $origin = $protocol.'//'.lc($hostname);
19332: } else {
19333: $origin = lc($absolute);
19334: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
19335: }
19336: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
19337: my $framepolicy = $1;
19338: $framepolicy =~ s/^\s+|\s+$//g;
19339: my @policies = split(/\s+/,$framepolicy);
19340: if (@policies) {
19341: if (grep(/^\Q'none'\E$/,@policies)) {
19342: $uselink = 1;
19343: } else {
19344: $uselink = 1;
19345: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
19346: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
19347: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
19348: undef($uselink);
19349: }
19350: if ($uselink) {
19351: if (grep(/^\Q'self'\E$/,@policies)) {
19352: if (($origin ne '') && ($remotehost eq $origin)) {
19353: undef($uselink);
19354: }
19355: }
19356: }
19357: if ($uselink) {
19358: my @possok;
19359: if ($ip ne '') {
19360: push(@possok,$ip);
19361: }
19362: my $hoststr = '';
19363: foreach my $part (reverse(split(/\./,$hostname))) {
19364: if ($hoststr eq '') {
19365: $hoststr = $part;
19366: } else {
19367: $hoststr = "$part.$hoststr";
19368: }
19369: if ($hoststr eq $hostname) {
19370: push(@possok,$hostname);
19371: } else {
19372: push(@possok,"*.$hoststr");
19373: }
19374: }
19375: if (@possok) {
19376: foreach my $poss (@possok) {
19377: last if (!$uselink);
19378: foreach my $policy (@policies) {
19379: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
19380: undef($uselink);
19381: last;
19382: }
19383: }
19384: }
19385: }
19386: }
19387: }
19388: }
19389: } elsif ($xframeop ne '') {
19390: $uselink = 1;
19391: my @policies = split(/\s*,\s*/,$xframeop);
19392: if (@policies) {
19393: unless (grep(/^deny$/,@policies)) {
19394: if ($origin ne '') {
19395: if (grep(/^sameorigin$/,@policies)) {
19396: if ($remotehost eq $origin) {
19397: undef($uselink);
19398: }
19399: }
19400: if ($uselink) {
19401: foreach my $policy (@policies) {
19402: if ($policy =~ /^allow-from\s*(.+)$/) {
19403: my $allowfrom = $1;
19404: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
19405: undef($uselink);
19406: last;
19407: }
19408: }
19409: }
19410: }
19411: }
19412: }
19413: }
19414: }
19415: }
19416: }
1.1329 raeburn 19417: if ($nocache) {
19418: if ($cached) {
19419: my $devalidate;
19420: if ($uselink && !$result) {
19421: $devalidate = 1;
19422: } elsif (!$uselink && $result) {
19423: $devalidate = 1;
19424: }
19425: if ($devalidate) {
19426: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
19427: }
19428: }
19429: } else {
19430: if ($uselink) {
19431: $result = 1;
19432: } else {
19433: $result = 0;
19434: }
19435: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
19436: }
1.1328 raeburn 19437: return $uselink;
19438: }
19439:
1.1359 raeburn 19440: sub page_menu {
19441: my ($menucolls,$menunum) = @_;
19442: my %menu;
19443: foreach my $item (split(/;/,$menucolls)) {
19444: my ($num,$value) = split(/\%/,$item);
19445: if ($num eq $menunum) {
19446: my @entries = split(/\&/,$value);
19447: foreach my $entry (@entries) {
19448: my ($name,$fields) = split(/=/,$entry);
1.1368 raeburn 19449: if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
1.1359 raeburn 19450: $menu{$name} = $fields;
19451: } else {
19452: my @shown;
19453: if ($fields =~ /,/) {
19454: @shown = split(/,/,$fields);
19455: } else {
19456: @shown = ($fields);
19457: }
19458: if (@shown) {
19459: foreach my $field (@shown) {
19460: next if ($field eq '');
19461: $menu{$field} = 1;
19462: }
19463: }
19464: }
19465: }
19466: }
19467: }
19468: return %menu;
19469: }
19470:
1.112 bowersj2 19471: 1;
19472: __END__;
1.41 ng 19473:
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