Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.161.2.32
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1075.2.161. .32(raeb 4:-25): # $Id: loncommon.pm,v 1.1075.2.161.2.31 2024/10/08 20:39:54 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.1075.2.161. .7(raebu 64:22): 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.1075.2.25 raeburn 70: use Apache::lonuserutils();
1.1075.2.27 raeburn 71: use Apache::lonuserstate();
1.1075.2.69 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.1075.2.161. .13(raeb 74:-23): use LONCAPA::map();
1.1075.2.135 raeburn 75: use HTTP::Request;
1.657 raeburn 76: use DateTime::TimeZone;
1.1075.2.102 raeburn 77: use DateTime::Locale;
1.1075.2.94 raeburn 78: use Encode();
1.1075.2.14 raeburn 79: use Authen::Captcha;
80: use Captcha::reCAPTCHA;
1.1075.2.107 raeburn 81: use JSON::DWIW;
82: use LWP::UserAgent;
1.1075.2.64 raeburn 83: use Crypt::DES;
84: use DynaLoader; # for Crypt::DES version
1.1075.2.128 raeburn 85: use File::Copy();
86: use File::Path();
1.1075.2.161. .1(raebu 87:21): use String::CRC32();
88:21): use Short::URL();
1.117 www 89:
1.517 raeburn 90: # ---------------------------------------------- Designs
91: use vars qw(%defaultdesign);
92:
1.22 www 93: my $readit;
94:
1.517 raeburn 95:
1.157 matthew 96: ##
97: ## Global Variables
98: ##
1.46 matthew 99:
1.643 foxr 100:
101: # ----------------------------------------------- SSI with retries:
102: #
103:
104: =pod
105:
1.648 raeburn 106: =head1 Server Side include with retries:
1.643 foxr 107:
108: =over 4
109:
1.648 raeburn 110: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 111:
112: Performs an ssi with some number of retries. Retries continue either
113: until the result is ok or until the retry count supplied by the
114: caller is exhausted.
115:
116: Inputs:
1.648 raeburn 117:
118: =over 4
119:
1.643 foxr 120: resource - Identifies the resource to insert.
1.648 raeburn 121:
1.643 foxr 122: retries - Count of the number of retries allowed.
1.648 raeburn 123:
1.643 foxr 124: form - Hash that identifies the rendering options.
125:
1.648 raeburn 126: =back
127:
128: Returns:
129:
130: =over 4
131:
1.643 foxr 132: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 133:
1.643 foxr 134: response - The response from the last attempt (which may or may not have been successful.
135:
1.648 raeburn 136: =back
137:
138: =back
139:
1.643 foxr 140: =cut
141:
142: sub ssi_with_retries {
143: my ($resource, $retries, %form) = @_;
144:
145:
146: my $ok = 0; # True if we got a good response.
147: my $content;
148: my $response;
149:
150: # Try to get the ssi done. within the retries count:
151:
152: do {
153: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
154: $ok = $response->is_success;
1.650 www 155: if (!$ok) {
156: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
157: }
1.643 foxr 158: $retries--;
159: } while (!$ok && ($retries > 0));
160:
161: if (!$ok) {
162: $content = ''; # On error return an empty content.
163: }
164: return ($content, $response);
165:
166: }
167:
168:
169:
1.20 www 170: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 171: my %language;
1.124 www 172: my %supported_language;
1.1048 foxr 173: my %latex_language; # For choosing hyphenation in <transl..>
174: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 175: my %cprtag;
1.192 taceyjo1 176: my %scprtag;
1.351 www 177: my %fe; my %fd; my %fm;
1.41 ng 178: my %category_extensions;
1.12 harris41 179:
1.46 matthew 180: # ---------------------------------------------- Thesaurus variables
1.144 matthew 181: #
182: # %Keywords:
183: # A hash used by &keyword to determine if a word is considered a keyword.
184: # $thesaurus_db_file
185: # Scalar containing the full path to the thesaurus database.
1.46 matthew 186:
187: my %Keywords;
188: my $thesaurus_db_file;
189:
1.144 matthew 190: #
191: # Initialize values from language.tab, copyright.tab, filetypes.tab,
192: # thesaurus.tab, and filecategories.tab.
193: #
1.18 www 194: BEGIN {
1.46 matthew 195: # Variable initialization
196: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
197: #
1.22 www 198: unless ($readit) {
1.12 harris41 199: # ------------------------------------------------------------------- languages
200: {
1.158 raeburn 201: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
202: '/language.tab';
1.1075.2.128 raeburn 203: if ( open(my $fh,'<',$langtabfile) ) {
1.356 albertel 204: while (my $line = <$fh>) {
205: next if ($line=~/^\#/);
206: chomp($line);
1.1048 foxr 207: my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 208: $language{$key}=$val.' - '.$enc;
209: if ($sup) {
210: $supported_language{$key}=$sup;
211: }
1.1048 foxr 212: if ($latex) {
213: $latex_language_bykey{$key} = $latex;
214: $latex_language{$two} = $latex;
215: }
1.158 raeburn 216: }
217: close($fh);
218: }
1.12 harris41 219: }
220: # ------------------------------------------------------------------ copyrights
221: {
1.158 raeburn 222: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
223: '/copyright.tab';
1.1075.2.128 raeburn 224: if ( open (my $fh,'<',$copyrightfile) ) {
1.356 albertel 225: while (my $line = <$fh>) {
226: next if ($line=~/^\#/);
227: chomp($line);
228: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 229: $cprtag{$key}=$val;
230: }
231: close($fh);
232: }
1.12 harris41 233: }
1.351 www 234: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 235: {
236: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
237: '/source_copyright.tab';
1.1075.2.128 raeburn 238: if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356 albertel 239: while (my $line = <$fh>) {
240: next if ($line =~ /^\#/);
241: chomp($line);
242: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 243: $scprtag{$key}=$val;
244: }
245: close($fh);
246: }
247: }
1.63 www 248:
1.517 raeburn 249: # -------------------------------------------------------------- default domain designs
1.63 www 250: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 251: my $designfile = $designdir.'/default.tab';
1.1075.2.128 raeburn 252: if ( open (my $fh,'<',$designfile) ) {
1.517 raeburn 253: while (my $line = <$fh>) {
254: next if ($line =~ /^\#/);
255: chomp($line);
256: my ($key,$val)=(split(/\=/,$line));
257: if ($val) { $defaultdesign{$key}=$val; }
258: }
259: close($fh);
1.63 www 260: }
261:
1.15 harris41 262: # ------------------------------------------------------------- file categories
263: {
1.158 raeburn 264: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
265: '/filecategories.tab';
1.1075.2.128 raeburn 266: if ( open (my $fh,'<',$categoryfile) ) {
1.356 albertel 267: while (my $line = <$fh>) {
268: next if ($line =~ /^\#/);
269: chomp($line);
270: my ($extension,$category)=(split(/\s+/,$line,2));
1.1075.2.119 raeburn 271: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 272: }
273: close($fh);
274: }
275:
1.15 harris41 276: }
1.12 harris41 277: # ------------------------------------------------------------------ file types
278: {
1.158 raeburn 279: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
280: '/filetypes.tab';
1.1075.2.128 raeburn 281: if ( open (my $fh,'<',$typesfile) ) {
1.356 albertel 282: while (my $line = <$fh>) {
283: next if ($line =~ /^\#/);
284: chomp($line);
285: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 286: if ($descr ne '') {
287: $fe{$ending}=lc($emb);
288: $fd{$ending}=$descr;
1.351 www 289: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 290: }
291: }
292: close($fh);
293: }
1.12 harris41 294: }
1.22 www 295: &Apache::lonnet::logthis(
1.705 tempelho 296: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 297: $readit=1;
1.46 matthew 298: } # end of unless($readit)
1.32 matthew 299:
300: }
1.112 bowersj2 301:
1.42 matthew 302: ###############################################################
303: ## HTML and Javascript Helper Functions ##
304: ###############################################################
305:
306: =pod
307:
1.112 bowersj2 308: =head1 HTML and Javascript Functions
1.42 matthew 309:
1.112 bowersj2 310: =over 4
311:
1.648 raeburn 312: =item * &browser_and_searcher_javascript()
1.112 bowersj2 313:
314: X<browsing, javascript>X<searching, javascript>Returns a string
315: containing javascript with two functions, C<openbrowser> and
316: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
317: tags.
1.42 matthew 318:
1.648 raeburn 319: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 320:
321: inputs: formname, elementname, only, omit
322:
323: formname and elementname indicate the name of the html form and name of
324: the element that the results of the browsing selection are to be placed in.
325:
326: Specifying 'only' will restrict the browser to displaying only files
1.185 www 327: with the given extension. Can be a comma separated list.
1.42 matthew 328:
329: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 330: with the given extension. Can be a comma separated list.
1.42 matthew 331:
1.648 raeburn 332: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 333:
334: Inputs: formname, elementname
335:
336: formname and elementname specify the name of the html form and the name
337: of the element the selection from the search results will be placed in.
1.542 raeburn 338:
1.42 matthew 339: =cut
340:
341: sub browser_and_searcher_javascript {
1.199 albertel 342: my ($mode)=@_;
343: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 344: my $resurl=&escape_single(&lastresurl());
1.42 matthew 345: return <<END;
1.219 albertel 346: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 347: var editbrowser = null;
1.135 albertel 348: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 349: var url = '$resurl/?';
1.42 matthew 350: if (editbrowser == null) {
351: url += 'launch=1&';
352: }
353: url += 'catalogmode=interactive&';
1.199 albertel 354: url += 'mode=$mode&';
1.611 albertel 355: url += 'inhibitmenu=yes&';
1.42 matthew 356: url += 'form=' + formname + '&';
357: if (only != null) {
358: url += 'only=' + only + '&';
1.217 albertel 359: } else {
360: url += 'only=&';
361: }
1.42 matthew 362: if (omit != null) {
363: url += 'omit=' + omit + '&';
1.217 albertel 364: } else {
365: url += 'omit=&';
366: }
1.135 albertel 367: if (titleelement != null) {
368: url += 'titleelement=' + titleelement + '&';
1.217 albertel 369: } else {
370: url += 'titleelement=&';
371: }
1.42 matthew 372: url += 'element=' + elementname + '';
373: var title = 'Browser';
1.435 albertel 374: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 375: options += ',width=700,height=600';
376: editbrowser = open(url,title,options,'1');
377: editbrowser.focus();
378: }
379: var editsearcher;
1.135 albertel 380: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 381: var url = '/adm/searchcat?';
382: if (editsearcher == null) {
383: url += 'launch=1&';
384: }
385: url += 'catalogmode=interactive&';
1.199 albertel 386: url += 'mode=$mode&';
1.42 matthew 387: url += 'form=' + formname + '&';
1.135 albertel 388: if (titleelement != null) {
389: url += 'titleelement=' + titleelement + '&';
1.217 albertel 390: } else {
391: url += 'titleelement=&';
392: }
1.42 matthew 393: url += 'element=' + elementname + '';
394: var title = 'Search';
1.435 albertel 395: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 396: options += ',width=700,height=600';
397: editsearcher = open(url,title,options,'1');
398: editsearcher.focus();
399: }
1.219 albertel 400: // END LON-CAPA Internal -->
1.42 matthew 401: END
1.170 www 402: }
403:
404: sub lastresurl {
1.258 albertel 405: if ($env{'environment.lastresurl'}) {
406: return $env{'environment.lastresurl'}
1.170 www 407: } else {
408: return '/res';
409: }
410: }
411:
412: sub storeresurl {
413: my $resurl=&Apache::lonnet::clutter(shift);
414: unless ($resurl=~/^\/res/) { return 0; }
415: $resurl=~s/\/$//;
416: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 417: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 418: return 1;
1.42 matthew 419: }
420:
1.74 www 421: sub studentbrowser_javascript {
1.111 www 422: unless (
1.258 albertel 423: (($env{'request.course.id'}) &&
1.302 albertel 424: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
425: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
426: '/'.$env{'request.course.sec'})
427: ))
1.258 albertel 428: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 429: ) { return ''; }
1.74 www 430: return (<<'ENDSTDBRW');
1.776 bisitz 431: <script type="text/javascript" language="Javascript">
1.824 bisitz 432: // <![CDATA[
1.74 www 433: var stdeditbrowser;
1.1075.2.161. .20(raeb 434:-23): function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv,uident) {
1.74 www 435: var url = '/adm/pickstudent?';
436: var filter;
1.558 albertel 437: if (!ignorefilter) {
438: eval('filter=document.'+formname+'.'+uname+'.value;');
439: }
1.74 www 440: if (filter != null) {
441: if (filter != '') {
442: url += 'filter='+filter+'&';
443: }
444: }
445: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 446: '&udomelement='+udom+
447: '&clicker='+clicker;
1.111 www 448: if (roleflag) { url+="&roles=1"; }
1.1075.2.143 raeburn 449: if (courseadv == 'condition') {
450: if (document.getElementById('courseadv')) {
451: courseadv = document.getElementById('courseadv').value;
452: }
453: }
454: if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.1075.2.161. .20(raeb 455:-23): if (uident !== '') { url+="&identelement="+uident; }
1.102 www 456: var title = 'Student_Browser';
1.74 www 457: var options = 'scrollbars=1,resizable=1,menubar=0';
458: options += ',width=700,height=600';
459: stdeditbrowser = open(url,title,options,'1');
460: stdeditbrowser.focus();
461: }
1.824 bisitz 462: // ]]>
1.74 www 463: </script>
464: ENDSTDBRW
465: }
1.42 matthew 466:
1.1003 www 467: sub resourcebrowser_javascript {
468: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 469: return (<<'ENDRESBRW');
1.1003 www 470: <script type="text/javascript" language="Javascript">
471: // <![CDATA[
472: var reseditbrowser;
1.1004 www 473: function openresbrowser(formname,reslink) {
1.1005 www 474: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 475: var title = 'Resource_Browser';
476: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 477: options += ',width=700,height=500';
1.1004 www 478: reseditbrowser = open(url,title,options,'1');
479: reseditbrowser.focus();
1.1003 www 480: }
481: // ]]>
482: </script>
1.1004 www 483: ENDRESBRW
1.1003 www 484: }
485:
1.74 www 486: sub selectstudent_link {
1.1075.2.161. .20(raeb 487:-23): my ($form,$unameele,$udomele,$courseadv,$clickerid,$identelem)=@_;
1.999 www 488: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
489: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
490: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 491: if ($env{'request.course.id'}) {
1.302 albertel 492: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
493: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
494: '/'.$env{'request.course.sec'})) {
1.111 www 495: return '';
496: }
1.999 www 497: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1075.2.143 raeburn 498: if ($courseadv eq 'only') {
499: $callargs .= ",'',1,'$courseadv'";
500: } elsif ($courseadv eq 'none') {
501: $callargs .= ",'','','$courseadv'";
502: } elsif ($courseadv eq 'condition') {
503: $callargs .= ",'','','$courseadv'";
1.1075.2.161. .20(raeb 504:-23): } elsif ($identelem ne '') {
505:-23): $callargs .= ",'','',''";
506:-23): }
507:-23): if ($identelem ne '') {
508:-23): $callargs .= ",'".&Apache::lonhtmlcommon::entity_encode($identelem)."'";
1.793 raeburn 509: }
510: return '<span class="LC_nobreak">'.
511: '<a href="javascript:openstdbrowser('.$callargs.');">'.
512: &mt('Select User').'</a></span>';
1.74 www 513: }
1.258 albertel 514: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 515: $callargs .= ",'',1";
1.793 raeburn 516: return '<span class="LC_nobreak">'.
517: '<a href="javascript:openstdbrowser('.$callargs.');">'.
518: &mt('Select User').'</a></span>';
1.111 www 519: }
520: return '';
1.91 www 521: }
522:
1.1004 www 523: sub selectresource_link {
524: my ($form,$reslink,$arg)=@_;
525:
526: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
527: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
528: unless ($env{'request.course.id'}) { return $arg; }
529: return '<span class="LC_nobreak">'.
530: '<a href="javascript:openresbrowser('.$callargs.');">'.
531: $arg.'</a></span>';
532: }
533:
534:
535:
1.653 raeburn 536: sub authorbrowser_javascript {
537: return <<"ENDAUTHORBRW";
1.776 bisitz 538: <script type="text/javascript" language="JavaScript">
1.824 bisitz 539: // <![CDATA[
1.653 raeburn 540: var stdeditbrowser;
541:
542: function openauthorbrowser(formname,udom) {
543: var url = '/adm/pickauthor?';
544: url += 'form='+formname+'&roledom='+udom;
545: var title = 'Author_Browser';
546: var options = 'scrollbars=1,resizable=1,menubar=0';
547: options += ',width=700,height=600';
548: stdeditbrowser = open(url,title,options,'1');
549: stdeditbrowser.focus();
550: }
551:
1.824 bisitz 552: // ]]>
1.653 raeburn 553: </script>
554: ENDAUTHORBRW
555: }
556:
1.91 www 557: sub coursebrowser_javascript {
1.1075.2.31 raeburn 558: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1075.2.95 raeburn 559: $credits_element,$instcode) = @_;
1.932 raeburn 560: my $wintitle = 'Course_Browser';
1.931 raeburn 561: if ($crstype eq 'Community') {
1.932 raeburn 562: $wintitle = 'Community_Browser';
1.909 raeburn 563: }
1.876 raeburn 564: my $id_functions = &javascript_index_functions();
565: my $output = '
1.776 bisitz 566: <script type="text/javascript" language="JavaScript">
1.824 bisitz 567: // <![CDATA[
1.468 raeburn 568: var stdeditbrowser;'."\n";
1.876 raeburn 569:
570: $output .= <<"ENDSTDBRW";
1.909 raeburn 571: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 572: var url = '/adm/pickcourse?';
1.895 raeburn 573: var formid = getFormIdByName(formname);
1.876 raeburn 574: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 575: if (domainfilter != null) {
576: if (domainfilter != '') {
577: url += 'domainfilter='+domainfilter+'&';
578: }
579: }
1.91 www 580: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 581: '&cdomelement='+udom+
582: '&cnameelement='+desc;
1.468 raeburn 583: if (extra_element !=null && extra_element != '') {
1.594 raeburn 584: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 585: url += '&roleelement='+extra_element;
586: if (domainfilter == null || domainfilter == '') {
587: url += '&domainfilter='+extra_element;
588: }
1.234 raeburn 589: }
1.468 raeburn 590: else {
591: if (formname == 'portform') {
592: url += '&setroles='+extra_element;
1.800 raeburn 593: } else {
594: if (formname == 'rules') {
595: url += '&fixeddom='+extra_element;
596: }
1.468 raeburn 597: }
598: }
1.230 raeburn 599: }
1.909 raeburn 600: if (type != null && type != '') {
601: url += '&type='+type;
602: }
603: if (type_elem != null && type_elem != '') {
604: url += '&typeelement='+type_elem;
605: }
1.872 raeburn 606: if (formname == 'ccrs') {
607: var ownername = document.forms[formid].ccuname.value;
608: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1075.2.101 raeburn 609: url += '&cloner='+ownername+':'+ownerdom;
610: if (type == 'Course') {
611: url += '&crscode='+document.forms[formid].crscode.value;
612: }
1.1075.2.95 raeburn 613: }
614: if (formname == 'requestcrs') {
615: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 616: }
1.293 raeburn 617: if (multflag !=null && multflag != '') {
618: url += '&multiple='+multflag;
619: }
1.909 raeburn 620: var title = '$wintitle';
1.91 www 621: var options = 'scrollbars=1,resizable=1,menubar=0';
622: options += ',width=700,height=600';
623: stdeditbrowser = open(url,title,options,'1');
624: stdeditbrowser.focus();
625: }
1.876 raeburn 626: $id_functions
627: ENDSTDBRW
1.1075.2.31 raeburn 628: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
629: $output .= &setsec_javascript($sec_element,$formname,$role_element,
630: $credits_element);
1.876 raeburn 631: }
632: $output .= '
633: // ]]>
634: </script>';
635: return $output;
636: }
637:
638: sub javascript_index_functions {
639: return <<"ENDJS";
640:
641: function getFormIdByName(formname) {
642: for (var i=0;i<document.forms.length;i++) {
643: if (document.forms[i].name == formname) {
644: return i;
645: }
646: }
647: return -1;
648: }
649:
650: function getIndexByName(formid,item) {
651: for (var i=0;i<document.forms[formid].elements.length;i++) {
652: if (document.forms[formid].elements[i].name == item) {
653: return i;
654: }
655: }
656: return -1;
657: }
1.468 raeburn 658:
1.876 raeburn 659: function getDomainFromSelectbox(formname,udom) {
660: var userdom;
661: var formid = getFormIdByName(formname);
662: if (formid > -1) {
663: var domid = getIndexByName(formid,udom);
664: if (domid > -1) {
665: if (document.forms[formid].elements[domid].type == 'select-one') {
666: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
667: }
668: if (document.forms[formid].elements[domid].type == 'hidden') {
669: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 670: }
671: }
672: }
1.876 raeburn 673: return userdom;
674: }
675:
676: ENDJS
1.468 raeburn 677:
1.876 raeburn 678: }
679:
1.1017 raeburn 680: sub javascript_array_indexof {
1.1018 raeburn 681: return <<ENDJS;
1.1017 raeburn 682: <script type="text/javascript" language="JavaScript">
683: // <![CDATA[
684:
685: if (!Array.prototype.indexOf) {
686: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
687: "use strict";
688: if (this === void 0 || this === null) {
689: throw new TypeError();
690: }
691: var t = Object(this);
692: var len = t.length >>> 0;
693: if (len === 0) {
694: return -1;
695: }
696: var n = 0;
697: if (arguments.length > 0) {
698: n = Number(arguments[1]);
699: if (n !== n) { // shortcut for verifying if it's NaN
700: n = 0;
701: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
702: n = (n > 0 || -1) * Math.floor(Math.abs(n));
703: }
704: }
705: if (n >= len) {
706: return -1;
707: }
708: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
709: for (; k < len; k++) {
710: if (k in t && t[k] === searchElement) {
711: return k;
712: }
713: }
714: return -1;
715: }
716: }
717:
718: // ]]>
719: </script>
720:
721: ENDJS
722:
723: }
724:
1.876 raeburn 725: sub userbrowser_javascript {
726: my $id_functions = &javascript_index_functions();
727: return <<"ENDUSERBRW";
728:
1.888 raeburn 729: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 730: var url = '/adm/pickuser?';
731: var userdom = getDomainFromSelectbox(formname,udom);
732: if (userdom != null) {
733: if (userdom != '') {
734: url += 'srchdom='+userdom+'&';
735: }
736: }
737: url += 'form=' + formname + '&unameelement='+uname+
738: '&udomelement='+udom+
739: '&ulastelement='+ulast+
740: '&ufirstelement='+ufirst+
741: '&uemailelement='+uemail+
1.881 raeburn 742: '&hideudomelement='+hideudom+
743: '&coursedom='+crsdom;
1.888 raeburn 744: if ((caller != null) && (caller != undefined)) {
745: url += '&caller='+caller;
746: }
1.876 raeburn 747: var title = 'User_Browser';
748: var options = 'scrollbars=1,resizable=1,menubar=0';
749: options += ',width=700,height=600';
750: var stdeditbrowser = open(url,title,options,'1');
751: stdeditbrowser.focus();
752: }
753:
1.888 raeburn 754: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 755: var formid = getFormIdByName(formname);
756: if (formid > -1) {
1.888 raeburn 757: var unameid = getIndexByName(formid,uname);
1.876 raeburn 758: var domid = getIndexByName(formid,udom);
759: var hidedomid = getIndexByName(formid,origdom);
760: if (hidedomid > -1) {
761: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 762: var unameval = document.forms[formid].elements[unameid].value;
763: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
764: if (domid > -1) {
765: var slct = document.forms[formid].elements[domid];
766: if (slct.type == 'select-one') {
767: var i;
768: for (i=0;i<slct.length;i++) {
769: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
770: }
771: }
772: if (slct.type == 'hidden') {
773: slct.value = fixeddom;
1.876 raeburn 774: }
775: }
1.468 raeburn 776: }
777: }
778: }
1.876 raeburn 779: return;
780: }
781:
782: $id_functions
783: ENDUSERBRW
1.468 raeburn 784: }
785:
786: sub setsec_javascript {
1.1075.2.31 raeburn 787: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 788: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
789: $communityrolestr);
790: if ($role_element ne '') {
791: my @allroles = ('st','ta','ep','in','ad');
792: foreach my $crstype ('Course','Community') {
793: if ($crstype eq 'Community') {
794: foreach my $role (@allroles) {
795: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
796: }
797: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
798: } else {
799: foreach my $role (@allroles) {
800: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
801: }
802: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
803: }
804: }
805: $rolestr = '"'.join('","',@allroles).'"';
806: $courserolestr = '"'.join('","',@courserolenames).'"';
807: $communityrolestr = '"'.join('","',@communityrolenames).'"';
808: }
1.468 raeburn 809: my $setsections = qq|
810: function setSect(sectionlist) {
1.629 raeburn 811: var sectionsArray = new Array();
812: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
813: sectionsArray = sectionlist.split(",");
814: }
1.468 raeburn 815: var numSections = sectionsArray.length;
816: document.$formname.$sec_element.length = 0;
817: if (numSections == 0) {
818: document.$formname.$sec_element.multiple=false;
819: document.$formname.$sec_element.size=1;
820: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
821: } else {
822: if (numSections == 1) {
823: document.$formname.$sec_element.multiple=false;
824: document.$formname.$sec_element.size=1;
825: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
826: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
827: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
828: } else {
829: for (var i=0; i<numSections; i++) {
830: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
831: }
832: document.$formname.$sec_element.multiple=true
833: if (numSections < 3) {
834: document.$formname.$sec_element.size=numSections;
835: } else {
836: document.$formname.$sec_element.size=3;
837: }
838: document.$formname.$sec_element.options[0].selected = false
839: }
840: }
1.91 www 841: }
1.905 raeburn 842:
843: function setRole(crstype) {
1.468 raeburn 844: |;
1.905 raeburn 845: if ($role_element eq '') {
846: $setsections .= ' return;
847: }
848: ';
849: } else {
850: $setsections .= qq|
851: var elementLength = document.$formname.$role_element.length;
852: var allroles = Array($rolestr);
853: var courserolenames = Array($courserolestr);
854: var communityrolenames = Array($communityrolestr);
855: if (elementLength != undefined) {
856: if (document.$formname.$role_element.options[5].value == 'cc') {
857: if (crstype == 'Course') {
858: return;
859: } else {
860: allroles[5] = 'co';
861: for (var i=0; i<6; i++) {
862: document.$formname.$role_element.options[i].value = allroles[i];
863: document.$formname.$role_element.options[i].text = communityrolenames[i];
864: }
865: }
866: } else {
867: if (crstype == 'Community') {
868: return;
869: } else {
870: allroles[5] = 'cc';
871: for (var i=0; i<6; i++) {
872: document.$formname.$role_element.options[i].value = allroles[i];
873: document.$formname.$role_element.options[i].text = courserolenames[i];
874: }
875: }
876: }
877: }
878: return;
879: }
880: |;
881: }
1.1075.2.31 raeburn 882: if ($credits_element) {
883: $setsections .= qq|
884: function setCredits(defaultcredits) {
885: document.$formname.$credits_element.value = defaultcredits;
886: return;
887: }
888: |;
889: }
1.468 raeburn 890: return $setsections;
891: }
892:
1.91 www 893: sub selectcourse_link {
1.909 raeburn 894: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
895: $typeelement) = @_;
896: my $type = $selecttype;
1.871 raeburn 897: my $linktext = &mt('Select Course');
898: if ($selecttype eq 'Community') {
1.909 raeburn 899: $linktext = &mt('Select Community');
1.906 raeburn 900: } elsif ($selecttype eq 'Course/Community') {
901: $linktext = &mt('Select Course/Community');
1.909 raeburn 902: $type = '';
1.1019 raeburn 903: } elsif ($selecttype eq 'Select') {
904: $linktext = &mt('Select');
905: $type = '';
1.871 raeburn 906: }
1.787 bisitz 907: return '<span class="LC_nobreak">'
908: ."<a href='"
909: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
910: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 911: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 912: ."'>".$linktext.'</a>'
1.787 bisitz 913: .'</span>';
1.74 www 914: }
1.42 matthew 915:
1.653 raeburn 916: sub selectauthor_link {
917: my ($form,$udom)=@_;
918: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
919: &mt('Select Author').'</a>';
920: }
921:
1.876 raeburn 922: sub selectuser_link {
1.881 raeburn 923: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 924: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 925: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 926: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 927: ');">'.$linktext.'</a>';
1.876 raeburn 928: }
929:
1.273 raeburn 930: sub check_uncheck_jscript {
931: my $jscript = <<"ENDSCRT";
932: function checkAll(field) {
933: if (field.length > 0) {
934: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 935: if (!field[i].disabled) {
936: field[i].checked = true;
937: }
1.273 raeburn 938: }
939: } else {
1.1075.2.14 raeburn 940: if (!field.disabled) {
941: field.checked = true;
942: }
1.273 raeburn 943: }
944: }
945:
946: function uncheckAll(field) {
947: if (field.length > 0) {
948: for (i = 0; i < field.length; i++) {
949: field[i].checked = false ;
1.543 albertel 950: }
951: } else {
1.273 raeburn 952: field.checked = false ;
953: }
954: }
955: ENDSCRT
956: return $jscript;
957: }
958:
1.656 www 959: sub select_timezone {
1.1075.2.161. .10(raeb 960:-22): my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_;
961:-22): my $output='<select name="'.$name.'" '.$id.$onchange.$disabled.'>'."\n";
1.659 raeburn 962: if ($includeempty) {
963: $output .= '<option value=""';
964: if (($selected eq '') || ($selected eq 'local')) {
965: $output .= ' selected="selected" ';
966: }
967: $output .= '> </option>';
968: }
1.657 raeburn 969: my @timezones = DateTime::TimeZone->all_names;
970: foreach my $tzone (@timezones) {
971: $output.= '<option value="'.$tzone.'"';
972: if ($tzone eq $selected) {
973: $output.=' selected="selected"';
974: }
975: $output.=">$tzone</option>\n";
1.656 www 976: }
977: $output.="</select>";
978: return $output;
979: }
1.273 raeburn 980:
1.687 raeburn 981: sub select_datelocale {
1.1075.2.115 raeburn 982: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
983: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 984: if ($includeempty) {
985: $output .= '<option value=""';
986: if ($selected eq '') {
987: $output .= ' selected="selected" ';
988: }
989: $output .= '> </option>';
990: }
1.1075.2.102 raeburn 991: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 992: my (@possibles,%locale_names);
1.1075.2.102 raeburn 993: my @locales = DateTime::Locale->ids();
994: foreach my $id (@locales) {
995: if ($id ne '') {
996: my ($en_terr,$native_terr);
997: my $loc = DateTime::Locale->load($id);
998: if (ref($loc)) {
999: $en_terr = $loc->name();
1000: $native_terr = $loc->native_name();
1.687 raeburn 1001: if (grep(/^en$/,@languages) || !@languages) {
1002: if ($en_terr ne '') {
1003: $locale_names{$id} = '('.$en_terr.')';
1004: } elsif ($native_terr ne '') {
1005: $locale_names{$id} = $native_terr;
1006: }
1007: } else {
1008: if ($native_terr ne '') {
1009: $locale_names{$id} = $native_terr.' ';
1010: } elsif ($en_terr ne '') {
1011: $locale_names{$id} = '('.$en_terr.')';
1012: }
1013: }
1.1075.2.94 raeburn 1014: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102 raeburn 1015: push(@possibles,$id);
1.687 raeburn 1016: }
1017: }
1018: }
1019: foreach my $item (sort(@possibles)) {
1020: $output.= '<option value="'.$item.'"';
1021: if ($item eq $selected) {
1022: $output.=' selected="selected"';
1023: }
1024: $output.=">$item";
1025: if ($locale_names{$item} ne '') {
1.1075.2.94 raeburn 1026: $output.=' '.$locale_names{$item};
1.687 raeburn 1027: }
1028: $output.="</option>\n";
1029: }
1030: $output.="</select>";
1031: return $output;
1032: }
1033:
1.792 raeburn 1034: sub select_language {
1.1075.2.115 raeburn 1035: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1036: my %langchoices;
1037: if ($includeempty) {
1.1075.2.32 raeburn 1038: %langchoices = ('' => 'No language preference');
1.792 raeburn 1039: }
1040: foreach my $id (&languageids()) {
1041: my $code = &supportedlanguagecode($id);
1042: if ($code) {
1043: $langchoices{$code} = &plainlanguagedescription($id);
1044: }
1045: }
1.1075.2.32 raeburn 1046: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1075.2.115 raeburn 1047: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1048: }
1049:
1.42 matthew 1050: =pod
1.36 matthew 1051:
1.648 raeburn 1052: =item * &linked_select_forms(...)
1.36 matthew 1053:
1054: linked_select_forms returns a string containing a <script></script> block
1055: and html for two <select> menus. The select menus will be linked in that
1056: changing the value of the first menu will result in new values being placed
1057: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1058: order unless a defined order is provided.
1.36 matthew 1059:
1060: linked_select_forms takes the following ordered inputs:
1061:
1062: =over 4
1063:
1.112 bowersj2 1064: =item * $formname, the name of the <form> tag
1.36 matthew 1065:
1.112 bowersj2 1066: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1067:
1.112 bowersj2 1068: =item * $firstdefault, the default value for the first menu
1.36 matthew 1069:
1.112 bowersj2 1070: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1071:
1.112 bowersj2 1072: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1073:
1.112 bowersj2 1074: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1075:
1.609 raeburn 1076: =item * $menuorder, the order of values in the first menu
1077:
1.1075.2.31 raeburn 1078: =item * $onchangefirst, additional javascript call to execute for an onchange
1079: event for the first <select> tag
1080:
1081: =item * $onchangesecond, additional javascript call to execute for an onchange
1082: event for the second <select> tag
1083:
1.41 ng 1084: =back
1085:
1.36 matthew 1086: Below is an example of such a hash. Only the 'text', 'default', and
1087: 'select2' keys must appear as stated. keys(%menu) are the possible
1088: values for the first select menu. The text that coincides with the
1.41 ng 1089: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1090: and text for the second menu are given in the hash pointed to by
1091: $menu{$choice1}->{'select2'}.
1092:
1.112 bowersj2 1093: my %menu = ( A1 => { text =>"Choice A1" ,
1094: default => "B3",
1095: select2 => {
1096: B1 => "Choice B1",
1097: B2 => "Choice B2",
1098: B3 => "Choice B3",
1099: B4 => "Choice B4"
1.609 raeburn 1100: },
1101: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1102: },
1103: A2 => { text =>"Choice A2" ,
1104: default => "C2",
1105: select2 => {
1106: C1 => "Choice C1",
1107: C2 => "Choice C2",
1108: C3 => "Choice C3"
1.609 raeburn 1109: },
1110: order => ['C2','C1','C3'],
1.112 bowersj2 1111: },
1112: A3 => { text =>"Choice A3" ,
1113: default => "D6",
1114: select2 => {
1115: D1 => "Choice D1",
1116: D2 => "Choice D2",
1117: D3 => "Choice D3",
1118: D4 => "Choice D4",
1119: D5 => "Choice D5",
1120: D6 => "Choice D6",
1121: D7 => "Choice D7"
1.609 raeburn 1122: },
1123: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1124: }
1125: );
1.36 matthew 1126:
1127: =cut
1128:
1129: sub linked_select_forms {
1130: my ($formname,
1131: $middletext,
1132: $firstdefault,
1133: $firstselectname,
1134: $secondselectname,
1.609 raeburn 1135: $hashref,
1136: $menuorder,
1.1075.2.31 raeburn 1137: $onchangefirst,
1138: $onchangesecond
1.36 matthew 1139: ) = @_;
1140: my $second = "document.$formname.$secondselectname";
1141: my $first = "document.$formname.$firstselectname";
1142: # output the javascript to do the changing
1143: my $result = '';
1.776 bisitz 1144: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1145: $result.="// <![CDATA[\n";
1.36 matthew 1146: $result.="var select2data = new Object();\n";
1147: $" = '","';
1148: my $debug = '';
1149: foreach my $s1 (sort(keys(%$hashref))) {
1150: $result.="select2data.d_$s1 = new Object();\n";
1151: $result.="select2data.d_$s1.def = new String('".
1152: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1153: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1154: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1155: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1156: @s2values = @{$hashref->{$s1}->{'order'}};
1157: }
1.36 matthew 1158: $result.="\"@s2values\");\n";
1159: $result.="select2data.d_$s1.texts = new Array(";
1160: my @s2texts;
1161: foreach my $value (@s2values) {
1.1075.2.119 raeburn 1162: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1163: }
1164: $result.="\"@s2texts\");\n";
1165: }
1166: $"=' ';
1167: $result.= <<"END";
1168:
1169: function select1_changed() {
1170: // Determine new choice
1171: var newvalue = "d_" + $first.value;
1172: // update select2
1173: var values = select2data[newvalue].values;
1174: var texts = select2data[newvalue].texts;
1175: var select2def = select2data[newvalue].def;
1176: var i;
1177: // out with the old
1178: for (i = 0; i < $second.options.length; i++) {
1179: $second.options[i] = null;
1180: }
1181: // in with the nuclear
1182: for (i=0;i<values.length; i++) {
1183: $second.options[i] = new Option(values[i]);
1.143 matthew 1184: $second.options[i].value = values[i];
1.36 matthew 1185: $second.options[i].text = texts[i];
1186: if (values[i] == select2def) {
1187: $second.options[i].selected = true;
1188: }
1189: }
1190: }
1.824 bisitz 1191: // ]]>
1.36 matthew 1192: </script>
1193: END
1194: # output the initial values for the selection lists
1.1075.2.31 raeburn 1195: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1196: my @order = sort(keys(%{$hashref}));
1197: if (ref($menuorder) eq 'ARRAY') {
1198: @order = @{$menuorder};
1199: }
1200: foreach my $value (@order) {
1.36 matthew 1201: $result.=" <option value=\"$value\" ";
1.253 albertel 1202: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1203: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1204: }
1205: $result .= "</select>\n";
1206: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1207: $result .= $middletext;
1.1075.2.31 raeburn 1208: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1209: if ($onchangesecond) {
1210: $result .= ' onchange="'.$onchangesecond.'"';
1211: }
1212: $result .= ">\n";
1.36 matthew 1213: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1214:
1215: my @secondorder = sort(keys(%select2));
1216: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1217: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1218: }
1219: foreach my $value (@secondorder) {
1.36 matthew 1220: $result.=" <option value=\"$value\" ";
1.253 albertel 1221: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1222: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1223: }
1224: $result .= "</select>\n";
1225: # return $debug;
1226: return $result;
1227: } # end of sub linked_select_forms {
1228:
1.45 matthew 1229: =pod
1.44 bowersj2 1230:
1.1075.2.161. .6(raebu 1231:22): =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid,$links_target)
1.44 bowersj2 1232:
1.112 bowersj2 1233: Returns a string corresponding to an HTML link to the given help
1234: $topic, where $topic corresponds to the name of a .tex file in
1235: /home/httpd/html/adm/help/tex, with underscores replaced by
1236: spaces.
1237:
1238: $text will optionally be linked to the same topic, allowing you to
1239: link text in addition to the graphic. If you do not want to link
1240: text, but wish to specify one of the later parameters, pass an
1241: empty string.
1242:
1243: $stayOnPage is a value that will be interpreted as a boolean. If true,
1244: the link will not open a new window. If false, the link will open
1245: a new window using Javascript. (Default is false.)
1246:
1247: $width and $height are optional numerical parameters that will
1248: override the width and height of the popped up window, which may
1.973 raeburn 1249: be useful for certain help topics with big pictures included.
1250:
1251: $imgid is the id of the img tag used for the help icon. This may be
1252: used in a javascript call to switch the image src. See
1253: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1254:
1.1075.2.161. .6(raebu 1255:22): $links_target will optionally be set to a target (_top, _parent or _self).
1256:22):
1.44 bowersj2 1257: =cut
1258:
1259: sub help_open_topic {
1.1075.2.161. .6(raebu 1260:22): my ($topic, $text, $stayOnPage, $width, $height, $imgid, $links_target) = @_;
1.48 bowersj2 1261: $text = "" if (not defined $text);
1.44 bowersj2 1262: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1263: $width = 500 if (not defined $width);
1.44 bowersj2 1264: $height = 400 if (not defined $height);
1265: my $filename = $topic;
1266: $filename =~ s/ /_/g;
1267:
1.48 bowersj2 1268: my $template = "";
1269: my $link;
1.572 banghart 1270:
1.159 www 1271: $topic=~s/\W/\_/g;
1.44 bowersj2 1272:
1.572 banghart 1273: if (!$stayOnPage) {
1.1075.2.50 raeburn 1274: if ($env{'browser.mobile'}) {
1275: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1276: } else {
1277: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1278: }
1.1037 www 1279: } elsif ($stayOnPage eq 'popup') {
1280: $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 1281: } else {
1.48 bowersj2 1282: $link = "/adm/help/${filename}.hlp";
1283: }
1284:
1285: # Add the text
1.1075.2.161. .6(raebu 1286:22): my $target = ' target="_top"';
1287:22): if ($links_target) {
1288:22): $target = ' target="'.$links_target.'"';
.17(raeb 1289:-23): } elsif ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
1290:-23): (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
.6(raebu 1291:22): $target = '';
1292:22): }
1.755 neumanie 1293: if ($text ne "") {
1.763 bisitz 1294: $template.='<span class="LC_help_open_topic">'
1.1075.2.161. .6(raebu 1295:22): .'<a'.$target.' href="'.$link.'">'
1.763 bisitz 1296: .$text.'</a>';
1.48 bowersj2 1297: }
1298:
1.763 bisitz 1299: # (Always) Add the graphic
1.179 matthew 1300: my $title = &mt('Online Help');
1.667 raeburn 1301: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1302: if ($imgid ne '') {
1303: $imgid = ' id="'.$imgid.'"';
1304: }
1.1075.2.161. .6(raebu 1305:22): $template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
1.763 bisitz 1306: .'<img src="'.$helpicon.'" border="0"'
1307: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1308: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1309: .' /></a>';
1310: if ($text ne "") {
1311: $template.='</span>';
1312: }
1.44 bowersj2 1313: return $template;
1314:
1.106 bowersj2 1315: }
1316:
1317: # This is a quicky function for Latex cheatsheet editing, since it
1318: # appears in at least four places
1319: sub helpLatexCheatsheet {
1.1037 www 1320: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1321: my $out;
1.106 bowersj2 1322: my $addOther = '';
1.732 raeburn 1323: if ($topic) {
1.1037 www 1324: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1325: }
1326: $out = '<span>' # Start cheatsheet
1327: .$addOther
1328: .'<span>'
1.1037 www 1329: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1330: .'</span> <span>'
1.1037 www 1331: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1332: .'</span>';
1.732 raeburn 1333: unless ($not_author) {
1.763 bisitz 1334: $out .= ' <span>'
1.1037 www 1335: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1336: .'</span> <span>'
1.1075.2.78 raeburn 1337: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1338: .'</span>';
1.732 raeburn 1339: }
1.763 bisitz 1340: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1341: return $out;
1.172 www 1342: }
1343:
1.430 albertel 1344: sub general_help {
1345: my $helptopic='Student_Intro';
1346: if ($env{'request.role'}=~/^(ca|au)/) {
1347: $helptopic='Authoring_Intro';
1.907 raeburn 1348: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1349: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1350: } elsif ($env{'request.role'}=~/^dc/) {
1351: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1352: }
1353: return $helptopic;
1354: }
1355:
1356: sub update_help_link {
1357: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1358: my $origurl = $ENV{'REQUEST_URI'};
1359: $origurl=~s|^/~|/priv/|;
1360: my $timestamp = time;
1361: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1362: $$datum = &escape($$datum);
1363: }
1364:
1365: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1366: my $output .= <<"ENDOUTPUT";
1367: <script type="text/javascript">
1.824 bisitz 1368: // <![CDATA[
1.430 albertel 1369: banner_link = '$banner_link';
1.824 bisitz 1370: // ]]>
1.430 albertel 1371: </script>
1372: ENDOUTPUT
1373: return $output;
1374: }
1375:
1376: # now just updates the help link and generates a blue icon
1.193 raeburn 1377: sub help_open_menu {
1.1075.2.161. .6(raebu 1378:22): my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text,$links_target)
1.552 banghart 1379: = @_;
1.949 droeschl 1380: $stayOnPage = 1;
1.430 albertel 1381: my $output;
1382: if ($component_help) {
1383: if (!$text) {
1384: $output=&help_open_topic($component_help,undef,$stayOnPage,
1.1075.2.161. .6(raebu 1385:22): $width,$height,'',$links_target);
1.430 albertel 1386: } else {
1387: my $help_text;
1388: $help_text=&unescape($topic);
1389: $output='<table><tr><td>'.
1390: &help_open_topic($component_help,$help_text,$stayOnPage,
1.1075.2.161. .6(raebu 1391:22): $width,$height,'',$links_target).'</td></tr></table>';
1.430 albertel 1392: }
1393: }
1394: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1395: return $output.$banner_link;
1396: }
1397:
1398: sub top_nav_help {
1.1075.2.158 raeburn 1399: my ($text,$linkattr) = @_;
1.436 albertel 1400: $text = &mt($text);
1.1075.2.60 raeburn 1401: my $stay_on_page;
1402: unless ($env{'environment.remote'} eq 'on') {
1403: $stay_on_page = 1;
1404: }
1.1075.2.61 raeburn 1405: my ($link,$banner_link);
1406: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1407: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1408: : "javascript:helpMenu('open')";
1409: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1410: }
1.201 raeburn 1411: my $title = &mt('Get help');
1.1075.2.61 raeburn 1412: if ($link) {
1413: return <<"END";
1.436 albertel 1414: $banner_link
1.1075.2.158 raeburn 1415: <a href="$link" title="$title" $linkattr>$text</a>
1.436 albertel 1416: END
1.1075.2.61 raeburn 1417: } else {
1418: return ' '.$text.' ';
1419: }
1.436 albertel 1420: }
1421:
1422: sub help_menu_js {
1.1075.2.52 raeburn 1423: my ($httphost) = @_;
1.949 droeschl 1424: my $stayOnPage = 1;
1.436 albertel 1425: my $width = 620;
1426: my $height = 600;
1.430 albertel 1427: my $helptopic=&general_help();
1.1075.2.52 raeburn 1428: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1429: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1430: my $start_page =
1431: &Apache::loncommon::start_page('Help Menu', undef,
1432: {'frameset' => 1,
1433: 'js_ready' => 1,
1.1075.2.136 raeburn 1434: 'use_absolute' => $httphost,
1.331 albertel 1435: 'add_entries' => {
1436: 'border' => '0',
1.579 raeburn 1437: 'rows' => "110,*",},});
1.331 albertel 1438: my $end_page =
1439: &Apache::loncommon::end_page({'frameset' => 1,
1440: 'js_ready' => 1,});
1441:
1.436 albertel 1442: my $template .= <<"ENDTEMPLATE";
1443: <script type="text/javascript">
1.877 bisitz 1444: // <![CDATA[
1.253 albertel 1445: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1446: var banner_link = '';
1.243 raeburn 1447: function helpMenu(target) {
1448: var caller = this;
1449: if (target == 'open') {
1450: var newWindow = null;
1451: try {
1.262 albertel 1452: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1453: }
1454: catch(error) {
1455: writeHelp(caller);
1456: return;
1457: }
1458: if (newWindow) {
1459: caller = newWindow;
1460: }
1.193 raeburn 1461: }
1.243 raeburn 1462: writeHelp(caller);
1463: return;
1464: }
1465: function writeHelp(caller) {
1.1075.2.61 raeburn 1466: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1467: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1468: caller.document.close();
1469: caller.focus();
1.193 raeburn 1470: }
1.877 bisitz 1471: // END LON-CAPA Internal -->
1.253 albertel 1472: // ]]>
1.436 albertel 1473: </script>
1.193 raeburn 1474: ENDTEMPLATE
1475: return $template;
1476: }
1477:
1.172 www 1478: sub help_open_bug {
1479: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1480: unless ($env{'user.adv'}) { return ''; }
1.172 www 1481: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1482: $text = "" if (not defined $text);
1483: $stayOnPage=1;
1.184 albertel 1484: $width = 600 if (not defined $width);
1485: $height = 600 if (not defined $height);
1.172 www 1486:
1487: $topic=~s/\W+/\+/g;
1488: my $link='';
1489: my $template='';
1.379 albertel 1490: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1491: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1492: if (!$stayOnPage)
1493: {
1494: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1495: }
1496: else
1497: {
1498: $link = $url;
1499: }
1.1075.2.161. .6(raebu 1500:22):
1501:22): my $target = '_top';
1502:22): if ((($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) ||
1503:22): (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'} eq '_self'))) {
1504:22): $target = '_blank';
1505:22): }
1506:22):
1.172 www 1507: # Add the text
1508: if ($text ne "")
1509: {
1510: $template .=
1511: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.1075.2.161. .6(raebu 1512:22): "<td bgcolor='#FF5555'><a target=\"$target\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1513: }
1514:
1515: # Add the graphic
1.179 matthew 1516: my $title = &mt('Report a Bug');
1.215 albertel 1517: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1518: $template .= <<"ENDTEMPLATE";
1.1075.2.161. .6(raebu 1519:22): <a target="$target" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1520: ENDTEMPLATE
1521: if ($text ne '') { $template.='</td></tr></table>' };
1522: return $template;
1523:
1524: }
1525:
1526: sub help_open_faq {
1527: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1528: unless ($env{'user.adv'}) { return ''; }
1.172 www 1529: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1530: $text = "" if (not defined $text);
1531: $stayOnPage=1;
1532: $width = 350 if (not defined $width);
1533: $height = 400 if (not defined $height);
1534:
1535: $topic=~s/\W+/\+/g;
1536: my $link='';
1537: my $template='';
1538: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1539: if (!$stayOnPage)
1540: {
1541: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1542: }
1543: else
1544: {
1545: $link = $url;
1546: }
1547:
1548: # Add the text
1549: if ($text ne "")
1550: {
1551: $template .=
1.173 www 1552: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1553: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1554: }
1555:
1556: # Add the graphic
1.179 matthew 1557: my $title = &mt('View the FAQ');
1.215 albertel 1558: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1559: $template .= <<"ENDTEMPLATE";
1.436 albertel 1560: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1561: ENDTEMPLATE
1562: if ($text ne '') { $template.='</td></tr></table>' };
1563: return $template;
1564:
1.44 bowersj2 1565: }
1.37 matthew 1566:
1.180 matthew 1567: ###############################################################
1568: ###############################################################
1569:
1.45 matthew 1570: =pod
1571:
1.648 raeburn 1572: =item * &change_content_javascript():
1.256 matthew 1573:
1574: This and the next function allow you to create small sections of an
1575: otherwise static HTML page that you can update on the fly with
1576: Javascript, even in Netscape 4.
1577:
1578: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1579: must be written to the HTML page once. It will prove the Javascript
1580: function "change(name, content)". Calling the change function with the
1581: name of the section
1582: you want to update, matching the name passed to C<changable_area>, and
1583: the new content you want to put in there, will put the content into
1584: that area.
1585:
1586: B<Note>: Netscape 4 only reserves enough space for the changable area
1587: to contain room for the original contents. You need to "make space"
1588: for whatever changes you wish to make, and be B<sure> to check your
1589: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1590: it's adequate for updating a one-line status display, but little more.
1591: This script will set the space to 100% width, so you only need to
1592: worry about height in Netscape 4.
1593:
1594: Modern browsers are much less limiting, and if you can commit to the
1595: user not using Netscape 4, this feature may be used freely with
1596: pretty much any HTML.
1597:
1598: =cut
1599:
1600: sub change_content_javascript {
1601: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1602: if ($env{'browser.type'} eq 'netscape' &&
1603: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1604: return (<<NETSCAPE4);
1605: function change(name, content) {
1606: doc = document.layers[name+"___escape"].layers[0].document;
1607: doc.open();
1608: doc.write(content);
1609: doc.close();
1610: }
1611: NETSCAPE4
1612: } else {
1613: # Otherwise, we need to use semi-standards-compliant code
1614: # (technically, "innerHTML" isn't standard but the equivalent
1615: # is really scary, and every useful browser supports it
1616: return (<<DOMBASED);
1617: function change(name, content) {
1618: element = document.getElementById(name);
1619: element.innerHTML = content;
1620: }
1621: DOMBASED
1622: }
1623: }
1624:
1625: =pod
1626:
1.648 raeburn 1627: =item * &changable_area($name,$origContent):
1.256 matthew 1628:
1629: This provides a "changable area" that can be modified on the fly via
1630: the Javascript code provided in C<change_content_javascript>. $name is
1631: the name you will use to reference the area later; do not repeat the
1632: same name on a given HTML page more then once. $origContent is what
1633: the area will originally contain, which can be left blank.
1634:
1635: =cut
1636:
1637: sub changable_area {
1638: my ($name, $origContent) = @_;
1639:
1.258 albertel 1640: if ($env{'browser.type'} eq 'netscape' &&
1641: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1642: # If this is netscape 4, we need to use the Layer tag
1643: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1644: } else {
1645: return "<span id='$name'>$origContent</span>";
1646: }
1647: }
1648:
1649: =pod
1650:
1.648 raeburn 1651: =item * &viewport_geometry_js
1.590 raeburn 1652:
1653: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1654:
1655: =cut
1656:
1657:
1658: sub viewport_geometry_js {
1659: return <<"GEOMETRY";
1660: var Geometry = {};
1661: function init_geometry() {
1662: if (Geometry.init) { return };
1663: Geometry.init=1;
1664: if (window.innerHeight) {
1665: Geometry.getViewportHeight = function() { return window.innerHeight; };
1666: Geometry.getViewportWidth = function() { return window.innerWidth; };
1667: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1668: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1669: }
1670: else if (document.documentElement && document.documentElement.clientHeight) {
1671: Geometry.getViewportHeight =
1672: function() { return document.documentElement.clientHeight; };
1673: Geometry.getViewportWidth =
1674: function() { return document.documentElement.clientWidth; };
1675:
1676: Geometry.getHorizontalScroll =
1677: function() { return document.documentElement.scrollLeft; };
1678: Geometry.getVerticalScroll =
1679: function() { return document.documentElement.scrollTop; };
1680: }
1681: else if (document.body.clientHeight) {
1682: Geometry.getViewportHeight =
1683: function() { return document.body.clientHeight; };
1684: Geometry.getViewportWidth =
1685: function() { return document.body.clientWidth; };
1686: Geometry.getHorizontalScroll =
1687: function() { return document.body.scrollLeft; };
1688: Geometry.getVerticalScroll =
1689: function() { return document.body.scrollTop; };
1690: }
1691: }
1692:
1693: GEOMETRY
1694: }
1695:
1696: =pod
1697:
1.648 raeburn 1698: =item * &viewport_size_js()
1.590 raeburn 1699:
1700: 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.
1701:
1702: =cut
1703:
1704: sub viewport_size_js {
1705: my $geometry = &viewport_geometry_js();
1706: return <<"DIMS";
1707:
1708: $geometry
1709:
1710: function getViewportDims(width,height) {
1711: init_geometry();
1712: width.value = Geometry.getViewportWidth();
1713: height.value = Geometry.getViewportHeight();
1714: return;
1715: }
1716:
1717: DIMS
1718: }
1719:
1720: =pod
1721:
1.648 raeburn 1722: =item * &resize_textarea_js()
1.565 albertel 1723:
1724: emits the needed javascript to resize a textarea to be as big as possible
1725:
1726: creates a function resize_textrea that takes two IDs first should be
1727: the id of the element to resize, second should be the id of a div that
1728: surrounds everything that comes after the textarea, this routine needs
1729: to be attached to the <body> for the onload and onresize events.
1730:
1731: =cut
1732:
1733: sub resize_textarea_js {
1.590 raeburn 1734: my $geometry = &viewport_geometry_js();
1.565 albertel 1735: return <<"RESIZE";
1736: <script type="text/javascript">
1.824 bisitz 1737: // <![CDATA[
1.590 raeburn 1738: $geometry
1.565 albertel 1739:
1.588 albertel 1740: function getX(element) {
1741: var x = 0;
1742: while (element) {
1743: x += element.offsetLeft;
1744: element = element.offsetParent;
1745: }
1746: return x;
1747: }
1748: function getY(element) {
1749: var y = 0;
1750: while (element) {
1751: y += element.offsetTop;
1752: element = element.offsetParent;
1753: }
1754: return y;
1755: }
1756:
1757:
1.565 albertel 1758: function resize_textarea(textarea_id,bottom_id) {
1759: init_geometry();
1760: var textarea = document.getElementById(textarea_id);
1761: //alert(textarea);
1762:
1.588 albertel 1763: var textarea_top = getY(textarea);
1.565 albertel 1764: var textarea_height = textarea.offsetHeight;
1765: var bottom = document.getElementById(bottom_id);
1.588 albertel 1766: var bottom_top = getY(bottom);
1.565 albertel 1767: var bottom_height = bottom.offsetHeight;
1768: var window_height = Geometry.getViewportHeight();
1.588 albertel 1769: var fudge = 23;
1.565 albertel 1770: var new_height = window_height-fudge-textarea_top-bottom_height;
1771: if (new_height < 300) {
1772: new_height = 300;
1773: }
1774: textarea.style.height=new_height+'px';
1775: }
1.824 bisitz 1776: // ]]>
1.565 albertel 1777: </script>
1778: RESIZE
1779:
1780: }
1781:
1.1075.2.112 raeburn 1782: sub colorfuleditor_js {
1783: return <<"COLORFULEDIT"
1784: <script type="text/javascript">
1785: // <![CDATA[>
1786: function fold_box(curDepth, lastresource){
1787:
1788: // we need a list because there can be several blocks you need to fold in one tag
1789: var block = document.getElementsByName('foldblock_'+curDepth);
1790: // but there is only one folding button per tag
1791: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1792:
1793: if(block.item(0).style.display == 'none'){
1794:
1795: foldbutton.value = '@{[&mt("Hide")]}';
1796: for (i = 0; i < block.length; i++){
1797: block.item(i).style.display = '';
1798: }
1799: }else{
1800:
1801: foldbutton.value = '@{[&mt("Show")]}';
1802: for (i = 0; i < block.length; i++){
1803: // block.item(i).style.visibility = 'collapse';
1804: block.item(i).style.display = 'none';
1805: }
1806: };
1807: saveState(lastresource);
1808: }
1809:
1810: function saveState (lastresource) {
1811:
1812: var tag_list = getTagList();
1813: if(tag_list != null){
1814: var timestamp = new Date().getTime();
1815: var key = lastresource;
1816:
1817: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1818: // starting with timestamp
1819: var value = timestamp+';';
1820:
1821: // building the list of key-value pairs
1822: for(var i = 0; i < tag_list.length; i++){
1823: value += tag_list[i]+',';
1824: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1825: }
1826:
1827: // only iterate whole storage if nothing to override
1828: if(localStorage.getItem(key) == null){
1829:
1830: // prevent storage from growing large
1831: if(localStorage.length > 50){
1832: var regex_getTimestamp = /^(?:\d)+;/;
1833: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1834: var oldest_key;
1835:
1836: for(var i = 1; i < localStorage.length; i++){
1837: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1838: oldest_key = localStorage.key(i);
1839: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1840: }
1841: }
1842: localStorage.removeItem(oldest_key);
1843: }
1844: }
1845: localStorage.setItem(key,value);
1846: }
1847: }
1848:
1849: // restore folding status of blocks (on page load)
1850: function restoreState (lastresource) {
1851: if(localStorage.getItem(lastresource) != null){
1852: var key = lastresource;
1853: var value = localStorage.getItem(key);
1854: var regex_delTimestamp = /^\d+;/;
1855:
1856: value.replace(regex_delTimestamp, '');
1857:
1858: var valueArr = value.split(';');
1859: var pairs;
1860: var elements;
1861: for (var i = 0; i < valueArr.length; i++){
1862: pairs = valueArr[i].split(',');
1863: elements = document.getElementsByName(pairs[0]);
1864:
1865: for (var j = 0; j < elements.length; j++){
1866: elements[j].style.display = pairs[1];
1867: if (pairs[1] == "none"){
1868: var regex_id = /([_\\d]+)\$/;
1869: regex_id.exec(pairs[0]);
1870: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
1871: }
1872: }
1873: }
1874: }
1875: }
1876:
1877: function getTagList () {
1878:
1879: var stringToSearch = document.lonhomework.innerHTML;
1880:
1881: var ret = new Array();
1882: var regex_findBlock = /(foldblock_.*?)"/g;
1883: var tag_list = stringToSearch.match(regex_findBlock);
1884:
1885: if(tag_list != null){
1886: for(var i = 0; i < tag_list.length; i++){
1887: ret.push(tag_list[i].replace(/"/, ''));
1888: }
1889: }
1890: return ret;
1891: }
1892:
1893: function saveScrollPosition (resource) {
1894: var tag_list = getTagList();
1895:
1896: // we dont always want to jump to the first block
1897: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
1898: if(\$(window).scrollTop() > 170){
1899: if(tag_list != null){
1900: var result;
1901: for(var i = 0; i < tag_list.length; i++){
1902: if(isElementInViewport(tag_list[i])){
1903: result += tag_list[i]+';';
1904: }
1905: }
1906: sessionStorage.setItem('anchor_'+resource, result);
1907: }
1908: } else {
1909: // we dont need to save zero, just delete the item to leave everything tidy
1910: sessionStorage.removeItem('anchor_'+resource);
1911: }
1912: }
1913:
1914: function restoreScrollPosition(resource){
1915:
1916: var elem = sessionStorage.getItem('anchor_'+resource);
1917: if(elem != null){
1918: var tag_list = elem.split(';');
1919: var elem_list;
1920:
1921: for(var i = 0; i < tag_list.length; i++){
1922: elem_list = document.getElementsByName(tag_list[i]);
1923:
1924: if(elem_list.length > 0){
1925: elem = elem_list[0];
1926: break;
1927: }
1928: }
1929: elem.scrollIntoView();
1930: }
1931: }
1932:
1933: function isElementInViewport(el) {
1934:
1935: // change to last element instead of first
1936: var elem = document.getElementsByName(el);
1937: var rect = elem[0].getBoundingClientRect();
1938:
1939: return (
1940: rect.top >= 0 &&
1941: rect.left >= 0 &&
1942: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
1943: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
1944: );
1945: }
1946:
1947: function autosize(depth){
1948: var cmInst = window['cm'+depth];
1949: var fitsizeButton = document.getElementById('fitsize'+depth);
1950:
1951: // is fixed size, switching to dynamic
1952: if (sessionStorage.getItem("autosized_"+depth) == null) {
1953: cmInst.setSize("","auto");
1954: fitsizeButton.value = "@{[&mt('Fixed size')]}";
1955: sessionStorage.setItem("autosized_"+depth, "yes");
1956:
1957: // is dynamic size, switching to fixed
1958: } else {
1959: cmInst.setSize("","300px");
1960: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
1961: sessionStorage.removeItem("autosized_"+depth);
1962: }
1963: }
1964:
1965:
1966:
1967: // ]]>
1968: </script>
1969: COLORFULEDIT
1970: }
1971:
1972: sub xmleditor_js {
1973: return <<XMLEDIT
1974: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
1975: <script type="text/javascript">
1976: // <![CDATA[>
1977:
1978: function saveScrollPosition (resource) {
1979:
1980: var scrollPos = \$(window).scrollTop();
1981: sessionStorage.setItem(resource,scrollPos);
1982: }
1983:
1984: function restoreScrollPosition(resource){
1985:
1986: var scrollPos = sessionStorage.getItem(resource);
1987: \$(window).scrollTop(scrollPos);
1988: }
1989:
1990: // unless internet explorer
1991: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
1992:
1993: \$(document).ready(function() {
1994: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
1995: });
1996: }
1997:
1998: // inserts text at cursor position into codemirror (xml editor only)
1999: function insertText(text){
2000: cm.focus();
2001: var curPos = cm.getCursor();
2002: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
2003: }
2004: // ]]>
2005: </script>
2006: XMLEDIT
2007: }
2008:
2009: sub insert_folding_button {
2010: my $curDepth = $Apache::lonxml::curdepth;
2011: my $lastresource = $env{'request.ambiguous'};
2012:
2013: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
2014: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
2015: }
2016:
1.1075.2.161. .21(raeb 2017:-24): =pod
2018:-24):
2019:-24): =item * &iframe_wrapper_headjs()
2020:-24):
2021:-24): emits javascript containing two global vars to facilitate handling of resizing
2022:-24): by code in iframe_wrapper_resizejs() used when an iframe is present in a page
2023:-24): with standard LON-CAPA menus.
2024:-24):
2025:-24): =cut
2026:-24):
2027:-24): #
2028:-24): # Where iframe is in use, if window.onload() executes before the custom resize function
2029:-24): # has been defined (jQuery), two global javascript vars (LCnotready and LCresizedef)
2030:-24): # are used to ensure document.ready() triggers a call to resize, so the iframe contents
2031:-24): # do not obscure the Functions menu.
2032:-24): #
2033:-24):
2034:-24): sub iframe_wrapper_headjs {
2035:-24): return <<"ENDJS";
2036:-24): <script type="text/javascript">
2037:-24): // <![CDATA[
2038:-24): var LCnotready = 0;
2039:-24): var LCresizedef = 0;
2040:-24): // ]]>
2041:-24): </script>
2042:-24):
2043:-24): ENDJS
2044:-24):
2045:-24): }
2046:-24):
2047:-24): =pod
2048:-24):
2049:-24): =item * &iframe_wrapper_resizejs()
2050:-24):
2051:-24): emits javascript used to handle resizing for a page containing
2052:-24): an iframe, to ensure that the iframe does not obscure any
2053:-24): standard LON-CAPA menu items.
2054:-24):
2055:-24): =back
2056:-24):
2057:-24): =cut
2058:-24):
2059:-24): #
2060:-24): # jQuery to use when iframe is in use and a page resize occurs.
2061:-24): # This script will ensure that the iframe does not obscure any
2062:-24): # standard LON-CAPA inline menus (primary, secondary, and/or
2063:-24): # breadcrumbs and Functions menus. Expects javascript from
2064:-24): # &iframe_wrapper_headjs() to be in head portion of the web page,
2065:-24): # e.g., by inclusion in second arg passed to &start_page().
2066:-24): #
2067:-24):
2068:-24): sub iframe_wrapper_resizejs {
2069:-24): my $offset = 5;
2070:-24): &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']);
2071:-24): if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) {
2072:-24): $offset = 0;
2073:-24): }
2074:-24): return &Apache::lonhtmlcommon::scripttag(<<SCRIPT);
2075:-24): \$(document).ready( function() {
2076:-24): \$(window).unbind('resize').resize(function(){
2077:-24): var header = null;
2078:-24): var offset = $offset;
2079:-24): var height = 0;
2080:-24): var hdrtop = 0;
2081:-24): if (\$('div.LC_menus_content:first').length) {
2082:-24): if (\$('div.LC_menus_content:first').hasClass ("shown")) {
2083:-24): header = \$('div.LC_menus_content:first');
2084:-24): offset = 12;
2085:-24): }
2086:-24): } else if (\$('div.LC_head_subbox:first').length) {
2087:-24): header = \$('div.LC_head_subbox:first');
2088:-24): offset = 9;
2089:-24): } else {
2090:-24): if (\$('#LC_breadcrumbs').length) {
2091:-24): header = \$('#LC_breadcrumbs');
2092:-24): }
2093:-24): }
2094:-24): if (header != null && header.length) {
2095:-24): height = header.height();
2096:-24): hdrtop = header.position().top;
2097:-24): }
2098:-24): var pos = height + hdrtop + offset;
2099:-24): \$('.LC_iframecontainer').css('top', pos);
2100:-24): });
2101:-24): LCresizedef = 1;
2102:-24): if (LCnotready == 1) {
2103:-24): LCnotready = 0;
2104:-24): \$(window).trigger('resize');
2105:-24): }
2106:-24): });
2107:-24): window.onload = function(){
2108:-24): if (LCresizedef) {
2109:-24): LCnotready = 0;
2110:-24): \$(window).trigger('resize');
2111:-24): } else {
2112:-24): LCnotready = 1;
2113:-24): }
2114:-24): };
2115:-24): SCRIPT
2116:-24):
2117:-24): }
1.1075.2.112 raeburn 2118:
1.565 albertel 2119: =pod
2120:
1.256 matthew 2121: =head1 Excel and CSV file utility routines
2122:
2123: =cut
2124:
2125: ###############################################################
2126: ###############################################################
2127:
2128: =pod
2129:
1.1075.2.56 raeburn 2130: =over 4
2131:
1.648 raeburn 2132: =item * &csv_translate($text)
1.37 matthew 2133:
1.185 www 2134: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2135: format.
2136:
2137: =cut
2138:
1.180 matthew 2139: ###############################################################
2140: ###############################################################
1.37 matthew 2141: sub csv_translate {
2142: my $text = shift;
2143: $text =~ s/\"/\"\"/g;
1.209 albertel 2144: $text =~ s/\n/ /g;
1.37 matthew 2145: return $text;
2146: }
1.180 matthew 2147:
2148: ###############################################################
2149: ###############################################################
2150:
2151: =pod
2152:
1.648 raeburn 2153: =item * &define_excel_formats()
1.180 matthew 2154:
2155: Define some commonly used Excel cell formats.
2156:
2157: Currently supported formats:
2158:
2159: =over 4
2160:
2161: =item header
2162:
2163: =item bold
2164:
2165: =item h1
2166:
2167: =item h2
2168:
2169: =item h3
2170:
1.256 matthew 2171: =item h4
2172:
2173: =item i
2174:
1.180 matthew 2175: =item date
2176:
2177: =back
2178:
2179: Inputs: $workbook
2180:
2181: Returns: $format, a hash reference.
2182:
1.1057 foxr 2183:
1.180 matthew 2184: =cut
2185:
2186: ###############################################################
2187: ###############################################################
2188: sub define_excel_formats {
2189: my ($workbook) = @_;
2190: my $format;
2191: $format->{'header'} = $workbook->add_format(bold => 1,
2192: bottom => 1,
2193: align => 'center');
2194: $format->{'bold'} = $workbook->add_format(bold=>1);
2195: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2196: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2197: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2198: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2199: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2200: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2201: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2202: return $format;
2203: }
2204:
2205: ###############################################################
2206: ###############################################################
1.113 bowersj2 2207:
2208: =pod
2209:
1.648 raeburn 2210: =item * &create_workbook()
1.255 matthew 2211:
2212: Create an Excel worksheet. If it fails, output message on the
2213: request object and return undefs.
2214:
2215: Inputs: Apache request object
2216:
2217: Returns (undef) on failure,
2218: Excel worksheet object, scalar with filename, and formats
2219: from &Apache::loncommon::define_excel_formats on success
2220:
2221: =cut
2222:
2223: ###############################################################
2224: ###############################################################
2225: sub create_workbook {
2226: my ($r) = @_;
2227: #
2228: # Create the excel spreadsheet
2229: my $filename = '/prtspool/'.
1.258 albertel 2230: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2231: time.'_'.rand(1000000000).'.xls';
2232: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2233: if (! defined($workbook)) {
2234: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2235: $r->print(
2236: '<p class="LC_error">'
2237: .&mt('Problems occurred in creating the new Excel file.')
2238: .' '.&mt('This error has been logged.')
2239: .' '.&mt('Please alert your LON-CAPA administrator.')
2240: .'</p>'
2241: );
1.255 matthew 2242: return (undef);
2243: }
2244: #
1.1014 foxr 2245: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2246: #
2247: my $format = &Apache::loncommon::define_excel_formats($workbook);
2248: return ($workbook,$filename,$format);
2249: }
2250:
2251: ###############################################################
2252: ###############################################################
2253:
2254: =pod
2255:
1.648 raeburn 2256: =item * &create_text_file()
1.113 bowersj2 2257:
1.542 raeburn 2258: Create a file to write to and eventually make available to the user.
1.256 matthew 2259: If file creation fails, outputs an error message on the request object and
2260: return undefs.
1.113 bowersj2 2261:
1.256 matthew 2262: Inputs: Apache request object, and file suffix
1.113 bowersj2 2263:
1.256 matthew 2264: Returns (undef) on failure,
2265: Filehandle and filename on success.
1.113 bowersj2 2266:
2267: =cut
2268:
1.256 matthew 2269: ###############################################################
2270: ###############################################################
2271: sub create_text_file {
2272: my ($r,$suffix) = @_;
2273: if (! defined($suffix)) { $suffix = 'txt'; };
2274: my $fh;
2275: my $filename = '/prtspool/'.
1.258 albertel 2276: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2277: time.'_'.rand(1000000000).'.'.$suffix;
2278: $fh = Apache::File->new('>/home/httpd'.$filename);
2279: if (! defined($fh)) {
2280: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2281: $r->print(
2282: '<p class="LC_error">'
2283: .&mt('Problems occurred in creating the output file.')
2284: .' '.&mt('This error has been logged.')
2285: .' '.&mt('Please alert your LON-CAPA administrator.')
2286: .'</p>'
2287: );
1.113 bowersj2 2288: }
1.256 matthew 2289: return ($fh,$filename)
1.113 bowersj2 2290: }
2291:
2292:
1.256 matthew 2293: =pod
1.113 bowersj2 2294:
2295: =back
2296:
2297: =cut
1.37 matthew 2298:
2299: ###############################################################
1.33 matthew 2300: ## Home server <option> list generating code ##
2301: ###############################################################
1.35 matthew 2302:
1.169 www 2303: # ------------------------------------------
2304:
2305: sub domain_select {
2306: my ($name,$value,$multiple)=@_;
2307: my %domains=map {
1.514 albertel 2308: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2309: } &Apache::lonnet::all_domains();
1.169 www 2310: if ($multiple) {
2311: $domains{''}=&mt('Any domain');
1.550 albertel 2312: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2313: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2314: } else {
1.550 albertel 2315: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2316: return &select_form($name,$value,\%domains);
1.169 www 2317: }
2318: }
2319:
1.282 albertel 2320: #-------------------------------------------
2321:
2322: =pod
2323:
1.519 raeburn 2324: =head1 Routines for form select boxes
2325:
2326: =over 4
2327:
1.648 raeburn 2328: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2329:
2330: Returns a string containing a <select> element int multiple mode
2331:
2332:
2333: Args:
2334: $name - name of the <select> element
1.506 raeburn 2335: $value - scalar or array ref of values that should already be selected
1.282 albertel 2336: $size - number of rows long the select element is
1.283 albertel 2337: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2338: (shown text should already have been &mt())
1.506 raeburn 2339: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2340:
1.282 albertel 2341: =cut
2342:
2343: #-------------------------------------------
1.169 www 2344: sub multiple_select_form {
1.284 albertel 2345: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2346: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2347: my $output='';
1.191 matthew 2348: if (! defined($size)) {
2349: $size = 4;
1.283 albertel 2350: if (scalar(keys(%$hash))<4) {
2351: $size = scalar(keys(%$hash));
1.191 matthew 2352: }
2353: }
1.734 bisitz 2354: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2355: my @order;
1.506 raeburn 2356: if (ref($order) eq 'ARRAY') {
2357: @order = @{$order};
2358: } else {
2359: @order = sort(keys(%$hash));
1.501 banghart 2360: }
2361: if (exists($$hash{'select_form_order'})) {
2362: @order = @{$$hash{'select_form_order'}};
2363: }
2364:
1.284 albertel 2365: foreach my $key (@order) {
1.356 albertel 2366: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2367: $output.='selected="selected" ' if ($selected{$key});
2368: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2369: }
2370: $output.="</select>\n";
2371: return $output;
2372: }
2373:
1.88 www 2374: #-------------------------------------------
2375:
2376: =pod
2377:
1.1075.2.115 raeburn 2378: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2379:
2380: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2381: allow a user to select options from a ref to a hash containing:
2382: option_name => displayed text. An optional $onchange can include
1.1075.2.115 raeburn 2383: a javascript onchange item, e.g., onchange="this.form.submit();".
2384: An optional arg -- $readonly -- if true will cause the select form
2385: to be disabled, e.g., for the case where an instructor has a section-
2386: specific role, and is viewing/modifying parameters.
1.970 raeburn 2387:
1.88 www 2388: See lonrights.pm for an example invocation and use.
2389:
2390: =cut
2391:
2392: #-------------------------------------------
2393: sub select_form {
1.1075.2.115 raeburn 2394: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2395: return unless (ref($hashref) eq 'HASH');
2396: if ($onchange) {
2397: $onchange = ' onchange="'.$onchange.'"';
2398: }
1.1075.2.129 raeburn 2399: my $disabled;
2400: if ($readonly) {
2401: $disabled = ' disabled="disabled"';
2402: }
2403: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2404: my @keys;
1.970 raeburn 2405: if (exists($hashref->{'select_form_order'})) {
2406: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2407: } else {
1.970 raeburn 2408: @keys=sort(keys(%{$hashref}));
1.128 albertel 2409: }
1.356 albertel 2410: foreach my $key (@keys) {
2411: $selectform.=
2412: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2413: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2414: ">".$hashref->{$key}."</option>\n";
1.88 www 2415: }
2416: $selectform.="</select>";
2417: return $selectform;
2418: }
2419:
1.475 www 2420: # For display filters
2421:
2422: sub display_filter {
1.1074 raeburn 2423: my ($context) = @_;
1.475 www 2424: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2425: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2426: my $phraseinput = 'hidden';
2427: my $includeinput = 'hidden';
2428: my ($checked,$includetypestext);
2429: if ($env{'form.displayfilter'} eq 'containing') {
2430: $phraseinput = 'text';
2431: if ($context eq 'parmslog') {
2432: $includeinput = 'checkbox';
2433: if ($env{'form.includetypes'}) {
2434: $checked = ' checked="checked"';
2435: }
2436: $includetypestext = &mt('Include parameter types');
2437: }
2438: } else {
2439: $includetypestext = ' ';
2440: }
2441: my ($additional,$secondid,$thirdid);
2442: if ($context eq 'parmslog') {
2443: $additional =
2444: '<label><input type="'.$includeinput.'" name="includetypes"'.
2445: $checked.' name="includetypes" value="1" id="includetypes" />'.
2446: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2447: '</label>';
2448: $secondid = 'includetypes';
2449: $thirdid = 'includetypestext';
2450: }
2451: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2452: '$secondid','$thirdid')";
2453: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2454: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2455: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2456: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2457: &mt('Filter: [_1]',
1.477 www 2458: &select_form($env{'form.displayfilter'},
2459: 'displayfilter',
1.970 raeburn 2460: {'currentfolder' => 'Current folder/page',
1.477 www 2461: 'containing' => 'Containing phrase',
1.1074 raeburn 2462: 'none' => 'None'},$onchange)).' '.
2463: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2464: &HTML::Entities::encode($env{'form.containingphrase'}).
2465: '" />'.$additional;
2466: }
2467:
2468: sub display_filter_js {
2469: my $includetext = &mt('Include parameter types');
2470: return <<"ENDJS";
2471:
2472: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2473: var firstType = 'hidden';
2474: if (setter.options[setter.selectedIndex].value == 'containing') {
2475: firstType = 'text';
2476: }
2477: firstObject = document.getElementById(firstid);
2478: if (typeof(firstObject) == 'object') {
2479: if (firstObject.type != firstType) {
2480: changeInputType(firstObject,firstType);
2481: }
2482: }
2483: if (context == 'parmslog') {
2484: var secondType = 'hidden';
2485: if (firstType == 'text') {
2486: secondType = 'checkbox';
2487: }
2488: secondObject = document.getElementById(secondid);
2489: if (typeof(secondObject) == 'object') {
2490: if (secondObject.type != secondType) {
2491: changeInputType(secondObject,secondType);
2492: }
2493: }
2494: var textItem = document.getElementById(thirdid);
2495: var currtext = textItem.innerHTML;
2496: var newtext;
2497: if (firstType == 'text') {
2498: newtext = '$includetext';
2499: } else {
2500: newtext = ' ';
2501: }
2502: if (currtext != newtext) {
2503: textItem.innerHTML = newtext;
2504: }
2505: }
2506: return;
2507: }
2508:
2509: function changeInputType(oldObject,newType) {
2510: var newObject = document.createElement('input');
2511: newObject.type = newType;
2512: if (oldObject.size) {
2513: newObject.size = oldObject.size;
2514: }
2515: if (oldObject.value) {
2516: newObject.value = oldObject.value;
2517: }
2518: if (oldObject.name) {
2519: newObject.name = oldObject.name;
2520: }
2521: if (oldObject.id) {
2522: newObject.id = oldObject.id;
2523: }
2524: oldObject.parentNode.replaceChild(newObject,oldObject);
2525: return;
2526: }
2527:
2528: ENDJS
1.475 www 2529: }
2530:
1.167 www 2531: sub gradeleveldescription {
2532: my $gradelevel=shift;
2533: my %gradelevels=(0 => 'Not specified',
2534: 1 => 'Grade 1',
2535: 2 => 'Grade 2',
2536: 3 => 'Grade 3',
2537: 4 => 'Grade 4',
2538: 5 => 'Grade 5',
2539: 6 => 'Grade 6',
2540: 7 => 'Grade 7',
2541: 8 => 'Grade 8',
2542: 9 => 'Grade 9',
2543: 10 => 'Grade 10',
2544: 11 => 'Grade 11',
2545: 12 => 'Grade 12',
2546: 13 => 'Grade 13',
2547: 14 => '100 Level',
2548: 15 => '200 Level',
2549: 16 => '300 Level',
2550: 17 => '400 Level',
2551: 18 => 'Graduate Level');
2552: return &mt($gradelevels{$gradelevel});
2553: }
2554:
1.163 www 2555: sub select_level_form {
2556: my ($deflevel,$name)=@_;
2557: unless ($deflevel) { $deflevel=0; }
1.167 www 2558: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2559: for (my $i=0; $i<=18; $i++) {
2560: $selectform.="<option value=\"$i\" ".
1.253 albertel 2561: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2562: ">".&gradeleveldescription($i)."</option>\n";
2563: }
2564: $selectform.="</select>";
2565: return $selectform;
1.163 www 2566: }
1.167 www 2567:
1.35 matthew 2568: #-------------------------------------------
2569:
1.45 matthew 2570: =pod
2571:
1.1075.2.115 raeburn 2572: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2573:
2574: Returns a string containing a <select name='$name' size='1'> form to
2575: allow a user to select the domain to preform an operation in.
2576: See loncreateuser.pm for an example invocation and use.
2577:
1.90 www 2578: If the $includeempty flag is set, it also includes an empty choice ("no domain
2579: selected");
2580:
1.743 raeburn 2581: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2582:
1.910 raeburn 2583: 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.
2584:
1.1075.2.36 raeburn 2585: The optional $incdoms is a reference to an array of domains which will be the only available options.
2586:
1.1075.2.115 raeburn 2587: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
2588:
2589: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
1.563 raeburn 2590:
1.35 matthew 2591: =cut
2592:
2593: #-------------------------------------------
1.34 matthew 2594: sub select_dom_form {
1.1075.2.115 raeburn 2595: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2596: if ($onchange) {
1.874 raeburn 2597: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2598: }
1.1075.2.115 raeburn 2599: if ($disabled) {
2600: $disabled = ' disabled="disabled"';
2601: }
1.1075.2.36 raeburn 2602: my (@domains,%exclude);
1.910 raeburn 2603: if (ref($incdoms) eq 'ARRAY') {
2604: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2605: } else {
2606: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2607: }
1.90 www 2608: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2609: if (ref($excdoms) eq 'ARRAY') {
2610: map { $exclude{$_} = 1; } @{$excdoms};
2611: }
1.1075.2.115 raeburn 2612: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2613: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2614: next if ($exclude{$dom});
1.356 albertel 2615: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2616: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2617: if ($showdomdesc) {
2618: if ($dom ne '') {
2619: my $domdesc = &Apache::lonnet::domain($dom,'description');
2620: if ($domdesc ne '') {
2621: $selectdomain .= ' ('.$domdesc.')';
2622: }
2623: }
2624: }
2625: $selectdomain .= "</option>\n";
1.34 matthew 2626: }
2627: $selectdomain.="</select>";
2628: return $selectdomain;
2629: }
2630:
1.35 matthew 2631: #-------------------------------------------
2632:
1.45 matthew 2633: =pod
2634:
1.648 raeburn 2635: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2636:
1.586 raeburn 2637: input: 4 arguments (two required, two optional) -
2638: $domain - domain of new user
2639: $name - name of form element
2640: $default - Value of 'default' causes a default item to be first
2641: option, and selected by default.
2642: $hide - Value of 'hide' causes hiding of the name of the server,
2643: if 1 server found, or default, if 0 found.
1.594 raeburn 2644: output: returns 2 items:
1.586 raeburn 2645: (a) form element which contains either:
2646: (i) <select name="$name">
2647: <option value="$hostid1">$hostid $servers{$hostid}</option>
2648: <option value="$hostid2">$hostid $servers{$hostid}</option>
2649: </select>
2650: form item if there are multiple library servers in $domain, or
2651: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2652: if there is only one library server in $domain.
2653:
2654: (b) number of library servers found.
2655:
2656: See loncreateuser.pm for example of use.
1.35 matthew 2657:
2658: =cut
2659:
2660: #-------------------------------------------
1.586 raeburn 2661: sub home_server_form_item {
2662: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2663: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2664: my $result;
2665: my $numlib = keys(%servers);
2666: if ($numlib > 1) {
2667: $result .= '<select name="'.$name.'" />'."\n";
2668: if ($default) {
1.804 bisitz 2669: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2670: '</option>'."\n";
2671: }
2672: foreach my $hostid (sort(keys(%servers))) {
2673: $result.= '<option value="'.$hostid.'">'.
2674: $hostid.' '.$servers{$hostid}."</option>\n";
2675: }
2676: $result .= '</select>'."\n";
2677: } elsif ($numlib == 1) {
2678: my $hostid;
2679: foreach my $item (keys(%servers)) {
2680: $hostid = $item;
2681: }
2682: $result .= '<input type="hidden" name="'.$name.'" value="'.
2683: $hostid.'" />';
2684: if (!$hide) {
2685: $result .= $hostid.' '.$servers{$hostid};
2686: }
2687: $result .= "\n";
2688: } elsif ($default) {
2689: $result .= '<input type="hidden" name="'.$name.
2690: '" value="default" />';
2691: if (!$hide) {
2692: $result .= &mt('default');
2693: }
2694: $result .= "\n";
1.33 matthew 2695: }
1.586 raeburn 2696: return ($result,$numlib);
1.33 matthew 2697: }
1.112 bowersj2 2698:
2699: =pod
2700:
1.534 albertel 2701: =back
2702:
1.112 bowersj2 2703: =cut
1.87 matthew 2704:
2705: ###############################################################
1.112 bowersj2 2706: ## Decoding User Agent ##
1.87 matthew 2707: ###############################################################
2708:
2709: =pod
2710:
1.112 bowersj2 2711: =head1 Decoding the User Agent
2712:
2713: =over 4
2714:
2715: =item * &decode_user_agent()
1.87 matthew 2716:
2717: Inputs: $r
2718:
2719: Outputs:
2720:
2721: =over 4
2722:
1.112 bowersj2 2723: =item * $httpbrowser
1.87 matthew 2724:
1.112 bowersj2 2725: =item * $clientbrowser
1.87 matthew 2726:
1.112 bowersj2 2727: =item * $clientversion
1.87 matthew 2728:
1.112 bowersj2 2729: =item * $clientmathml
1.87 matthew 2730:
1.112 bowersj2 2731: =item * $clientunicode
1.87 matthew 2732:
1.112 bowersj2 2733: =item * $clientos
1.87 matthew 2734:
1.1075.2.42 raeburn 2735: =item * $clientmobile
2736:
2737: =item * $clientinfo
2738:
1.1075.2.77 raeburn 2739: =item * $clientosversion
2740:
1.87 matthew 2741: =back
2742:
1.157 matthew 2743: =back
2744:
1.87 matthew 2745: =cut
2746:
2747: ###############################################################
2748: ###############################################################
2749: sub decode_user_agent {
1.247 albertel 2750: my ($r)=@_;
1.87 matthew 2751: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2752: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2753: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2754: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2755: my $clientbrowser='unknown';
2756: my $clientversion='0';
2757: my $clientmathml='';
2758: my $clientunicode='0';
1.1075.2.42 raeburn 2759: my $clientmobile=0;
1.1075.2.77 raeburn 2760: my $clientosversion='';
1.87 matthew 2761: for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76 raeburn 2762: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2763: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2764: $clientbrowser=$bname;
2765: $httpbrowser=~/$vreg/i;
2766: $clientversion=$1;
2767: $clientmathml=($clientversion>=$minv);
2768: $clientunicode=($clientversion>=$univ);
2769: }
2770: }
2771: my $clientos='unknown';
1.1075.2.42 raeburn 2772: my $clientinfo;
1.87 matthew 2773: if (($httpbrowser=~/linux/i) ||
2774: ($httpbrowser=~/unix/i) ||
2775: ($httpbrowser=~/ux/i) ||
2776: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2777: if (($httpbrowser=~/vax/i) ||
2778: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2779: if ($httpbrowser=~/next/i) { $clientos='next'; }
2780: if (($httpbrowser=~/mac/i) ||
2781: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77 raeburn 2782: if ($httpbrowser=~/win/i) {
2783: $clientos='win';
2784: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2785: $clientosversion = $1;
2786: }
2787: }
1.87 matthew 2788: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2789: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2790: $clientmobile=lc($1);
2791: }
2792: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2793: $clientinfo = 'firefox-'.$1;
2794: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2795: $clientinfo = 'chromeframe-'.$1;
2796: }
1.87 matthew 2797: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77 raeburn 2798: $clientunicode,$clientos,$clientmobile,$clientinfo,
2799: $clientosversion);
1.87 matthew 2800: }
2801:
1.32 matthew 2802: ###############################################################
2803: ## Authentication changing form generation subroutines ##
2804: ###############################################################
2805: ##
2806: ## All of the authform_xxxxxxx subroutines take their inputs in a
2807: ## hash, and have reasonable default values.
2808: ##
2809: ## formname = the name given in the <form> tag.
1.35 matthew 2810: #-------------------------------------------
2811:
1.45 matthew 2812: =pod
2813:
1.112 bowersj2 2814: =head1 Authentication Routines
2815:
2816: =over 4
2817:
1.648 raeburn 2818: =item * &authform_xxxxxx()
1.35 matthew 2819:
2820: The authform_xxxxxx subroutines provide javascript and html forms which
2821: handle some of the conveniences required for authentication forms.
2822: This is not an optimal method, but it works.
2823:
2824: =over 4
2825:
1.112 bowersj2 2826: =item * authform_header
1.35 matthew 2827:
1.112 bowersj2 2828: =item * authform_authorwarning
1.35 matthew 2829:
1.112 bowersj2 2830: =item * authform_nochange
1.35 matthew 2831:
1.112 bowersj2 2832: =item * authform_kerberos
1.35 matthew 2833:
1.112 bowersj2 2834: =item * authform_internal
1.35 matthew 2835:
1.112 bowersj2 2836: =item * authform_filesystem
1.35 matthew 2837:
1.1075.2.161. .17(raeb 2838:-23): =item * authform_lti
2839:-23):
1.35 matthew 2840: =back
2841:
1.648 raeburn 2842: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2843:
1.35 matthew 2844: =cut
2845:
2846: #-------------------------------------------
1.32 matthew 2847: sub authform_header{
2848: my %in = (
2849: formname => 'cu',
1.80 albertel 2850: kerb_def_dom => '',
1.32 matthew 2851: @_,
2852: );
2853: $in{'formname'} = 'document.' . $in{'formname'};
2854: my $result='';
1.80 albertel 2855:
2856: #---------------------------------------------- Code for upper case translation
2857: my $Javascript_toUpperCase;
2858: unless ($in{kerb_def_dom}) {
2859: $Javascript_toUpperCase =<<"END";
2860: switch (choice) {
2861: case 'krb': currentform.elements[choicearg].value =
2862: currentform.elements[choicearg].value.toUpperCase();
2863: break;
2864: default:
2865: }
2866: END
2867: } else {
2868: $Javascript_toUpperCase = "";
2869: }
2870:
1.165 raeburn 2871: my $radioval = "'nochange'";
1.591 raeburn 2872: if (defined($in{'curr_authtype'})) {
2873: if ($in{'curr_authtype'} ne '') {
2874: $radioval = "'".$in{'curr_authtype'}."arg'";
2875: }
1.174 matthew 2876: }
1.165 raeburn 2877: my $argfield = 'null';
1.591 raeburn 2878: if (defined($in{'mode'})) {
1.165 raeburn 2879: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2880: if (defined($in{'curr_autharg'})) {
2881: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2882: $argfield = "'$in{'curr_autharg'}'";
2883: }
2884: }
2885: }
2886: }
2887:
1.32 matthew 2888: $result.=<<"END";
2889: var current = new Object();
1.165 raeburn 2890: current.radiovalue = $radioval;
2891: current.argfield = $argfield;
1.32 matthew 2892:
2893: function changed_radio(choice,currentform) {
2894: var choicearg = choice + 'arg';
2895: // If a radio button in changed, we need to change the argfield
2896: if (current.radiovalue != choice) {
2897: current.radiovalue = choice;
2898: if (current.argfield != null) {
2899: currentform.elements[current.argfield].value = '';
2900: }
2901: if (choice == 'nochange') {
2902: current.argfield = null;
2903: } else {
2904: current.argfield = choicearg;
2905: switch(choice) {
2906: case 'krb':
2907: currentform.elements[current.argfield].value =
2908: "$in{'kerb_def_dom'}";
2909: break;
2910: default:
2911: break;
2912: }
2913: }
2914: }
2915: return;
2916: }
1.22 www 2917:
1.32 matthew 2918: function changed_text(choice,currentform) {
2919: var choicearg = choice + 'arg';
2920: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2921: $Javascript_toUpperCase
1.32 matthew 2922: // clear old field
2923: if ((current.argfield != choicearg) && (current.argfield != null)) {
2924: currentform.elements[current.argfield].value = '';
2925: }
2926: current.argfield = choicearg;
2927: }
2928: set_auth_radio_buttons(choice,currentform);
2929: return;
1.20 www 2930: }
1.32 matthew 2931:
2932: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2933: var numauthchoices = currentform.login.length;
2934: if (typeof numauthchoices == "undefined") {
2935: return;
2936: }
1.32 matthew 2937: var i=0;
1.986 raeburn 2938: while (i < numauthchoices) {
1.32 matthew 2939: if (currentform.login[i].value == newvalue) { break; }
2940: i++;
2941: }
1.986 raeburn 2942: if (i == numauthchoices) {
1.32 matthew 2943: return;
2944: }
2945: current.radiovalue = newvalue;
2946: currentform.login[i].checked = true;
2947: return;
2948: }
2949: END
2950: return $result;
2951: }
2952:
1.1075.2.20 raeburn 2953: sub authform_authorwarning {
1.32 matthew 2954: my $result='';
1.144 matthew 2955: $result='<i>'.
2956: &mt('As a general rule, only authors or co-authors should be '.
2957: 'filesystem authenticated '.
2958: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2959: return $result;
2960: }
2961:
1.1075.2.20 raeburn 2962: sub authform_nochange {
1.32 matthew 2963: my %in = (
2964: formname => 'document.cu',
2965: kerb_def_dom => 'MSU.EDU',
2966: @_,
2967: );
1.1075.2.20 raeburn 2968: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2969: my $result;
1.1075.2.20 raeburn 2970: if (!$authnum) {
2971: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2972: } else {
2973: $result = '<label>'.&mt('[_1] Do not change login data',
2974: '<input type="radio" name="login" value="nochange" '.
2975: 'checked="checked" onclick="'.
1.281 albertel 2976: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2977: '</label>';
1.586 raeburn 2978: }
1.32 matthew 2979: return $result;
2980: }
2981:
1.591 raeburn 2982: sub authform_kerberos {
1.32 matthew 2983: my %in = (
2984: formname => 'document.cu',
2985: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2986: kerb_def_auth => 'krb4',
1.32 matthew 2987: @_,
2988: );
1.586 raeburn 2989: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1075.2.117 raeburn 2990: $autharg,$jscall,$disabled);
1.1075.2.20 raeburn 2991: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2992: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2993: $check5 = ' checked="checked"';
1.80 albertel 2994: } else {
1.772 bisitz 2995: $check4 = ' checked="checked"';
1.80 albertel 2996: }
1.1075.2.117 raeburn 2997: if ($in{'readonly'}) {
2998: $disabled = ' disabled="disabled"';
2999: }
1.165 raeburn 3000: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 3001: if (defined($in{'curr_authtype'})) {
3002: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 3003: $krbcheck = ' checked="checked"';
1.623 raeburn 3004: if (defined($in{'mode'})) {
3005: if ($in{'mode'} eq 'modifyuser') {
3006: $krbcheck = '';
3007: }
3008: }
1.591 raeburn 3009: if (defined($in{'curr_kerb_ver'})) {
3010: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 3011: $check5 = ' checked="checked"';
1.591 raeburn 3012: $check4 = '';
3013: } else {
1.772 bisitz 3014: $check4 = ' checked="checked"';
1.591 raeburn 3015: $check5 = '';
3016: }
1.586 raeburn 3017: }
1.591 raeburn 3018: if (defined($in{'curr_autharg'})) {
1.165 raeburn 3019: $krbarg = $in{'curr_autharg'};
3020: }
1.586 raeburn 3021: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 3022: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3023: $result =
3024: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
3025: $in{'curr_autharg'},$krbver);
3026: } else {
3027: $result =
3028: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
3029: }
3030: return $result;
3031: }
3032: }
3033: } else {
3034: if ($authnum == 1) {
1.784 bisitz 3035: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 3036: }
3037: }
1.586 raeburn 3038: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
3039: return;
1.587 raeburn 3040: } elsif ($authtype eq '') {
1.591 raeburn 3041: if (defined($in{'mode'})) {
1.587 raeburn 3042: if ($in{'mode'} eq 'modifycourse') {
3043: if ($authnum == 1) {
1.1075.2.117 raeburn 3044: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 3045: }
3046: }
3047: }
1.586 raeburn 3048: }
3049: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
3050: if ($authtype eq '') {
3051: $authtype = '<input type="radio" name="login" value="krb" '.
3052: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1075.2.117 raeburn 3053: $krbcheck.$disabled.' />';
1.586 raeburn 3054: }
3055: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 3056: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 3057: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 3058: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 3059: $in{'curr_authtype'} eq 'krb4')) {
3060: $result .= &mt
1.144 matthew 3061: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 3062: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 3063: '<label>'.$authtype,
1.281 albertel 3064: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 3065: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 3066: 'onchange="'.$jscall.'"'.$disabled.' />',
3067: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
3068: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 3069: '</label>');
1.586 raeburn 3070: } elsif ($can_assign{'krb4'}) {
3071: $result .= &mt
3072: ('[_1] Kerberos authenticated with domain [_2] '.
3073: '[_3] Version 4 [_4]',
3074: '<label>'.$authtype,
3075: '</label><input type="text" size="10" name="krbarg" '.
3076: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 3077: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3078: '<label><input type="hidden" name="krbver" value="4" />',
3079: '</label>');
3080: } elsif ($can_assign{'krb5'}) {
3081: $result .= &mt
3082: ('[_1] Kerberos authenticated with domain [_2] '.
3083: '[_3] Version 5 [_4]',
3084: '<label>'.$authtype,
3085: '</label><input type="text" size="10" name="krbarg" '.
3086: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 3087: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 3088: '<label><input type="hidden" name="krbver" value="5" />',
3089: '</label>');
3090: }
1.32 matthew 3091: return $result;
3092: }
3093:
1.1075.2.20 raeburn 3094: sub authform_internal {
1.586 raeburn 3095: my %in = (
1.32 matthew 3096: formname => 'document.cu',
3097: kerb_def_dom => 'MSU.EDU',
3098: @_,
3099: );
1.1075.2.117 raeburn 3100: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3101: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3102: if ($in{'readonly'}) {
3103: $disabled = ' disabled="disabled"';
3104: }
1.591 raeburn 3105: if (defined($in{'curr_authtype'})) {
3106: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 3107: if ($can_assign{'int'}) {
1.772 bisitz 3108: $intcheck = 'checked="checked" ';
1.623 raeburn 3109: if (defined($in{'mode'})) {
3110: if ($in{'mode'} eq 'modifyuser') {
3111: $intcheck = '';
3112: }
3113: }
1.591 raeburn 3114: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3115: $intarg = $in{'curr_autharg'};
3116: }
3117: } else {
3118: $result = &mt('Currently internally authenticated.');
3119: return $result;
1.165 raeburn 3120: }
3121: }
1.586 raeburn 3122: } else {
3123: if ($authnum == 1) {
1.784 bisitz 3124: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 3125: }
3126: }
3127: if (!$can_assign{'int'}) {
3128: return;
1.587 raeburn 3129: } elsif ($authtype eq '') {
1.591 raeburn 3130: if (defined($in{'mode'})) {
1.587 raeburn 3131: if ($in{'mode'} eq 'modifycourse') {
3132: if ($authnum == 1) {
1.1075.2.117 raeburn 3133: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3134: }
3135: }
3136: }
1.165 raeburn 3137: }
1.586 raeburn 3138: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3139: if ($authtype eq '') {
3140: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1075.2.117 raeburn 3141: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3142: }
1.605 bisitz 3143: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1075.2.117 raeburn 3144: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3145: $result = &mt
1.144 matthew 3146: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3147: '<label>'.$authtype,'</label>'.$autharg);
1.1075.2.118 raeburn 3148: $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 3149: return $result;
3150: }
3151:
1.1075.2.20 raeburn 3152: sub authform_local {
1.32 matthew 3153: my %in = (
3154: formname => 'document.cu',
3155: kerb_def_dom => 'MSU.EDU',
3156: @_,
3157: );
1.1075.2.117 raeburn 3158: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3159: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3160: if ($in{'readonly'}) {
3161: $disabled = ' disabled="disabled"';
3162: }
1.591 raeburn 3163: if (defined($in{'curr_authtype'})) {
3164: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3165: if ($can_assign{'loc'}) {
1.772 bisitz 3166: $loccheck = 'checked="checked" ';
1.623 raeburn 3167: if (defined($in{'mode'})) {
3168: if ($in{'mode'} eq 'modifyuser') {
3169: $loccheck = '';
3170: }
3171: }
1.591 raeburn 3172: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3173: $locarg = $in{'curr_autharg'};
3174: }
3175: } else {
3176: $result = &mt('Currently using local (institutional) authentication.');
3177: return $result;
1.165 raeburn 3178: }
3179: }
1.586 raeburn 3180: } else {
3181: if ($authnum == 1) {
1.784 bisitz 3182: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3183: }
3184: }
3185: if (!$can_assign{'loc'}) {
3186: return;
1.587 raeburn 3187: } elsif ($authtype eq '') {
1.591 raeburn 3188: if (defined($in{'mode'})) {
1.587 raeburn 3189: if ($in{'mode'} eq 'modifycourse') {
3190: if ($authnum == 1) {
1.1075.2.117 raeburn 3191: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3192: }
3193: }
3194: }
1.165 raeburn 3195: }
1.586 raeburn 3196: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3197: if ($authtype eq '') {
3198: $authtype = '<input type="radio" name="login" value="loc" '.
3199: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117 raeburn 3200: $jscall.'"'.$disabled.' />';
1.586 raeburn 3201: }
3202: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1075.2.117 raeburn 3203: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3204: $result = &mt('[_1] Local Authentication with argument [_2]',
3205: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3206: return $result;
3207: }
3208:
1.1075.2.20 raeburn 3209: sub authform_filesystem {
1.32 matthew 3210: my %in = (
3211: formname => 'document.cu',
3212: kerb_def_dom => 'MSU.EDU',
3213: @_,
3214: );
1.1075.2.117 raeburn 3215: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3216: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3217: if ($in{'readonly'}) {
3218: $disabled = ' disabled="disabled"';
3219: }
1.591 raeburn 3220: if (defined($in{'curr_authtype'})) {
3221: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3222: if ($can_assign{'fsys'}) {
1.772 bisitz 3223: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3224: if (defined($in{'mode'})) {
3225: if ($in{'mode'} eq 'modifyuser') {
3226: $fsyscheck = '';
3227: }
3228: }
1.586 raeburn 3229: } else {
3230: $result = &mt('Currently Filesystem Authenticated.');
3231: return $result;
3232: }
3233: }
3234: } else {
3235: if ($authnum == 1) {
1.784 bisitz 3236: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3237: }
3238: }
3239: if (!$can_assign{'fsys'}) {
3240: return;
1.587 raeburn 3241: } elsif ($authtype eq '') {
1.591 raeburn 3242: if (defined($in{'mode'})) {
1.587 raeburn 3243: if ($in{'mode'} eq 'modifycourse') {
3244: if ($authnum == 1) {
1.1075.2.117 raeburn 3245: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3246: }
3247: }
3248: }
1.586 raeburn 3249: }
3250: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3251: if ($authtype eq '') {
3252: $authtype = '<input type="radio" name="login" value="fsys" '.
3253: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117 raeburn 3254: $jscall.'"'.$disabled.' />';
1.586 raeburn 3255: }
1.1075.2.158 raeburn 3256: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1075.2.117 raeburn 3257: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3258: $result = &mt
1.144 matthew 3259: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1075.2.158 raeburn 3260: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3261: return $result;
3262: }
3263:
1.1075.2.161. .17(raeb 3264:-23): sub authform_lti {
3265:-23): my %in = (
3266:-23): formname => 'document.cu',
3267:-23): kerb_def_dom => 'MSU.EDU',
3268:-23): @_,
3269:-23): );
3270:-23): my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
3271:-23): my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
3272:-23): if ($in{'readonly'}) {
3273:-23): $disabled = ' disabled="disabled"';
3274:-23): }
3275:-23): if (defined($in{'curr_authtype'})) {
3276:-23): if ($in{'curr_authtype'} eq 'lti') {
3277:-23): if ($can_assign{'lti'}) {
3278:-23): $lticheck = 'checked="checked" ';
3279:-23): if (defined($in{'mode'})) {
3280:-23): if ($in{'mode'} eq 'modifyuser') {
3281:-23): $lticheck = '';
3282:-23): }
3283:-23): }
3284:-23): } else {
3285:-23): $result = &mt('Currently LTI Authenticated.');
3286:-23): return $result;
3287:-23): }
3288:-23): }
3289:-23): } else {
3290:-23): if ($authnum == 1) {
3291:-23): $authtype = '<input type="hidden" name="login" value="lti" />';
3292:-23): }
3293:-23): }
3294:-23): if (!$can_assign{'lti'}) {
3295:-23): return;
3296:-23): } elsif ($authtype eq '') {
3297:-23): if (defined($in{'mode'})) {
3298:-23): if ($in{'mode'} eq 'modifycourse') {
3299:-23): if ($authnum == 1) {
3300:-23): $authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
3301:-23): }
3302:-23): }
3303:-23): }
3304:-23): }
3305:-23): $jscall = "javascript:changed_radio('lti',$in{'formname'});";
3306:-23): if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) {
3307:-23): $authtype = '<input type="radio" name="login" value="lti" '.
3308:-23): $lticheck.' onchange="'.$jscall.'" onclick="'.
3309:-23): $jscall.'"'.$disabled.' />';
3310:-23): }
3311:-23): $autharg = '<input type="hidden" name="ltiarg" value="" />';
3312:-23): if ($authtype) {
3313:-23): $result = &mt('[_1] LTI Authenticated',
3314:-23): '<label>'.$authtype.'</label>'.$autharg);
3315:-23): } else {
3316:-23): $result = '<b>'.&mt('LTI Authenticated').'</b>'.
3317:-23): $autharg;
3318:-23): }
3319:-23): return $result;
3320:-23): }
3321:-23):
1.586 raeburn 3322: sub get_assignable_auth {
3323: my ($dom) = @_;
3324: if ($dom eq '') {
3325: $dom = $env{'request.role.domain'};
3326: }
3327: my %can_assign = (
3328: krb4 => 1,
3329: krb5 => 1,
3330: int => 1,
3331: loc => 1,
3332: );
3333: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3334: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3335: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3336: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3337: my $context;
3338: if ($env{'request.role'} =~ /^au/) {
3339: $context = 'author';
1.1075.2.117 raeburn 3340: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3341: $context = 'domain';
3342: } elsif ($env{'request.course.id'}) {
3343: $context = 'course';
3344: }
3345: if ($context) {
3346: if (ref($authhash->{$context}) eq 'HASH') {
3347: %can_assign = %{$authhash->{$context}};
3348: }
3349: }
3350: }
3351: }
3352: my $authnum = 0;
3353: foreach my $key (keys(%can_assign)) {
3354: if ($can_assign{$key}) {
3355: $authnum ++;
3356: }
3357: }
3358: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3359: $authnum --;
3360: }
3361: return ($authnum,%can_assign);
3362: }
3363:
1.1075.2.137 raeburn 3364: sub check_passwd_rules {
3365: my ($domain,$plainpass) = @_;
3366: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3367: my ($min,$max,@chars,@brokerule,$warning);
1.1075.2.138 raeburn 3368: $min = $Apache::lonnet::passwdmin;
1.1075.2.137 raeburn 3369: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3370: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1075.2.138 raeburn 3371: if ($passwdconf{'min'} > $min) {
3372: $min = $passwdconf{'min'};
3373: }
1.1075.2.137 raeburn 3374: }
3375: if ($passwdconf{'max'} =~ /^\d+$/) {
3376: $max = $passwdconf{'max'};
3377: }
3378: @chars = @{$passwdconf{'chars'}};
3379: }
3380: if (($min) && (length($plainpass) < $min)) {
3381: push(@brokerule,'min');
3382: }
3383: if (($max) && (length($plainpass) > $max)) {
3384: push(@brokerule,'max');
3385: }
3386: if (@chars) {
3387: my %rules;
3388: map { $rules{$_} = 1; } @chars;
3389: if ($rules{'uc'}) {
3390: unless ($plainpass =~ /[A-Z]/) {
3391: push(@brokerule,'uc');
3392: }
3393: }
3394: if ($rules{'lc'}) {
3395: unless ($plainpass =~ /[a-z]/) {
3396: push(@brokerule,'lc');
3397: }
3398: }
3399: if ($rules{'num'}) {
3400: unless ($plainpass =~ /\d/) {
3401: push(@brokerule,'num');
3402: }
3403: }
3404: if ($rules{'spec'}) {
3405: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3406: push(@brokerule,'spec');
3407: }
3408: }
3409: }
3410: if (@brokerule) {
3411: my %rulenames = &Apache::lonlocal::texthash(
3412: uc => 'At least one upper case letter',
3413: lc => 'At least one lower case letter',
3414: num => 'At least one number',
3415: spec => 'At least one non-alphanumeric',
3416: );
3417: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3418: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3419: $rulenames{'num'} .= ': 0123456789';
3420: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3421: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3422: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3423: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1075.2.143 raeburn 3424: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1075.2.137 raeburn 3425: if (grep(/^$rule$/,@brokerule)) {
3426: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3427: }
3428: }
3429: $warning .= '</ul>';
3430: }
3431: if (wantarray) {
3432: return @brokerule;
3433: }
3434: return $warning;
3435: }
3436:
1.1075.2.161. .5(raebu 3437:22): sub passwd_validation_js {
3438:22): my ($currpasswdval,$domain,$context,$id) = @_;
3439:22): my (%passwdconf,$alertmsg);
3440:22): if ($context eq 'linkprot') {
3441:22): my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain);
3442:22): if (ref($domconfig{'ltisec'}) eq 'HASH') {
3443:22): if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') {
3444:22): %passwdconf = %{$domconfig{'ltisec'}{'rules'}};
3445:22): }
3446:22): }
3447:22): if ($id eq 'add') {
3448:22): $alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n';
3449:22): } elsif ($id =~ /^\d+$/) {
3450:22): my $pos = $id+1;
3451:22): $alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3452:22): } else {
3453:22): $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3454:22): }
.27(raeb 3455:-24): } elsif ($context eq 'ltitools') {
3456:-24): my %domconfig = &Apache::lonnet::get_dom('configuration',['toolsec'],$domain);
3457:-24): if (ref($domconfig{'toolsec'}) eq 'HASH') {
3458:-24): if (ref($domconfig{'toolsec'}{'rules'}) eq 'HASH') {
3459:-24): %passwdconf = %{$domconfig{'toolsec'}{'rules'}};
3460:-24): }
3461:-24): }
3462:-24): if ($id eq 'add') {
3463:-24): $alertmsg = &mt('Secret for added external tool did not satisfy requirement(s):').'\n\n';
3464:-24): } elsif ($id =~ /^\d+$/) {
3465:-24): my $pos = $id+1;
3466:-24): $alertmsg = &mt('Secret for external tool [_1] did not satisfy requirement(s):','#'.$pos).'\n\n';
3467:-24): } else {
3468:-24): $alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n';
3469:-24): }
.5(raebu 3470:22): } else {
3471:22): %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3472:22): $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
3473:22): }
3474:22): my ($min,$max,@chars,$numrules,$intargjs,%alert);
3475:22): $numrules = 0;
3476:22): $min = $Apache::lonnet::passwdmin;
3477:22): if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3478:22): if ($passwdconf{'min'} =~ /^\d+$/) {
3479:22): if ($passwdconf{'min'} > $min) {
3480:22): $min = $passwdconf{'min'};
3481:22): }
3482:22): }
3483:22): if ($passwdconf{'max'} =~ /^\d+$/) {
3484:22): $max = $passwdconf{'max'};
3485:22): $numrules ++;
3486:22): }
3487:22): @chars = @{$passwdconf{'chars'}};
3488:22): if (@chars) {
3489:22): $numrules ++;
3490:22): }
3491:22): }
3492:22): if ($min > 0) {
3493:22): $numrules ++;
3494:22): }
3495:22): if (($min > 0) || ($max ne '') || (@chars > 0)) {
3496:22): if ($min) {
3497:22): $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
3498:22): }
3499:22): if ($max) {
3500:22): $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
3501:22): }
3502:22): my (@charalerts,@charrules);
3503:22): if (@chars) {
3504:22): if (grep(/^uc$/,@chars)) {
3505:22): push(@charalerts,&mt('contain at least one upper case letter'));
3506:22): push(@charrules,'uc');
3507:22): }
3508:22): if (grep(/^lc$/,@chars)) {
3509:22): push(@charalerts,&mt('contain at least one lower case letter'));
3510:22): push(@charrules,'lc');
3511:22): }
3512:22): if (grep(/^num$/,@chars)) {
3513:22): push(@charalerts,&mt('contain at least one number'));
3514:22): push(@charrules,'num');
3515:22): }
3516:22): if (grep(/^spec$/,@chars)) {
3517:22): push(@charalerts,&mt('contain at least one non-alphanumeric'));
3518:22): push(@charrules,'spec');
3519:22): }
3520:22): }
3521:22): $intargjs = qq| var rulesmsg = '';\n|.
3522:22): qq| var currpwval = $currpasswdval;\n|;
3523:22): if ($min) {
3524:22): $intargjs .= qq|
3525:22): if (currpwval.length < $min) {
3526:22): rulesmsg += ' - $alert{min}';
3527:22): }
3528:22): |;
3529:22): }
3530:22): if ($max) {
3531:22): $intargjs .= qq|
3532:22): if (currpwval.length > $max) {
3533:22): rulesmsg += ' - $alert{max}';
3534:22): }
3535:22): |;
3536:22): }
3537:22): if (@chars > 0) {
3538:22): my $charrulestr = '"'.join('","',@charrules).'"';
3539:22): my $charalertstr = '"'.join('","',@charalerts).'"';
3540:22): $intargjs .= qq| var brokerules = new Array();\n|.
3541:22): qq| var charrules = new Array($charrulestr);\n|.
3542:22): qq| var charalerts = new Array($charalertstr);\n|;
3543:22): my %rules;
3544:22): map { $rules{$_} = 1; } @chars;
3545:22): if ($rules{'uc'}) {
3546:22): $intargjs .= qq|
3547:22): var ucRegExp = /[A-Z]/;
3548:22): if (!ucRegExp.test(currpwval)) {
3549:22): brokerules.push('uc');
3550:22): }
3551:22): |;
3552:22): }
3553:22): if ($rules{'lc'}) {
3554:22): $intargjs .= qq|
3555:22): var lcRegExp = /[a-z]/;
3556:22): if (!lcRegExp.test(currpwval)) {
3557:22): brokerules.push('lc');
3558:22): }
3559:22): |;
3560:22): }
3561:22): if ($rules{'num'}) {
3562:22): $intargjs .= qq|
3563:22): var numRegExp = /[0-9]/;
3564:22): if (!numRegExp.test(currpwval)) {
3565:22): brokerules.push('num');
3566:22): }
3567:22): |;
3568:22): }
3569:22): if ($rules{'spec'}) {
3570:22): $intargjs .= q|
3571:22): var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
3572:22): if (!specRegExp.test(currpwval)) {
3573:22): brokerules.push('spec');
3574:22): }
3575:22): |;
3576:22): }
3577:22): $intargjs .= qq|
3578:22): if (brokerules.length > 0) {
3579:22): for (var i=0; i<brokerules.length; i++) {
3580:22): for (var j=0; j<charrules.length; j++) {
3581:22): if (brokerules[i] == charrules[j]) {
3582:22): rulesmsg += ' - '+charalerts[j]+'\\n';
3583:22): break;
3584:22): }
3585:22): }
3586:22): }
3587:22): }
3588:22): |;
3589:22): }
3590:22): $intargjs .= qq|
3591:22): if (rulesmsg != '') {
3592:22): rulesmsg = '$alertmsg'+rulesmsg;
3593:22): alert(rulesmsg);
3594:22): return false;
3595:22): }
3596:22): |;
3597:22): }
3598:22): return ($numrules,$intargjs);
3599:22): }
3600:22):
1.80 albertel 3601: ###############################################################
3602: ## Get Kerberos Defaults for Domain ##
3603: ###############################################################
3604: ##
3605: ## Returns default kerberos version and an associated argument
3606: ## as listed in file domain.tab. If not listed, provides
3607: ## appropriate default domain and kerberos version.
3608: ##
3609: #-------------------------------------------
3610:
3611: =pod
3612:
1.648 raeburn 3613: =item * &get_kerberos_defaults()
1.80 albertel 3614:
3615: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3616: version and domain. If not found, it defaults to version 4 and the
3617: domain of the server.
1.80 albertel 3618:
1.648 raeburn 3619: =over 4
3620:
1.80 albertel 3621: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3622:
1.648 raeburn 3623: =back
3624:
3625: =back
3626:
1.80 albertel 3627: =cut
3628:
3629: #-------------------------------------------
3630: sub get_kerberos_defaults {
3631: my $domain=shift;
1.641 raeburn 3632: my ($krbdef,$krbdefdom);
3633: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3634: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3635: $krbdef = $domdefaults{'auth_def'};
3636: $krbdefdom = $domdefaults{'auth_arg_def'};
3637: } else {
1.80 albertel 3638: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3639: my $krbdefdom=$1;
3640: $krbdefdom=~tr/a-z/A-Z/;
3641: $krbdef = "krb4";
3642: }
3643: return ($krbdef,$krbdefdom);
3644: }
1.112 bowersj2 3645:
1.32 matthew 3646:
1.46 matthew 3647: ###############################################################
3648: ## Thesaurus Functions ##
3649: ###############################################################
1.20 www 3650:
1.46 matthew 3651: =pod
1.20 www 3652:
1.112 bowersj2 3653: =head1 Thesaurus Functions
3654:
3655: =over 4
3656:
1.648 raeburn 3657: =item * &initialize_keywords()
1.46 matthew 3658:
3659: Initializes the package variable %Keywords if it is empty. Uses the
3660: package variable $thesaurus_db_file.
3661:
3662: =cut
3663:
3664: ###################################################
3665:
3666: sub initialize_keywords {
3667: return 1 if (scalar keys(%Keywords));
3668: # If we are here, %Keywords is empty, so fill it up
3669: # Make sure the file we need exists...
3670: if (! -e $thesaurus_db_file) {
3671: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3672: " failed because it does not exist");
3673: return 0;
3674: }
3675: # Set up the hash as a database
3676: my %thesaurus_db;
3677: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3678: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3679: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3680: $thesaurus_db_file);
3681: return 0;
3682: }
3683: # Get the average number of appearances of a word.
3684: my $avecount = $thesaurus_db{'average.count'};
3685: # Put keywords (those that appear > average) into %Keywords
3686: while (my ($word,$data)=each (%thesaurus_db)) {
3687: my ($count,undef) = split /:/,$data;
3688: $Keywords{$word}++ if ($count > $avecount);
3689: }
3690: untie %thesaurus_db;
3691: # Remove special values from %Keywords.
1.356 albertel 3692: foreach my $value ('total.count','average.count') {
3693: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3694: }
1.46 matthew 3695: return 1;
3696: }
3697:
3698: ###################################################
3699:
3700: =pod
3701:
1.648 raeburn 3702: =item * &keyword($word)
1.46 matthew 3703:
3704: Returns true if $word is a keyword. A keyword is a word that appears more
3705: than the average number of times in the thesaurus database. Calls
3706: &initialize_keywords
3707:
3708: =cut
3709:
3710: ###################################################
1.20 www 3711:
3712: sub keyword {
1.46 matthew 3713: return if (!&initialize_keywords());
3714: my $word=lc(shift());
3715: $word=~s/\W//g;
3716: return exists($Keywords{$word});
1.20 www 3717: }
1.46 matthew 3718:
3719: ###############################################################
3720:
3721: =pod
1.20 www 3722:
1.648 raeburn 3723: =item * &get_related_words()
1.46 matthew 3724:
1.160 matthew 3725: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3726: an array of words. If the keyword is not in the thesaurus, an empty array
3727: will be returned. The order of the words returned is determined by the
3728: database which holds them.
3729:
3730: Uses global $thesaurus_db_file.
3731:
1.1057 foxr 3732:
1.46 matthew 3733: =cut
3734:
3735: ###############################################################
3736: sub get_related_words {
3737: my $keyword = shift;
3738: my %thesaurus_db;
3739: if (! -e $thesaurus_db_file) {
3740: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3741: "failed because the file does not exist");
3742: return ();
3743: }
3744: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3745: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3746: return ();
3747: }
3748: my @Words=();
1.429 www 3749: my $count=0;
1.46 matthew 3750: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3751: # The first element is the number of times
3752: # the word appears. We do not need it now.
1.429 www 3753: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3754: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3755: my $threshold=$mostfrequentcount/10;
3756: foreach my $possibleword (@RelatedWords) {
3757: my ($word,$wordcount)=split(/\,/,$possibleword);
3758: if ($wordcount>$threshold) {
3759: push(@Words,$word);
3760: $count++;
3761: if ($count>10) { last; }
3762: }
1.20 www 3763: }
3764: }
1.46 matthew 3765: untie %thesaurus_db;
3766: return @Words;
1.14 harris41 3767: }
1.46 matthew 3768:
1.112 bowersj2 3769: =pod
3770:
3771: =back
3772:
3773: =cut
1.61 www 3774:
3775: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3776: =pod
3777:
1.112 bowersj2 3778: =head1 User Name Functions
3779:
3780: =over 4
3781:
1.648 raeburn 3782: =item * &plainname($uname,$udom,$first)
1.81 albertel 3783:
1.112 bowersj2 3784: Takes a users logon name and returns it as a string in
1.226 albertel 3785: "first middle last generation" form
3786: if $first is set to 'lastname' then it returns it as
3787: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3788:
3789: =cut
1.61 www 3790:
1.295 www 3791:
1.81 albertel 3792: ###############################################################
1.61 www 3793: sub plainname {
1.226 albertel 3794: my ($uname,$udom,$first)=@_;
1.537 albertel 3795: return if (!defined($uname) || !defined($udom));
1.295 www 3796: my %names=&getnames($uname,$udom);
1.226 albertel 3797: my $name=&Apache::lonnet::format_name($names{'firstname'},
3798: $names{'middlename'},
3799: $names{'lastname'},
3800: $names{'generation'},$first);
3801: $name=~s/^\s+//;
1.62 www 3802: $name=~s/\s+$//;
3803: $name=~s/\s+/ /g;
1.353 albertel 3804: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3805: return $name;
1.61 www 3806: }
1.66 www 3807:
3808: # -------------------------------------------------------------------- Nickname
1.81 albertel 3809: =pod
3810:
1.648 raeburn 3811: =item * &nickname($uname,$udom)
1.81 albertel 3812:
3813: Gets a users name and returns it as a string as
3814:
3815: ""nickname""
1.66 www 3816:
1.81 albertel 3817: if the user has a nickname or
3818:
3819: "first middle last generation"
3820:
3821: if the user does not
3822:
3823: =cut
1.66 www 3824:
3825: sub nickname {
3826: my ($uname,$udom)=@_;
1.537 albertel 3827: return if (!defined($uname) || !defined($udom));
1.295 www 3828: my %names=&getnames($uname,$udom);
1.68 albertel 3829: my $name=$names{'nickname'};
1.66 www 3830: if ($name) {
3831: $name='"'.$name.'"';
3832: } else {
3833: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3834: $names{'lastname'}.' '.$names{'generation'};
3835: $name=~s/\s+$//;
3836: $name=~s/\s+/ /g;
3837: }
3838: return $name;
3839: }
3840:
1.295 www 3841: sub getnames {
3842: my ($uname,$udom)=@_;
1.537 albertel 3843: return if (!defined($uname) || !defined($udom));
1.433 albertel 3844: if ($udom eq 'public' && $uname eq 'public') {
3845: return ('lastname' => &mt('Public'));
3846: }
1.295 www 3847: my $id=$uname.':'.$udom;
3848: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3849: if ($cached) {
3850: return %{$names};
3851: } else {
3852: my %loadnames=&Apache::lonnet::get('environment',
3853: ['firstname','middlename','lastname','generation','nickname'],
3854: $udom,$uname);
3855: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3856: return %loadnames;
3857: }
3858: }
1.61 www 3859:
1.542 raeburn 3860: # -------------------------------------------------------------------- getemails
1.648 raeburn 3861:
1.542 raeburn 3862: =pod
3863:
1.648 raeburn 3864: =item * &getemails($uname,$udom)
1.542 raeburn 3865:
3866: Gets a user's email information and returns it as a hash with keys:
3867: notification, critnotification, permanentemail
3868:
3869: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3870: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3871:
1.648 raeburn 3872:
1.542 raeburn 3873: =cut
3874:
1.648 raeburn 3875:
1.466 albertel 3876: sub getemails {
3877: my ($uname,$udom)=@_;
3878: if ($udom eq 'public' && $uname eq 'public') {
3879: return;
3880: }
1.467 www 3881: if (!$udom) { $udom=$env{'user.domain'}; }
3882: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3883: my $id=$uname.':'.$udom;
3884: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3885: if ($cached) {
3886: return %{$names};
3887: } else {
3888: my %loadnames=&Apache::lonnet::get('environment',
3889: ['notification','critnotification',
3890: 'permanentemail'],
3891: $udom,$uname);
3892: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3893: return %loadnames;
3894: }
3895: }
3896:
1.551 albertel 3897: sub flush_email_cache {
3898: my ($uname,$udom)=@_;
3899: if (!$udom) { $udom =$env{'user.domain'}; }
3900: if (!$uname) { $uname=$env{'user.name'}; }
3901: return if ($udom eq 'public' && $uname eq 'public');
3902: my $id=$uname.':'.$udom;
3903: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3904: }
3905:
1.728 raeburn 3906: # -------------------------------------------------------------------- getlangs
3907:
3908: =pod
3909:
3910: =item * &getlangs($uname,$udom)
3911:
3912: Gets a user's language preference and returns it as a hash with key:
3913: language.
3914:
3915: =cut
3916:
3917:
3918: sub getlangs {
3919: my ($uname,$udom) = @_;
3920: if (!$udom) { $udom =$env{'user.domain'}; }
3921: if (!$uname) { $uname=$env{'user.name'}; }
3922: my $id=$uname.':'.$udom;
3923: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3924: if ($cached) {
3925: return %{$langs};
3926: } else {
3927: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3928: $udom,$uname);
3929: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3930: return %loadlangs;
3931: }
3932: }
3933:
3934: sub flush_langs_cache {
3935: my ($uname,$udom)=@_;
3936: if (!$udom) { $udom =$env{'user.domain'}; }
3937: if (!$uname) { $uname=$env{'user.name'}; }
3938: return if ($udom eq 'public' && $uname eq 'public');
3939: my $id=$uname.':'.$udom;
3940: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3941: }
3942:
1.61 www 3943: # ------------------------------------------------------------------ Screenname
1.81 albertel 3944:
3945: =pod
3946:
1.648 raeburn 3947: =item * &screenname($uname,$udom)
1.81 albertel 3948:
3949: Gets a users screenname and returns it as a string
3950:
3951: =cut
1.61 www 3952:
3953: sub screenname {
3954: my ($uname,$udom)=@_;
1.258 albertel 3955: if ($uname eq $env{'user.name'} &&
3956: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3957: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3958: return $names{'screenname'};
1.62 www 3959: }
3960:
1.212 albertel 3961:
1.802 bisitz 3962: # ------------------------------------------------------------- Confirm Wrapper
3963: =pod
3964:
1.1075.2.42 raeburn 3965: =item * &confirmwrapper($message)
1.802 bisitz 3966:
3967: Wrap messages about completion of operation in box
3968:
3969: =cut
3970:
3971: sub confirmwrapper {
3972: my ($message)=@_;
3973: if ($message) {
3974: return "\n".'<div class="LC_confirm_box">'."\n"
3975: .$message."\n"
3976: .'</div>'."\n";
3977: } else {
3978: return $message;
3979: }
3980: }
3981:
1.62 www 3982: # ------------------------------------------------------------- Message Wrapper
3983:
3984: sub messagewrapper {
1.369 www 3985: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3986: return
1.441 albertel 3987: '<a href="/adm/email?compose=individual&'.
3988: 'recname='.$username.'&recdom='.$domain.
3989: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3990: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3991: }
1.802 bisitz 3992:
1.74 www 3993: # --------------------------------------------------------------- Notes Wrapper
3994:
3995: sub noteswrapper {
3996: my ($link,$un,$do)=@_;
3997: return
1.896 amueller 3998: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3999: }
1.802 bisitz 4000:
1.62 www 4001: # ------------------------------------------------------------- Aboutme Wrapper
4002:
4003: sub aboutmewrapper {
1.1070 raeburn 4004: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 4005: if (!defined($username) && !defined($domain)) {
4006: return;
4007: }
1.1075.2.15 raeburn 4008: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 4009: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 4010: }
4011:
4012: # ------------------------------------------------------------ Syllabus Wrapper
4013:
4014: sub syllabuswrapper {
1.707 bisitz 4015: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 4016: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 4017: }
1.14 harris41 4018:
1.1075.2.161. .11(raeb 4019:-22): sub aboutme_on {
4020:-22): my ($uname,$udom)=@_;
4021:-22): unless ($uname) { $uname=$env{'user.name'}; }
4022:-22): unless ($udom) { $udom=$env{'user.domain'}; }
4023:-22): return if ($udom eq 'public' && $uname eq 'public');
4024:-22): my $hashkey=$uname.':'.$udom;
4025:-22): my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
4026:-22): if ($cached) {
4027:-22): return $aboutme;
4028:-22): }
4029:-22): $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
4030:-22): &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
4031:-22): return $aboutme;
4032:-22): }
4033:-22):
4034:-22): sub devalidate_aboutme_cache {
4035:-22): my ($uname,$udom)=@_;
4036:-22): if (!$udom) { $udom =$env{'user.domain'}; }
4037:-22): if (!$uname) { $uname=$env{'user.name'}; }
4038:-22): return if ($udom eq 'public' && $uname eq 'public');
4039:-22): my $id=$uname.':'.$udom;
4040:-22): &Apache::lonnet::devalidate_cache_new('aboutme',$id);
4041:-22): }
4042:-22):
1.802 bisitz 4043: # -----------------------------------------------------------------------------
4044:
1.208 matthew 4045: sub track_student_link {
1.887 raeburn 4046: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 4047: my $link ="/adm/trackstudent?";
1.208 matthew 4048: my $title = 'View recent activity';
4049: if (defined($sname) && $sname !~ /^\s*$/ &&
4050: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 4051: $link .= "selected_student=$sname:$sdom";
1.208 matthew 4052: $title .= ' of this student';
1.268 albertel 4053: }
1.208 matthew 4054: if (defined($target) && $target !~ /^\s*$/) {
4055: $target = qq{target="$target"};
4056: } else {
4057: $target = '';
4058: }
1.268 albertel 4059: if ($start) { $link.='&start='.$start; }
1.887 raeburn 4060: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 4061: $title = &mt($title);
4062: $linktext = &mt($linktext);
1.448 albertel 4063: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
4064: &help_open_topic('View_recent_activity');
1.208 matthew 4065: }
4066:
1.781 raeburn 4067: sub slot_reservations_link {
4068: my ($linktext,$sname,$sdom,$target) = @_;
4069: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
4070: my $title = 'View slot reservation history';
4071: if (defined($sname) && $sname !~ /^\s*$/ &&
4072: defined($sdom) && $sdom !~ /^\s*$/) {
4073: $link .= "&uname=$sname&udom=$sdom";
4074: $title .= ' of this student';
4075: }
4076: if (defined($target) && $target !~ /^\s*$/) {
4077: $target = qq{target="$target"};
4078: } else {
4079: $target = '';
4080: }
4081: $title = &mt($title);
4082: $linktext = &mt($linktext);
4083: return qq{<a href="$link" title="$title" $target>$linktext</a>};
4084: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
4085:
4086: }
4087:
1.508 www 4088: # ===================================================== Display a student photo
4089:
4090:
1.509 albertel 4091: sub student_image_tag {
1.508 www 4092: my ($domain,$user)=@_;
4093: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
4094: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
4095: return '<img src="'.$imgsrc.'" align="right" />';
4096: } else {
4097: return '';
4098: }
4099: }
4100:
1.112 bowersj2 4101: =pod
4102:
4103: =back
4104:
4105: =head1 Access .tab File Data
4106:
4107: =over 4
4108:
1.648 raeburn 4109: =item * &languageids()
1.112 bowersj2 4110:
4111: returns list of all language ids
4112:
4113: =cut
4114:
1.14 harris41 4115: sub languageids {
1.16 harris41 4116: return sort(keys(%language));
1.14 harris41 4117: }
4118:
1.112 bowersj2 4119: =pod
4120:
1.648 raeburn 4121: =item * &languagedescription()
1.112 bowersj2 4122:
4123: returns description of a specified language id
4124:
4125: =cut
4126:
1.14 harris41 4127: sub languagedescription {
1.125 www 4128: my $code=shift;
4129: return ($supported_language{$code}?'* ':'').
4130: $language{$code}.
1.126 www 4131: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 4132: }
4133:
1.1048 foxr 4134: =pod
4135:
4136: =item * &plainlanguagedescription
4137:
4138: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
4139: and the language character encoding (e.g. ISO) separated by a ' - ' string.
4140:
4141: =cut
4142:
1.145 www 4143: sub plainlanguagedescription {
4144: my $code=shift;
4145: return $language{$code};
4146: }
4147:
1.1048 foxr 4148: =pod
4149:
4150: =item * &supportedlanguagecode
4151:
4152: Returns the supported language code (e.g. sptutf maps to pt) given a language
4153: code.
4154:
4155: =cut
4156:
1.145 www 4157: sub supportedlanguagecode {
4158: my $code=shift;
4159: return $supported_language{$code};
1.97 www 4160: }
4161:
1.112 bowersj2 4162: =pod
4163:
1.1048 foxr 4164: =item * &latexlanguage()
4165:
4166: Given a language key code returns the correspondnig language to use
4167: to select the correct hyphenation on LaTeX printouts. This is undef if there
4168: is no supported hyphenation for the language code.
4169:
4170: =cut
4171:
4172: sub latexlanguage {
4173: my $code = shift;
4174: return $latex_language{$code};
4175: }
4176:
4177: =pod
4178:
4179: =item * &latexhyphenation()
4180:
4181: Same as above but what's supplied is the language as it might be stored
4182: in the metadata.
4183:
4184: =cut
4185:
4186: sub latexhyphenation {
4187: my $key = shift;
4188: return $latex_language_bykey{$key};
4189: }
4190:
4191: =pod
4192:
1.648 raeburn 4193: =item * ©rightids()
1.112 bowersj2 4194:
4195: returns list of all copyrights
4196:
4197: =cut
4198:
4199: sub copyrightids {
4200: return sort(keys(%cprtag));
4201: }
4202:
4203: =pod
4204:
1.648 raeburn 4205: =item * ©rightdescription()
1.112 bowersj2 4206:
4207: returns description of a specified copyright id
4208:
4209: =cut
4210:
4211: sub copyrightdescription {
1.166 www 4212: return &mt($cprtag{shift(@_)});
1.112 bowersj2 4213: }
1.197 matthew 4214:
4215: =pod
4216:
1.648 raeburn 4217: =item * &source_copyrightids()
1.192 taceyjo1 4218:
4219: returns list of all source copyrights
4220:
4221: =cut
4222:
4223: sub source_copyrightids {
4224: return sort(keys(%scprtag));
4225: }
4226:
4227: =pod
4228:
1.648 raeburn 4229: =item * &source_copyrightdescription()
1.192 taceyjo1 4230:
4231: returns description of a specified source copyright id
4232:
4233: =cut
4234:
4235: sub source_copyrightdescription {
4236: return &mt($scprtag{shift(@_)});
4237: }
1.112 bowersj2 4238:
4239: =pod
4240:
1.648 raeburn 4241: =item * &filecategories()
1.112 bowersj2 4242:
4243: returns list of all file categories
4244:
4245: =cut
4246:
4247: sub filecategories {
4248: return sort(keys(%category_extensions));
4249: }
4250:
4251: =pod
4252:
1.648 raeburn 4253: =item * &filecategorytypes()
1.112 bowersj2 4254:
4255: returns list of file types belonging to a given file
4256: category
4257:
4258: =cut
4259:
4260: sub filecategorytypes {
1.356 albertel 4261: my ($cat) = @_;
4262: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 4263: }
4264:
4265: =pod
4266:
1.648 raeburn 4267: =item * &fileembstyle()
1.112 bowersj2 4268:
4269: returns embedding style for a specified file type
4270:
4271: =cut
4272:
4273: sub fileembstyle {
4274: return $fe{lc(shift(@_))};
1.169 www 4275: }
4276:
1.351 www 4277: sub filemimetype {
4278: return $fm{lc(shift(@_))};
4279: }
4280:
1.169 www 4281:
4282: sub filecategoryselect {
4283: my ($name,$value)=@_;
1.189 matthew 4284: return &select_form($value,$name,
1.970 raeburn 4285: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 4286: }
4287:
4288: =pod
4289:
1.648 raeburn 4290: =item * &filedescription()
1.112 bowersj2 4291:
4292: returns description for a specified file type
4293:
4294: =cut
4295:
4296: sub filedescription {
1.188 matthew 4297: my $file_description = $fd{lc(shift())};
4298: $file_description =~ s:([\[\]]):~$1:g;
4299: return &mt($file_description);
1.112 bowersj2 4300: }
4301:
4302: =pod
4303:
1.648 raeburn 4304: =item * &filedescriptionex()
1.112 bowersj2 4305:
4306: returns description for a specified file type with
4307: extra formatting
4308:
4309: =cut
4310:
4311: sub filedescriptionex {
4312: my $ex=shift;
1.188 matthew 4313: my $file_description = $fd{lc($ex)};
4314: $file_description =~ s:([\[\]]):~$1:g;
4315: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 4316: }
4317:
4318: # End of .tab access
4319: =pod
4320:
4321: =back
4322:
4323: =cut
4324:
4325: # ------------------------------------------------------------------ File Types
4326: sub fileextensions {
4327: return sort(keys(%fe));
4328: }
4329:
1.97 www 4330: # ----------------------------------------------------------- Display Languages
4331: # returns a hash with all desired display languages
4332: #
4333:
4334: sub display_languages {
4335: my %languages=();
1.695 raeburn 4336: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 4337: $languages{$lang}=1;
1.97 www 4338: }
4339: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 4340: if ($env{'form.displaylanguage'}) {
1.356 albertel 4341: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
4342: $languages{$lang}=1;
1.97 www 4343: }
4344: }
4345: return %languages;
1.14 harris41 4346: }
4347:
1.582 albertel 4348: sub languages {
4349: my ($possible_langs) = @_;
1.695 raeburn 4350: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4351: if (!ref($possible_langs)) {
4352: if( wantarray ) {
4353: return @preferred_langs;
4354: } else {
4355: return $preferred_langs[0];
4356: }
4357: }
4358: my %possibilities = map { $_ => 1 } (@$possible_langs);
4359: my @preferred_possibilities;
4360: foreach my $preferred_lang (@preferred_langs) {
4361: if (exists($possibilities{$preferred_lang})) {
4362: push(@preferred_possibilities, $preferred_lang);
4363: }
4364: }
4365: if( wantarray ) {
4366: return @preferred_possibilities;
4367: }
4368: return $preferred_possibilities[0];
4369: }
4370:
1.742 raeburn 4371: sub user_lang {
4372: my ($touname,$toudom,$fromcid) = @_;
4373: my @userlangs;
4374: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4375: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4376: $env{'course.'.$fromcid.'.languages'}));
4377: } else {
4378: my %langhash = &getlangs($touname,$toudom);
4379: if ($langhash{'languages'} ne '') {
4380: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4381: } else {
4382: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4383: if ($domdefs{'lang_def'} ne '') {
4384: @userlangs = ($domdefs{'lang_def'});
4385: }
4386: }
4387: }
4388: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4389: my $user_lh = Apache::localize->get_handle(@languages);
4390: return $user_lh;
4391: }
4392:
4393:
1.112 bowersj2 4394: ###############################################################
4395: ## Student Answer Attempts ##
4396: ###############################################################
4397:
4398: =pod
4399:
4400: =head1 Alternate Problem Views
4401:
4402: =over 4
4403:
1.648 raeburn 4404: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86 raeburn 4405: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4406:
4407: Return string with previous attempt on problem. Arguments:
4408:
4409: =over 4
4410:
4411: =item * $symb: Problem, including path
4412:
4413: =item * $username: username of the desired student
4414:
4415: =item * $domain: domain of the desired student
1.14 harris41 4416:
1.112 bowersj2 4417: =item * $course: Course ID
1.14 harris41 4418:
1.112 bowersj2 4419: =item * $getattempt: Leave blank for all attempts, otherwise put
4420: something
1.14 harris41 4421:
1.112 bowersj2 4422: =item * $regexp: if string matches this regexp, the string will be
4423: sent to $gradesub
1.14 harris41 4424:
1.112 bowersj2 4425: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4426:
1.1075.2.86 raeburn 4427: =item * $usec: section of the desired student
4428:
4429: =item * $identifier: counter for student (multiple students one problem) or
4430: problem (one student; whole sequence).
4431:
1.112 bowersj2 4432: =back
1.14 harris41 4433:
1.112 bowersj2 4434: The output string is a table containing all desired attempts, if any.
1.16 harris41 4435:
1.112 bowersj2 4436: =cut
1.1 albertel 4437:
4438: sub get_previous_attempt {
1.1075.2.86 raeburn 4439: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4440: my $prevattempts='';
1.43 ng 4441: no strict 'refs';
1.1 albertel 4442: if ($symb) {
1.3 albertel 4443: my (%returnhash)=
4444: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4445: if ($returnhash{'version'}) {
4446: my %lasthash=();
4447: my $version;
4448: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91 raeburn 4449: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4450: if ($key =~ /\.rawrndseed$/) {
4451: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4452: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4453: } else {
4454: $lasthash{$key}=$returnhash{$version.':'.$key};
4455: }
1.19 harris41 4456: }
1.1 albertel 4457: }
1.596 albertel 4458: $prevattempts=&start_data_table().&start_data_table_header_row();
4459: $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86 raeburn 4460: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4461: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4462: foreach my $key (sort(keys(%lasthash))) {
4463: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4464: if ($#parts > 0) {
1.31 albertel 4465: my $data=$parts[-1];
1.989 raeburn 4466: next if ($data eq 'foilorder');
1.31 albertel 4467: pop(@parts);
1.1010 www 4468: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4469: if ($data eq 'type') {
4470: unless ($showsurv) {
4471: my $id = join(',',@parts);
4472: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4473: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4474: $lasthidden{$ign.'.'.$id} = 1;
4475: }
1.945 raeburn 4476: }
1.1075.2.86 raeburn 4477: if ($identifier ne '') {
4478: my $id = join(',',@parts);
4479: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4480: $domain,$username,$usec,undef,$course) =~ /^no/) {
4481: $hidestatus{$ign.'.'.$id} = 1;
4482: }
4483: }
4484: } elsif ($data eq 'regrader') {
4485: if (($identifier ne '') && (@parts)) {
4486: my $id = join(',',@parts);
4487: $regraded{$ign.'.'.$id} = 1;
4488: }
1.1010 www 4489: }
1.31 albertel 4490: } else {
1.41 ng 4491: if ($#parts == 0) {
4492: $prevattempts.='<th>'.$parts[0].'</th>';
4493: } else {
4494: $prevattempts.='<th>'.$ign.'</th>';
4495: }
1.31 albertel 4496: }
1.16 harris41 4497: }
1.596 albertel 4498: $prevattempts.=&end_data_table_header_row();
1.40 ng 4499: if ($getattempt eq '') {
1.1075.2.86 raeburn 4500: my (%solved,%resets,%probstatus);
4501: if (($identifier ne '') && (keys(%regraded) > 0)) {
4502: for ($version=1;$version<=$returnhash{'version'};$version++) {
4503: foreach my $id (keys(%regraded)) {
4504: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4505: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4506: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4507: push(@{$resets{$id}},$version);
4508: }
4509: }
4510: }
4511: }
1.40 ng 4512: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86 raeburn 4513: my (@hidden,@unsolved);
1.945 raeburn 4514: if (%typeparts) {
4515: foreach my $id (keys(%typeparts)) {
1.1075.2.86 raeburn 4516: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4517: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4518: push(@hidden,$id);
1.1075.2.86 raeburn 4519: } elsif ($identifier ne '') {
4520: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4521: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4522: ($hidestatus{$id})) {
4523: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
4524: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4525: push(@{$solved{$id}},$version);
4526: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4527: (ref($solved{$id}) eq 'ARRAY')) {
4528: my $skip;
4529: if (ref($resets{$id}) eq 'ARRAY') {
4530: foreach my $reset (@{$resets{$id}}) {
4531: if ($reset > $solved{$id}[-1]) {
4532: $skip=1;
4533: last;
4534: }
4535: }
4536: }
4537: unless ($skip) {
4538: my ($ign,$partslist) = split(/\./,$id,2);
4539: push(@unsolved,$partslist);
4540: }
4541: }
4542: }
1.945 raeburn 4543: }
4544: }
4545: }
4546: $prevattempts.=&start_data_table_row().
1.1075.2.86 raeburn 4547: '<td>'.&mt('Transaction [_1]',$version);
4548: if (@unsolved) {
4549: $prevattempts .= '<span class="LC_nobreak"><label>'.
4550: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4551: &mt('Hide').'</label></span>';
4552: }
4553: $prevattempts .= '</td>';
1.945 raeburn 4554: if (@hidden) {
4555: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4556: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4557: my $hide;
4558: foreach my $id (@hidden) {
4559: if ($key =~ /^\Q$id\E/) {
4560: $hide = 1;
4561: last;
4562: }
4563: }
4564: if ($hide) {
4565: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4566: if (($data eq 'award') || ($data eq 'awarddetail')) {
4567: my $value = &format_previous_attempt_value($key,
4568: $returnhash{$version.':'.$key});
4569: $prevattempts.='<td>'.$value.' </td>';
4570: } else {
4571: $prevattempts.='<td> </td>';
4572: }
4573: } else {
4574: if ($key =~ /\./) {
1.1075.2.91 raeburn 4575: my $value = $returnhash{$version.':'.$key};
4576: if ($key =~ /\.rndseed$/) {
4577: my ($id) = ($key =~ /^(.+)\.rndseed$/);
4578: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4579: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4580: }
4581: }
4582: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4583: ' </td>';
1.945 raeburn 4584: } else {
4585: $prevattempts.='<td> </td>';
4586: }
4587: }
4588: }
4589: } else {
4590: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4591: next if ($key =~ /\.foilorder$/);
1.1075.2.91 raeburn 4592: my $value = $returnhash{$version.':'.$key};
4593: if ($key =~ /\.rndseed$/) {
4594: my ($id) = ($key =~ /^(.+)\.rndseed$/);
4595: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4596: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4597: }
4598: }
4599: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4600: ' </td>';
1.945 raeburn 4601: }
4602: }
4603: $prevattempts.=&end_data_table_row();
1.40 ng 4604: }
1.1 albertel 4605: }
1.945 raeburn 4606: my @currhidden = keys(%lasthidden);
1.596 albertel 4607: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4608: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4609: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4610: if (%typeparts) {
4611: my $hidden;
4612: foreach my $id (@currhidden) {
4613: if ($key =~ /^\Q$id\E/) {
4614: $hidden = 1;
4615: last;
4616: }
4617: }
4618: if ($hidden) {
4619: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4620: if (($data eq 'award') || ($data eq 'awarddetail')) {
4621: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4622: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4623: $value = &$gradesub($value);
4624: }
4625: $prevattempts.='<td>'.$value.' </td>';
4626: } else {
4627: $prevattempts.='<td> </td>';
4628: }
4629: } else {
4630: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4631: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4632: $value = &$gradesub($value);
4633: }
4634: $prevattempts.='<td>'.$value.' </td>';
4635: }
4636: } else {
4637: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4638: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4639: $value = &$gradesub($value);
4640: }
4641: $prevattempts.='<td>'.$value.' </td>';
4642: }
1.16 harris41 4643: }
1.596 albertel 4644: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4645: } else {
1.1075.2.161. .17(raeb 4646:-23): my $msg;
4647:-23): if ($symb =~ /ext\.tool$/) {
4648:-23): $msg = &mt('No grade passed back.');
4649:-23): } else {
4650:-23): $msg = &mt('Nothing submitted - no attempts.');
4651:-23): }
1.596 albertel 4652: $prevattempts=
4653: &start_data_table().&start_data_table_row().
1.1075.2.161. .17(raeb 4654:-23): '<td>'.$msg.'</td>'.
1.596 albertel 4655: &end_data_table_row().&end_data_table();
1.1 albertel 4656: }
4657: } else {
1.596 albertel 4658: $prevattempts=
4659: &start_data_table().&start_data_table_row().
4660: '<td>'.&mt('No data.').'</td>'.
4661: &end_data_table_row().&end_data_table();
1.1 albertel 4662: }
1.10 albertel 4663: }
4664:
1.581 albertel 4665: sub format_previous_attempt_value {
4666: my ($key,$value) = @_;
1.1011 www 4667: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 4668: $value = &Apache::lonlocal::locallocaltime($value);
4669: } elsif (ref($value) eq 'ARRAY') {
4670: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 4671: } elsif ($key =~ /answerstring$/) {
4672: my %answers = &Apache::lonnet::str2hash($value);
4673: my @anskeys = sort(keys(%answers));
4674: if (@anskeys == 1) {
4675: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4676: if ($answer =~ m{\0}) {
4677: $answer =~ s{\0}{,}g;
1.988 raeburn 4678: }
4679: my $tag_internal_answer_name = 'INTERNAL';
4680: if ($anskeys[0] eq $tag_internal_answer_name) {
4681: $value = $answer;
4682: } else {
4683: $value = $anskeys[0].'='.$answer;
4684: }
4685: } else {
4686: foreach my $ans (@anskeys) {
4687: my $answer = $answers{$ans};
1.1001 raeburn 4688: if ($answer =~ m{\0}) {
4689: $answer =~ s{\0}{,}g;
1.988 raeburn 4690: }
4691: $value .= $ans.'='.$answer.'<br />';;
4692: }
4693: }
1.581 albertel 4694: } else {
4695: $value = &unescape($value);
4696: }
4697: return $value;
4698: }
4699:
4700:
1.107 albertel 4701: sub relative_to_absolute {
4702: my ($url,$output)=@_;
4703: my $parser=HTML::TokeParser->new(\$output);
4704: my $token;
4705: my $thisdir=$url;
4706: my @rlinks=();
4707: while ($token=$parser->get_token) {
4708: if ($token->[0] eq 'S') {
4709: if ($token->[1] eq 'a') {
4710: if ($token->[2]->{'href'}) {
4711: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4712: }
4713: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4714: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4715: } elsif ($token->[1] eq 'base') {
4716: $thisdir=$token->[2]->{'href'};
4717: }
4718: }
4719: }
4720: $thisdir=~s-/[^/]*$--;
1.356 albertel 4721: foreach my $link (@rlinks) {
1.726 raeburn 4722: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4723: ($link=~/^\//) ||
4724: ($link=~/^javascript:/i) ||
4725: ($link=~/^mailto:/i) ||
4726: ($link=~/^\#/)) {
4727: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4728: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4729: }
4730: }
4731: # -------------------------------------------------- Deal with Applet codebases
4732: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4733: return $output;
4734: }
4735:
1.112 bowersj2 4736: =pod
4737:
1.648 raeburn 4738: =item * &get_student_view()
1.112 bowersj2 4739:
4740: show a snapshot of what student was looking at
4741:
4742: =cut
4743:
1.10 albertel 4744: sub get_student_view {
1.186 albertel 4745: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4746: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4747: my (%form);
1.10 albertel 4748: my @elements=('symb','courseid','domain','username');
4749: foreach my $element (@elements) {
1.186 albertel 4750: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4751: }
1.186 albertel 4752: if (defined($moreenv)) {
4753: %form=(%form,%{$moreenv});
4754: }
1.236 albertel 4755: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4756: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4757: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4758: $userview=~s/\<body[^\>]*\>//gi;
4759: $userview=~s/\<\/body\>//gi;
4760: $userview=~s/\<html\>//gi;
4761: $userview=~s/\<\/html\>//gi;
4762: $userview=~s/\<head\>//gi;
4763: $userview=~s/\<\/head\>//gi;
4764: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4765: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4766: if (wantarray) {
4767: return ($userview,$response);
4768: } else {
4769: return $userview;
4770: }
4771: }
4772:
4773: sub get_student_view_with_retries {
4774: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4775:
4776: my $ok = 0; # True if we got a good response.
4777: my $content;
4778: my $response;
4779:
4780: # Try to get the student_view done. within the retries count:
4781:
4782: do {
4783: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4784: $ok = $response->is_success;
4785: if (!$ok) {
4786: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4787: }
4788: $retries--;
4789: } while (!$ok && ($retries > 0));
4790:
4791: if (!$ok) {
4792: $content = ''; # On error return an empty content.
4793: }
1.651 www 4794: if (wantarray) {
4795: return ($content, $response);
4796: } else {
4797: return $content;
4798: }
1.11 albertel 4799: }
4800:
1.1075.2.149 raeburn 4801: sub css_links {
4802: my ($currsymb,$level) = @_;
4803: my ($links,@symbs,%cssrefs,%httpref);
4804: if ($level eq 'map') {
4805: my $navmap = Apache::lonnavmaps::navmap->new();
4806: if (ref($navmap)) {
4807: my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
4808: my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
4809: foreach my $res (@resources) {
4810: if (ref($res) && $res->symb()) {
4811: push(@symbs,$res->symb());
4812: }
4813: }
4814: }
4815: } else {
4816: @symbs = ($currsymb);
4817: }
4818: foreach my $symb (@symbs) {
4819: my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
4820: if ($css_href =~ /\S/) {
4821: unless ($css_href =~ m{https?://}) {
4822: my $url = (&Apache::lonnet::decode_symb($symb))[-1];
4823: my $proburl = &Apache::lonnet::clutter($url);
4824: my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
4825: unless ($css_href =~ m{^/}) {
4826: $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
4827: }
4828: if ($css_href =~ m{^/(res|uploaded)/}) {
4829: unless (($httpref{'httpref.'.$css_href}) ||
4830: (&Apache::lonnet::is_on_map($css_href))) {
4831: my $thisurl = $proburl;
4832: if ($env{'httpref.'.$proburl}) {
4833: $thisurl = $env{'httpref.'.$proburl};
4834: }
4835: $httpref{'httpref.'.$css_href} = $thisurl;
4836: }
4837: }
4838: }
4839: $cssrefs{$css_href} = 1;
4840: }
4841: }
4842: if (keys(%httpref)) {
4843: &Apache::lonnet::appenv(\%httpref);
4844: }
4845: if (keys(%cssrefs)) {
4846: foreach my $css_href (keys(%cssrefs)) {
4847: next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
4848: $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
4849: }
4850: }
4851: return $links;
4852: }
4853:
1.112 bowersj2 4854: =pod
4855:
1.648 raeburn 4856: =item * &get_student_answers()
1.112 bowersj2 4857:
4858: show a snapshot of how student was answering problem
4859:
4860: =cut
4861:
1.11 albertel 4862: sub get_student_answers {
1.100 sakharuk 4863: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4864: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4865: my (%moreenv);
1.11 albertel 4866: my @elements=('symb','courseid','domain','username');
4867: foreach my $element (@elements) {
1.186 albertel 4868: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4869: }
1.186 albertel 4870: $moreenv{'grade_target'}='answer';
4871: %moreenv=(%form,%moreenv);
1.497 raeburn 4872: $feedurl = &Apache::lonnet::clutter($feedurl);
4873: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4874: return $userview;
1.1 albertel 4875: }
1.116 albertel 4876:
4877: =pod
4878:
4879: =item * &submlink()
4880:
1.242 albertel 4881: Inputs: $text $uname $udom $symb $target
1.116 albertel 4882:
4883: Returns: A link to grades.pm such as to see the SUBM view of a student
4884:
4885: =cut
4886:
4887: ###############################################
4888: sub submlink {
1.242 albertel 4889: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4890: if (!($uname && $udom)) {
4891: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4892: &Apache::lonnet::whichuser($symb);
1.116 albertel 4893: if (!$symb) { $symb=$cursymb; }
4894: }
1.254 matthew 4895: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4896: $symb=&escape($symb);
1.960 bisitz 4897: if ($target) { $target=" target=\"$target\""; }
4898: return
4899: '<a href="/adm/grades?command=submission'.
4900: '&symb='.$symb.
4901: '&student='.$uname.
4902: '&userdom='.$udom.'"'.
4903: $target.'>'.$text.'</a>';
1.242 albertel 4904: }
4905: ##############################################
4906:
4907: =pod
4908:
4909: =item * &pgrdlink()
4910:
4911: Inputs: $text $uname $udom $symb $target
4912:
4913: Returns: A link to grades.pm such as to see the PGRD view of a student
4914:
4915: =cut
4916:
4917: ###############################################
4918: sub pgrdlink {
4919: my $link=&submlink(@_);
4920: $link=~s/(&command=submission)/$1&showgrading=yes/;
4921: return $link;
4922: }
4923: ##############################################
4924:
4925: =pod
4926:
4927: =item * &pprmlink()
4928:
4929: Inputs: $text $uname $udom $symb $target
4930:
4931: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4932: student and a specific resource
1.242 albertel 4933:
4934: =cut
4935:
4936: ###############################################
4937: sub pprmlink {
4938: my ($text,$uname,$udom,$symb,$target)=@_;
4939: if (!($uname && $udom)) {
4940: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4941: &Apache::lonnet::whichuser($symb);
1.242 albertel 4942: if (!$symb) { $symb=$cursymb; }
4943: }
1.254 matthew 4944: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4945: $symb=&escape($symb);
1.242 albertel 4946: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4947: return '<a href="/adm/parmset?command=set&'.
4948: 'symb='.$symb.'&uname='.$uname.
4949: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4950: }
4951: ##############################################
1.37 matthew 4952:
1.112 bowersj2 4953: =pod
4954:
4955: =back
4956:
4957: =cut
4958:
1.37 matthew 4959: ###############################################
1.51 www 4960:
4961:
4962: sub timehash {
1.687 raeburn 4963: my ($thistime) = @_;
4964: my $timezone = &Apache::lonlocal::gettimezone();
4965: my $dt = DateTime->from_epoch(epoch => $thistime)
4966: ->set_time_zone($timezone);
4967: my $wday = $dt->day_of_week();
4968: if ($wday == 7) { $wday = 0; }
4969: return ( 'second' => $dt->second(),
4970: 'minute' => $dt->minute(),
4971: 'hour' => $dt->hour(),
4972: 'day' => $dt->day_of_month(),
4973: 'month' => $dt->month(),
4974: 'year' => $dt->year(),
4975: 'weekday' => $wday,
4976: 'dayyear' => $dt->day_of_year(),
4977: 'dlsav' => $dt->is_dst() );
1.51 www 4978: }
4979:
1.370 www 4980: sub utc_string {
4981: my ($date)=@_;
1.371 www 4982: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4983: }
4984:
1.51 www 4985: sub maketime {
4986: my %th=@_;
1.687 raeburn 4987: my ($epoch_time,$timezone,$dt);
4988: $timezone = &Apache::lonlocal::gettimezone();
4989: eval {
4990: $dt = DateTime->new( year => $th{'year'},
4991: month => $th{'month'},
4992: day => $th{'day'},
4993: hour => $th{'hour'},
4994: minute => $th{'minute'},
4995: second => $th{'second'},
4996: time_zone => $timezone,
4997: );
4998: };
4999: if (!$@) {
5000: $epoch_time = $dt->epoch;
5001: if ($epoch_time) {
5002: return $epoch_time;
5003: }
5004: }
1.51 www 5005: return POSIX::mktime(
5006: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 5007: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 5008: }
5009:
5010: #########################################
1.51 www 5011:
5012: sub findallcourses {
1.482 raeburn 5013: my ($roles,$uname,$udom) = @_;
1.355 albertel 5014: my %roles;
5015: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 5016: my %courses;
1.51 www 5017: my $now=time;
1.482 raeburn 5018: if (!defined($uname)) {
5019: $uname = $env{'user.name'};
5020: }
5021: if (!defined($udom)) {
5022: $udom = $env{'user.domain'};
5023: }
5024: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 5025: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 5026: if (!%roles) {
5027: %roles = (
5028: cc => 1,
1.907 raeburn 5029: co => 1,
1.482 raeburn 5030: in => 1,
5031: ep => 1,
5032: ta => 1,
5033: cr => 1,
5034: st => 1,
5035: );
5036: }
5037: foreach my $entry (keys(%roleshash)) {
5038: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
5039: if ($trole =~ /^cr/) {
5040: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
5041: } else {
5042: next if (!exists($roles{$trole}));
5043: }
5044: if ($tend) {
5045: next if ($tend < $now);
5046: }
5047: if ($tstart) {
5048: next if ($tstart > $now);
5049: }
1.1058 raeburn 5050: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 5051: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 5052: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 5053: if ($secpart eq '') {
5054: ($cnum,$role) = split(/_/,$cnumpart);
5055: $sec = 'none';
1.1058 raeburn 5056: $value .= $cnum.'/';
1.482 raeburn 5057: } else {
5058: $cnum = $cnumpart;
5059: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 5060: $value .= $cnum.'/'.$sec;
5061: }
5062: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5063: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5064: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5065: }
5066: } else {
5067: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 5068: }
1.482 raeburn 5069: }
5070: } else {
5071: foreach my $key (keys(%env)) {
1.483 albertel 5072: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
5073: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 5074: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
5075: next if ($role eq 'ca' || $role eq 'aa');
5076: next if (%roles && !exists($roles{$role}));
5077: my ($starttime,$endtime)=split(/\./,$env{$key});
5078: my $active=1;
5079: if ($starttime) {
5080: if ($now<$starttime) { $active=0; }
5081: }
5082: if ($endtime) {
5083: if ($now>$endtime) { $active=0; }
5084: }
5085: if ($active) {
1.1058 raeburn 5086: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 5087: if ($sec eq '') {
5088: $sec = 'none';
1.1058 raeburn 5089: } else {
5090: $value .= $sec;
5091: }
5092: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
5093: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
5094: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
5095: }
5096: } else {
5097: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 5098: }
1.474 raeburn 5099: }
5100: }
1.51 www 5101: }
5102: }
1.474 raeburn 5103: return %courses;
1.51 www 5104: }
1.37 matthew 5105:
1.54 www 5106: ###############################################
1.474 raeburn 5107:
5108: sub blockcheck {
1.1075.2.158 raeburn 5109: my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.490 raeburn 5110:
1.1075.2.161. .4(raebu 5111:22): unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
1.1075.2.158 raeburn 5112: my ($has_evb,$check_ipaccess);
5113: my $dom = $env{'user.domain'};
5114: if ($env{'request.course.id'}) {
5115: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5116: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
5117: my $checkrole = "cm./$cdom/$cnum";
5118: my $sec = $env{'request.course.sec'};
5119: if ($sec ne '') {
5120: $checkrole .= "/$sec";
5121: }
5122: if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
5123: ($env{'request.role'} !~ /^st/)) {
5124: $has_evb = 1;
5125: }
5126: unless ($has_evb) {
5127: if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
5128: ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
5129: if ($udom eq $cdom) {
5130: $check_ipaccess = 1;
5131: }
5132: }
5133: }
1.1075.2.161. .3(raebu 5134:22): } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
5135:22): ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
5136:22): my $checkrole;
5137:22): if ($env{'request.role.domain'} eq '') {
5138:22): $checkrole = "cm./$env{'user.domain'}/";
5139:22): } else {
5140:22): $checkrole = "cm./$env{'request.role.domain'}/";
5141:22): }
5142:22): if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
5143:22): $has_evb = 1;
5144:22): }
1.1075.2.158 raeburn 5145: }
5146: unless ($has_evb || $check_ipaccess) {
5147: my @machinedoms = &Apache::lonnet::current_machine_domains();
5148: if (($dom eq 'public') && ($activity eq 'port')) {
5149: $dom = $udom;
5150: }
5151: if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
5152: $check_ipaccess = 1;
5153: } else {
5154: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
5155: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
5156: my $prim = &Apache::lonnet::domain($dom,'primary');
5157: my $intdom = &Apache::lonnet::internet_dom($prim);
5158: if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
5159: if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
5160: $check_ipaccess = 1;
5161: }
5162: }
5163: }
5164: }
5165: if ($check_ipaccess) {
5166: my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
5167: unless (defined($cached)) {
5168: my %domconfig =
5169: &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
5170: $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
5171: }
5172: if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
5173: foreach my $id (keys(%{$ipaccessref})) {
5174: if (ref($ipaccessref->{$id}) eq 'HASH') {
5175: my $range = $ipaccessref->{$id}->{'ip'};
5176: if ($range) {
5177: if (&Apache::lonnet::ip_match($clientip,$range)) {
5178: if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
5179: if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
5180: return ('','','',$id,$dom);
5181: last;
5182: }
5183: }
5184: }
5185: }
5186: }
5187: }
5188: }
5189: }
1.1075.2.161. .4(raebu 5190:22): if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5191:22): return ();
5192:22): }
1.1075.2.158 raeburn 5193: }
1.1075.2.73 raeburn 5194: if (defined($udom) && defined($uname)) {
5195: # If uname and udom are for a course, check for blocks in the course.
5196: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
5197: my ($startblock,$endblock,$triggerblock) =
1.1075.2.147 raeburn 5198: &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1075.2.73 raeburn 5199: return ($startblock,$endblock,$triggerblock);
5200: }
5201: } else {
1.490 raeburn 5202: $udom = $env{'user.domain'};
5203: $uname = $env{'user.name'};
5204: }
5205:
1.502 raeburn 5206: my $startblock = 0;
5207: my $endblock = 0;
1.1062 raeburn 5208: my $triggerblock = '';
1.1075.2.160 raeburn 5209: my %live_courses;
5210: unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
5211: %live_courses = &findallcourses(undef,$uname,$udom);
5212: }
1.474 raeburn 5213:
1.490 raeburn 5214: # If uname is for a user, and activity is course-specific, i.e.,
5215: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 5216:
1.490 raeburn 5217: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.161. .1(raebu 5218:21): $activity eq 'groups' || $activity eq 'printout' ||
5219:21): $activity eq 'search' || $activity eq 'reinit' ||
5220:21): $activity eq 'alert') && ($env{'request.course.id'})) {
1.490 raeburn 5221: foreach my $key (keys(%live_courses)) {
5222: if ($key ne $env{'request.course.id'}) {
5223: delete($live_courses{$key});
5224: }
5225: }
5226: }
5227:
5228: my $otheruser = 0;
5229: my %own_courses;
5230: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
5231: # Resource belongs to user other than current user.
5232: $otheruser = 1;
5233: # Gather courses for current user
5234: %own_courses =
5235: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
5236: }
5237:
5238: # Gather active course roles - course coordinator, instructor,
5239: # exam proctor, ta, student, or custom role.
1.474 raeburn 5240:
5241: foreach my $course (keys(%live_courses)) {
1.482 raeburn 5242: my ($cdom,$cnum);
5243: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
5244: $cdom = $env{'course.'.$course.'.domain'};
5245: $cnum = $env{'course.'.$course.'.num'};
5246: } else {
1.490 raeburn 5247: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 5248: }
5249: my $no_ownblock = 0;
5250: my $no_userblock = 0;
1.533 raeburn 5251: if ($otheruser && $activity ne 'com') {
1.490 raeburn 5252: # Check if current user has 'evb' priv for this
5253: if (defined($own_courses{$course})) {
5254: foreach my $sec (keys(%{$own_courses{$course}})) {
5255: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
5256: if ($sec ne 'none') {
5257: $checkrole .= '/'.$sec;
5258: }
5259: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5260: $no_ownblock = 1;
5261: last;
5262: }
5263: }
5264: }
5265: # if they have 'evb' priv and are currently not playing student
5266: next if (($no_ownblock) &&
5267: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
5268: }
1.474 raeburn 5269: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 5270: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 5271: if ($sec ne 'none') {
1.482 raeburn 5272: $checkrole .= '/'.$sec;
1.474 raeburn 5273: }
1.490 raeburn 5274: if ($otheruser) {
5275: # Resource belongs to user other than current user.
5276: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 5277: my (%allroles,%userroles);
5278: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
5279: foreach my $entry (@{$live_courses{$course}{$sec}}) {
5280: my ($trole,$tdom,$tnum,$tsec);
5281: if ($entry =~ /^cr/) {
5282: ($trole,$tdom,$tnum,$tsec) =
5283: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
5284: } else {
5285: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
5286: }
5287: my ($spec,$area,$trest);
5288: $area = '/'.$tdom.'/'.$tnum;
5289: $trest = $tnum;
5290: if ($tsec ne '') {
5291: $area .= '/'.$tsec;
5292: $trest .= '/'.$tsec;
5293: }
5294: $spec = $trole.'.'.$area;
5295: if ($trole =~ /^cr/) {
5296: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
5297: $tdom,$spec,$trest,$area);
5298: } else {
5299: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
5300: $tdom,$spec,$trest,$area);
5301: }
5302: }
1.1075.2.124 raeburn 5303: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 5304: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
5305: if ($1) {
5306: $no_userblock = 1;
5307: last;
5308: }
1.486 raeburn 5309: }
5310: }
1.490 raeburn 5311: } else {
5312: # Resource belongs to current user
5313: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 5314: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
5315: $no_ownblock = 1;
5316: last;
5317: }
1.474 raeburn 5318: }
5319: }
5320: # if they have the evb priv and are currently not playing student
1.482 raeburn 5321: next if (($no_ownblock) &&
1.491 albertel 5322: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 5323: next if ($no_userblock);
1.474 raeburn 5324:
1.1075.2.128 raeburn 5325: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 5326: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 5327:
1.1062 raeburn 5328: my ($start,$end,$trigger) =
1.1075.2.147 raeburn 5329: &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502 raeburn 5330: if (($start != 0) &&
5331: (($startblock == 0) || ($startblock > $start))) {
5332: $startblock = $start;
1.1062 raeburn 5333: if ($trigger ne '') {
5334: $triggerblock = $trigger;
5335: }
1.502 raeburn 5336: }
5337: if (($end != 0) &&
5338: (($endblock == 0) || ($endblock < $end))) {
5339: $endblock = $end;
1.1062 raeburn 5340: if ($trigger ne '') {
5341: $triggerblock = $trigger;
5342: }
1.502 raeburn 5343: }
1.490 raeburn 5344: }
1.1062 raeburn 5345: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 5346: }
5347:
5348: sub get_blocks {
1.1075.2.147 raeburn 5349: my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490 raeburn 5350: my $startblock = 0;
5351: my $endblock = 0;
1.1062 raeburn 5352: my $triggerblock = '';
1.490 raeburn 5353: my $course = $cdom.'_'.$cnum;
5354: $setters->{$course} = {};
5355: $setters->{$course}{'staff'} = [];
5356: $setters->{$course}{'times'} = [];
1.1062 raeburn 5357: $setters->{$course}{'triggers'} = [];
5358: my (@blockers,%triggered);
5359: my $now = time;
5360: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5361: if ($activity eq 'docs') {
1.1075.2.148 raeburn 5362: my ($blocked,$nosymbcache,$noenccheck);
1.1075.2.147 raeburn 5363: if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
5364: $blocked = 1;
5365: $nosymbcache = 1;
1.1075.2.148 raeburn 5366: $noenccheck = 1;
1.1075.2.147 raeburn 5367: }
1.1075.2.148 raeburn 5368: @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062 raeburn 5369: foreach my $block (@blockers) {
5370: if ($block =~ /^firstaccess____(.+)$/) {
5371: my $item = $1;
5372: my $type = 'map';
5373: my $timersymb = $item;
5374: if ($item eq 'course') {
5375: $type = 'course';
5376: } elsif ($item =~ /___\d+___/) {
5377: $type = 'resource';
5378: } else {
5379: $timersymb = &Apache::lonnet::symbread($item);
5380: }
5381: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5382: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5383: $triggered{$block} = {
5384: start => $start,
5385: end => $end,
5386: type => $type,
5387: };
5388: }
5389: }
5390: } else {
5391: foreach my $block (keys(%commblocks)) {
5392: if ($block =~ m/^(\d+)____(\d+)$/) {
5393: my ($start,$end) = ($1,$2);
5394: if ($start <= time && $end >= time) {
5395: if (ref($commblocks{$block}) eq 'HASH') {
5396: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5397: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5398: unless(grep(/^\Q$block\E$/,@blockers)) {
5399: push(@blockers,$block);
5400: }
5401: }
5402: }
5403: }
5404: }
5405: } elsif ($block =~ /^firstaccess____(.+)$/) {
5406: my $item = $1;
5407: my $timersymb = $item;
5408: my $type = 'map';
5409: if ($item eq 'course') {
5410: $type = 'course';
5411: } elsif ($item =~ /___\d+___/) {
5412: $type = 'resource';
5413: } else {
5414: $timersymb = &Apache::lonnet::symbread($item);
5415: }
5416: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5417: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5418: if ($start && $end) {
5419: if (($start <= time) && ($end >= time)) {
1.1075.2.158 raeburn 5420: if (ref($commblocks{$block}) eq 'HASH') {
5421: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5422: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5423: unless(grep(/^\Q$block\E$/,@blockers)) {
5424: push(@blockers,$block);
5425: $triggered{$block} = {
5426: start => $start,
5427: end => $end,
5428: type => $type,
5429: };
5430: }
5431: }
5432: }
1.1062 raeburn 5433: }
5434: }
1.490 raeburn 5435: }
1.1062 raeburn 5436: }
5437: }
5438: }
5439: foreach my $blocker (@blockers) {
5440: my ($staff_name,$staff_dom,$title,$blocks) =
5441: &parse_block_record($commblocks{$blocker});
5442: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5443: my ($start,$end,$triggertype);
5444: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5445: ($start,$end) = ($1,$2);
5446: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5447: $start = $triggered{$blocker}{'start'};
5448: $end = $triggered{$blocker}{'end'};
5449: $triggertype = $triggered{$blocker}{'type'};
5450: }
5451: if ($start) {
5452: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5453: if ($triggertype) {
5454: push(@{$$setters{$course}{'triggers'}},$triggertype);
5455: } else {
5456: push(@{$$setters{$course}{'triggers'}},0);
5457: }
5458: if ( ($startblock == 0) || ($startblock > $start) ) {
5459: $startblock = $start;
5460: if ($triggertype) {
5461: $triggerblock = $blocker;
1.474 raeburn 5462: }
5463: }
1.1062 raeburn 5464: if ( ($endblock == 0) || ($endblock < $end) ) {
5465: $endblock = $end;
5466: if ($triggertype) {
5467: $triggerblock = $blocker;
5468: }
5469: }
1.474 raeburn 5470: }
5471: }
1.1062 raeburn 5472: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5473: }
5474:
5475: sub parse_block_record {
5476: my ($record) = @_;
5477: my ($setuname,$setudom,$title,$blocks);
5478: if (ref($record) eq 'HASH') {
5479: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5480: $title = &unescape($record->{'event'});
5481: $blocks = $record->{'blocks'};
5482: } else {
5483: my @data = split(/:/,$record,3);
5484: if (scalar(@data) eq 2) {
5485: $title = $data[1];
5486: ($setuname,$setudom) = split(/@/,$data[0]);
5487: } else {
5488: ($setuname,$setudom,$title) = @data;
5489: }
5490: $blocks = { 'com' => 'on' };
5491: }
5492: return ($setuname,$setudom,$title,$blocks);
5493: }
5494:
1.854 kalberla 5495: sub blocking_status {
1.1075.2.158 raeburn 5496: my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061 raeburn 5497: my %setters;
1.890 droeschl 5498:
1.1061 raeburn 5499: # check for active blocking
1.1075.2.158 raeburn 5500: if ($clientip eq '') {
5501: $clientip = &Apache::lonnet::get_requestor_ip();
5502: }
5503: my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
5504: &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062 raeburn 5505: my $blocked = 0;
1.1075.2.158 raeburn 5506: if (($startblock && $endblock) || ($by_ip)) {
1.1062 raeburn 5507: $blocked = 1;
5508: }
1.890 droeschl 5509:
1.1061 raeburn 5510: # caller just wants to know whether a block is active
5511: if (!wantarray) { return $blocked; }
5512:
5513: # build a link to a popup window containing the details
5514: my $querystring = "?activity=$activity";
1.1075.2.158 raeburn 5515: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
5516: if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1075.2.97 raeburn 5517: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5518: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5519: } elsif ($activity eq 'docs') {
1.1075.2.147 raeburn 5520: my $showurl = &Apache::lonenc::check_encrypt($url);
5521: $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
5522: if ($symb) {
5523: my $showsymb = &Apache::lonenc::check_encrypt($symb);
5524: $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
5525: }
1.1062 raeburn 5526: }
1.1061 raeburn 5527:
5528: my $output .= <<'END_MYBLOCK';
5529: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5530: var options = "width=" + w + ",height=" + h + ",";
5531: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5532: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5533: var newWin = window.open(url, wdwName, options);
5534: newWin.focus();
5535: }
1.890 droeschl 5536: END_MYBLOCK
1.854 kalberla 5537:
1.1061 raeburn 5538: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5539:
1.1061 raeburn 5540: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5541: my $text = &mt('Communication Blocked');
1.1075.2.93 raeburn 5542: my $class = 'LC_comblock';
1.1062 raeburn 5543: if ($activity eq 'docs') {
5544: $text = &mt('Content Access Blocked');
1.1075.2.93 raeburn 5545: $class = '';
1.1063 raeburn 5546: } elsif ($activity eq 'printout') {
5547: $text = &mt('Printing Blocked');
1.1075.2.97 raeburn 5548: } elsif ($activity eq 'passwd') {
5549: $text = &mt('Password Changing Blocked');
1.1075.2.158 raeburn 5550: } elsif ($activity eq 'grades') {
5551: $text = &mt('Gradebook Blocked');
5552: } elsif ($activity eq 'search') {
5553: $text = &mt('Search Blocked');
1.1075.2.161. .1(raebu 5554:21): } elsif ($activity eq 'alert') {
5555:21): $text = &mt('Checking Critical Messages Blocked');
5556:21): } elsif ($activity eq 'reinit') {
5557:21): $text = &mt('Checking Course Update Blocked');
1.1075.2.158 raeburn 5558: } elsif ($activity eq 'about') {
5559: $text = &mt('Access to User Information Pages Blocked');
1.1075.2.160 raeburn 5560: } elsif ($activity eq 'wishlist') {
5561: $text = &mt('Access to Stored Links Blocked');
5562: } elsif ($activity eq 'annotate') {
5563: $text = &mt('Access to Annotations Blocked');
1.1062 raeburn 5564: }
1.1061 raeburn 5565: $output .= <<"END_BLOCK";
1.1075.2.93 raeburn 5566: <div class='$class'>
1.869 kalberla 5567: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5568: title='$text'>
5569: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5570: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5571: title='$text'>$text</a>
1.867 kalberla 5572: </div>
5573:
5574: END_BLOCK
1.474 raeburn 5575:
1.1061 raeburn 5576: return ($blocked, $output);
1.854 kalberla 5577: }
1.490 raeburn 5578:
1.60 matthew 5579: ###############################################
5580:
1.682 raeburn 5581: sub check_ip_acc {
1.1075.2.105 raeburn 5582: my ($acc,$clientip)=@_;
1.682 raeburn 5583: &Apache::lonxml::debug("acc is $acc");
5584: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5585: return 1;
5586: }
5587: my $allowed=0;
1.1075.2.144 raeburn 5588: my $ip;
5589: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
5590: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
5591: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
5592: } else {
1.1075.2.150 raeburn 5593: my $remote_ip = &Apache::lonnet::get_requestor_ip();
5594: $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1075.2.144 raeburn 5595: }
1.682 raeburn 5596:
5597: my $name;
1.1075.2.161. .1(raebu 5598:21): my %access = (
5599:21): allowfrom => 1,
5600:21): denyfrom => 0,
5601:21): );
5602:21): my @allows;
5603:21): my @denies;
5604:21): foreach my $item (split(',',$acc)) {
5605:21): $item =~ s/^\s*//;
5606:21): $item =~ s/\s*$//;
5607:21): if ($item =~ /^\!(.+)$/) {
5608:21): push(@denies,$1);
5609:21): } else {
5610:21): push(@allows,$item);
5611:21): }
5612:21): }
5613:21): my $numdenies = scalar(@denies);
5614:21): my $numallows = scalar(@allows);
5615:21): my $count = 0;
5616:21): foreach my $pattern (@denies,@allows) {
5617:21): $count ++;
5618:21): my $acctype = 'allowfrom';
5619:21): if ($count <= $numdenies) {
5620:21): $acctype = 'denyfrom';
5621:21): }
1.682 raeburn 5622: if ($pattern =~ /\*$/) {
5623: #35.8.*
5624: $pattern=~s/\*//;
1.1075.2.161. .1(raebu 5625:21): if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5626: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5627: #35.8.3.[34-56]
5628: my $low=$2;
5629: my $high=$3;
5630: $pattern=$1;
5631: if ($ip =~ /^\Q$pattern\E/) {
5632: my $last=(split(/\./,$ip))[3];
1.1075.2.161. .1(raebu 5633:21): if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
1.682 raeburn 5634: }
5635: } elsif ($pattern =~ /^\*/) {
5636: #*.msu.edu
5637: $pattern=~s/\*//;
5638: if (!defined($name)) {
5639: use Socket;
5640: my $netaddr=inet_aton($ip);
5641: ($name)=gethostbyaddr($netaddr,AF_INET);
5642: }
1.1075.2.161. .1(raebu 5643:21): if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
1.682 raeburn 5644: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5645: #127.0.0.1
1.1075.2.161. .1(raebu 5646:21): if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
1.682 raeburn 5647: } else {
5648: #some.name.com
5649: if (!defined($name)) {
5650: use Socket;
5651: my $netaddr=inet_aton($ip);
5652: ($name)=gethostbyaddr($netaddr,AF_INET);
5653: }
1.1075.2.161. .1(raebu 5654:21): if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
5655:21): }
5656:21): if ($allowed =~ /^(0|1)$/) { last; }
5657:21): }
5658:21): if ($allowed eq '') {
5659:21): if ($numdenies && !$numallows) {
5660:21): $allowed = 1;
5661:21): } else {
5662:21): $allowed = 0;
1.682 raeburn 5663: }
5664: }
5665: return $allowed;
5666: }
5667:
5668: ###############################################
5669:
1.60 matthew 5670: =pod
5671:
1.112 bowersj2 5672: =head1 Domain Template Functions
5673:
5674: =over 4
5675:
5676: =item * &determinedomain()
1.60 matthew 5677:
5678: Inputs: $domain (usually will be undef)
5679:
1.63 www 5680: Returns: Determines which domain should be used for designs
1.60 matthew 5681:
5682: =cut
1.54 www 5683:
1.60 matthew 5684: ###############################################
1.63 www 5685: sub determinedomain {
5686: my $domain=shift;
1.531 albertel 5687: if (! $domain) {
1.60 matthew 5688: # Determine domain if we have not been given one
1.893 raeburn 5689: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5690: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5691: if ($env{'request.role.domain'}) {
5692: $domain=$env{'request.role.domain'};
1.60 matthew 5693: }
5694: }
1.63 www 5695: return $domain;
5696: }
5697: ###############################################
1.517 raeburn 5698:
1.518 albertel 5699: sub devalidate_domconfig_cache {
5700: my ($udom)=@_;
5701: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5702: }
5703:
5704: # ---------------------- Get domain configuration for a domain
5705: sub get_domainconf {
5706: my ($udom) = @_;
5707: my $cachetime=1800;
5708: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5709: if (defined($cached)) { return %{$result}; }
5710:
5711: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5712: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5713: my (%designhash,%legacy);
1.518 albertel 5714: if (keys(%domconfig) > 0) {
5715: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5716: if (keys(%{$domconfig{'login'}})) {
5717: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5718: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87 raeburn 5719: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5720: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5721: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5722: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5723: if ($key eq 'loginvia') {
5724: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5725: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5726: $designhash{$udom.'.login.loginvia'} = $server;
5727: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5728: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5729: } else {
5730: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5731: }
1.948 raeburn 5732: }
1.1075.2.87 raeburn 5733: } elsif ($key eq 'headtag') {
5734: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5735: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5736: }
1.946 raeburn 5737: }
1.1075.2.87 raeburn 5738: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5739: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5740: }
1.946 raeburn 5741: }
5742: }
5743: }
1.1075.2.158 raeburn 5744: } elsif ($key eq 'saml') {
5745: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5746: foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
5747: if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
5748: $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
1.1075.2.161. .9(raebu 5749:22): foreach my $item ('text','img','alt','url','title','window','notsso') {
1.1075.2.158 raeburn 5750: $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
5751: }
5752: }
5753: }
5754: }
1.946 raeburn 5755: } else {
5756: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5757: $designhash{$udom.'.login.'.$key.'_'.$img} =
5758: $domconfig{'login'}{$key}{$img};
5759: }
1.699 raeburn 5760: }
5761: } else {
5762: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5763: }
1.632 raeburn 5764: }
5765: } else {
5766: $legacy{'login'} = 1;
1.518 albertel 5767: }
1.632 raeburn 5768: } else {
5769: $legacy{'login'} = 1;
1.518 albertel 5770: }
5771: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5772: if (keys(%{$domconfig{'rolecolors'}})) {
5773: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5774: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5775: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5776: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5777: }
1.518 albertel 5778: }
5779: }
1.632 raeburn 5780: } else {
5781: $legacy{'rolecolors'} = 1;
1.518 albertel 5782: }
1.632 raeburn 5783: } else {
5784: $legacy{'rolecolors'} = 1;
1.518 albertel 5785: }
1.948 raeburn 5786: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5787: if ($domconfig{'autoenroll'}{'co-owners'}) {
5788: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5789: }
5790: }
1.632 raeburn 5791: if (keys(%legacy) > 0) {
5792: my %legacyhash = &get_legacy_domconf($udom);
5793: foreach my $item (keys(%legacyhash)) {
5794: if ($item =~ /^\Q$udom\E\.login/) {
5795: if ($legacy{'login'}) {
5796: $designhash{$item} = $legacyhash{$item};
5797: }
5798: } else {
5799: if ($legacy{'rolecolors'}) {
5800: $designhash{$item} = $legacyhash{$item};
5801: }
1.518 albertel 5802: }
5803: }
5804: }
1.632 raeburn 5805: } else {
5806: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5807: }
5808: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5809: $cachetime);
5810: return %designhash;
5811: }
5812:
1.632 raeburn 5813: sub get_legacy_domconf {
5814: my ($udom) = @_;
5815: my %legacyhash;
5816: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5817: my $designfile = $designdir.'/'.$udom.'.tab';
5818: if (-e $designfile) {
1.1075.2.128 raeburn 5819: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 5820: while (my $line = <$fh>) {
5821: next if ($line =~ /^\#/);
5822: chomp($line);
5823: my ($key,$val)=(split(/\=/,$line));
5824: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5825: }
5826: close($fh);
5827: }
5828: }
1.1026 raeburn 5829: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5830: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5831: }
5832: return %legacyhash;
5833: }
5834:
1.63 www 5835: =pod
5836:
1.112 bowersj2 5837: =item * &domainlogo()
1.63 www 5838:
5839: Inputs: $domain (usually will be undef)
5840:
5841: Returns: A link to a domain logo, if the domain logo exists.
5842: If the domain logo does not exist, a description of the domain.
5843:
5844: =cut
1.112 bowersj2 5845:
1.63 www 5846: ###############################################
5847: sub domainlogo {
1.517 raeburn 5848: my $domain = &determinedomain(shift);
1.518 albertel 5849: my %designhash = &get_domainconf($domain);
1.517 raeburn 5850: # See if there is a logo
5851: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5852: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5853: if ($imgsrc =~ m{^/(adm|res)/}) {
5854: if ($imgsrc =~ m{^/res/}) {
5855: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5856: &Apache::lonnet::repcopy($local_name);
5857: }
5858: $imgsrc = &lonhttpdurl($imgsrc);
1.1075.2.161. .2(raebu 5859:22): }
5860:22): my $alttext = $domain;
5861:22): if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
5862:22): $alttext = $designhash{$domain.'.login.alttext_domlogo'};
5863:22): }
5864:22): return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514 albertel 5865: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5866: return &Apache::lonnet::domain($domain,'description');
1.59 www 5867: } else {
1.60 matthew 5868: return '';
1.59 www 5869: }
5870: }
1.63 www 5871: ##############################################
5872:
5873: =pod
5874:
1.112 bowersj2 5875: =item * &designparm()
1.63 www 5876:
5877: Inputs: $which parameter; $domain (usually will be undef)
5878:
5879: Returns: value of designparamter $which
5880:
5881: =cut
1.112 bowersj2 5882:
1.397 albertel 5883:
1.400 albertel 5884: ##############################################
1.397 albertel 5885: sub designparm {
5886: my ($which,$domain)=@_;
5887: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5888: return $env{'environment.color.'.$which};
1.96 www 5889: }
1.63 www 5890: $domain=&determinedomain($domain);
1.1016 raeburn 5891: my %domdesign;
5892: unless ($domain eq 'public') {
5893: %domdesign = &get_domainconf($domain);
5894: }
1.520 raeburn 5895: my $output;
1.517 raeburn 5896: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5897: $output = $domdesign{$domain.'.'.$which};
1.63 www 5898: } else {
1.520 raeburn 5899: $output = $defaultdesign{$which};
5900: }
5901: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5902: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5903: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5904: if ($output =~ m{^/res/}) {
5905: my $local_name = &Apache::lonnet::filelocation('',$output);
5906: &Apache::lonnet::repcopy($local_name);
5907: }
1.520 raeburn 5908: $output = &lonhttpdurl($output);
5909: }
1.63 www 5910: }
1.520 raeburn 5911: return $output;
1.63 www 5912: }
1.59 www 5913:
1.822 bisitz 5914: ##############################################
5915: =pod
5916:
1.832 bisitz 5917: =item * &authorspace()
5918:
1.1028 raeburn 5919: Inputs: $url (usually will be undef).
1.832 bisitz 5920:
1.1075.2.40 raeburn 5921: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5922: directory being viewed (or for which action is being taken).
5923: If $url is provided, and begins /priv/<domain>/<uname>
5924: the path will be that portion of the $context argument.
5925: Otherwise the path will be for the author space of the current
5926: user when the current role is author, or for that of the
5927: co-author/assistant co-author space when the current role
5928: is co-author or assistant co-author.
1.832 bisitz 5929:
5930: =cut
5931:
5932: sub authorspace {
1.1028 raeburn 5933: my ($url) = @_;
5934: if ($url ne '') {
5935: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5936: return $1;
5937: }
5938: }
1.832 bisitz 5939: my $caname = '';
1.1024 www 5940: my $cadom = '';
1.1028 raeburn 5941: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5942: ($cadom,$caname) =
1.832 bisitz 5943: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5944: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5945: $caname = $env{'user.name'};
1.1024 www 5946: $cadom = $env{'user.domain'};
1.832 bisitz 5947: }
1.1028 raeburn 5948: if (($caname ne '') && ($cadom ne '')) {
5949: return "/priv/$cadom/$caname/";
5950: }
5951: return;
1.832 bisitz 5952: }
5953:
5954: ##############################################
5955: =pod
5956:
1.822 bisitz 5957: =item * &head_subbox()
5958:
5959: Inputs: $content (contains HTML code with page functions, etc.)
5960:
5961: Returns: HTML div with $content
5962: To be included in page header
5963:
5964: =cut
5965:
5966: sub head_subbox {
5967: my ($content)=@_;
5968: my $output =
1.993 raeburn 5969: '<div class="LC_head_subbox">'
1.822 bisitz 5970: .$content
5971: .'</div>'
5972: }
5973:
5974: ##############################################
5975: =pod
5976:
5977: =item * &CSTR_pageheader()
5978:
1.1026 raeburn 5979: Input: (optional) filename from which breadcrumb trail is built.
5980: In most cases no input as needed, as $env{'request.filename'}
5981: is appropriate for use in building the breadcrumb trail.
1.1075.2.161. .6(raebu 5982:22): frameset flag
5983:22): If page header is being requested for use in a frameset, then
5984:22): the second (option) argument -- frameset will be true, and
5985:22): the target attribute set for links should be target="_parent".
.26(raeb 5986:-24): If $title is supplied as the third arg, that will be used to
5987:-24): the left of the breadcrumbs tail for the current path.
1.822 bisitz 5988:
5989: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 5990: To be included on Authoring Space pages
1.822 bisitz 5991:
5992: =cut
5993:
5994: sub CSTR_pageheader {
1.1075.2.161. .26(raeb 5995:-24): my ($trailfile,$frameset,$title) = @_;
1.1026 raeburn 5996: if ($trailfile eq '') {
5997: $trailfile = $env{'request.filename'};
5998: }
5999:
6000: # this is for resources; directories have customtitle, and crumbs
6001: # and select recent are created in lonpubdir.pm
6002:
6003: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 6004: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 6005: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 6006: my $formaction = "/priv/$udom/$uname/$thisdisfn";
6007: $formaction =~ s{/+}{/}g;
1.822 bisitz 6008:
6009: my $parentpath = '';
6010: my $lastitem = '';
6011: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
6012: $parentpath = $1;
6013: $lastitem = $2;
6014: } else {
6015: $lastitem = $thisdisfn;
6016: }
1.921 bisitz 6017:
1.1075.2.161. .26(raeb 6018:-24): if ($title eq '') {
6019:-24): $title = &mt('Authoring Space');
6020:-24): }
6021:-24):
.6(raebu 6022:22): my ($target,$crumbtarget) = (' target="_top"','_top');
6023:22): if ($frameset) {
6024:22): $target = ' target="_parent"';
6025:22): $crumbtarget = '_parent';
.17(raeb 6026:-23): } elsif (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
6027:-23): $target = '';
6028:-23): $crumbtarget = '';
.6(raebu 6029:22): } elsif (($env{'request.deeplink.login'}) && ($env{'request.deeplink.target'})) {
6030:22): $target = ' target="'.$env{'request.deeplink.target'}.'"';
6031:22): $crumbtarget = $env{'request.deeplink.target'};
6032:22): }
6033:22):
1.921 bisitz 6034: my $output =
1.822 bisitz 6035: '<div>'
6036: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.161. .26(raeb 6037:-24): .'<b>'.$title.'</b> '
.6(raebu 6038:22): .'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
6039:22): .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
1.921 bisitz 6040:
6041: if ($lastitem) {
6042: $output .=
6043: '<span class="LC_filename">'
6044: .$lastitem
6045: .'</span>';
6046: }
6047: $output .=
6048: '<br />'
1.1075.2.161. .6(raebu 6049:22): #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
1.822 bisitz 6050: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
6051: .'</form>'
1.1075.2.161. .6(raebu 6052:22): .&Apache::lonmenu::constspaceform($frameset)
1.822 bisitz 6053: .'</div>';
1.921 bisitz 6054:
6055: return $output;
1.822 bisitz 6056: }
6057:
1.1075.2.161. .21(raeb 6058:-24): ##############################################
6059:-24): =pod
6060:-24):
6061:-24): =item * &nocodemirror()
6062:-24):
6063:-24): Input: None
6064:-24):
6065:-24): Returns: 1 if CodeMirror is deactivated based on
6066:-24): user's preference, or domain default,
6067:-24): if user indicated use of default.
6068:-24):
6069:-24): =cut
6070:-24):
6071:-24): sub nocodemirror {
6072:-24): my $nocodem = $env{'environment.nocodemirror'};
6073:-24): unless ($nocodem) {
6074:-24): my %domdefs = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
6075:-24): if ($domdefs{'nocodemirror'}) {
6076:-24): $nocodem = 'yes';
6077:-24): }
6078:-24): }
6079:-24): if ($nocodem eq 'yes') {
6080:-24): return 1;
6081:-24): }
6082:-24): return;
6083:-24): }
6084:-24):
6085:-24): ##############################################
6086:-24): =pod
6087:-24):
6088:-24): =item * &permitted_editors()
6089:-24):
6090:-24): Input: $uri (optional)
6091:-24):
6092:-24): Returns: %editors hash in which keys are editors
.25(raeb 6093:-24): permitted in current Authoring Space,
6094:-24): or in current course for web pages
6095:-24): created in a course.
6096:-24):
.21(raeb 6097:-24): Value for each key is 1. Possible keys
.25(raeb 6098:-24): are: edit, xml, and daxe.
6099:-24):
6100:-24): For a regular Authoring Space, if no specific
.21(raeb 6101:-24): set of editors has been set for the Author
6102:-24): who owns the Authoring Space, then the
6103:-24): domain default will be used. If no domain
6104:-24): default has been set, then the keys will be
6105:-24): edit and xml.
6106:-24):
.25(raeb 6107:-24): For a course author, or for web pages created
6108:-24): in a course, if no specific set of editors has
6109:-24): been set for the course, then the domain
6110:-24): course default will be used. If no domain
6111:-24): course default has been set, then the keys
6112:-24): will be edit and xml.
6113:-24):
.21(raeb 6114:-24): =cut
6115:-24):
6116:-24): sub permitted_editors {
6117:-24): my ($uri) = @_;
.25(raeb 6118:-24): my ($is_author,$is_coauthor,$is_course,$auname,$audom,%editors);
.21(raeb 6119:-24): if ($env{'request.role'} =~ m{^au\./}) {
6120:-24): $is_author = 1;
6121:-24): } elsif ($env{'request.role'} =~ m{^(?:ca|aa)\./($match_domain)/($match_username)}) {
6122:-24): ($audom,$auname) = ($1,$2);
6123:-24): if (($audom ne '') && ($auname ne '')) {
6124:-24): if (($env{'user.domain'} eq $audom) &&
6125:-24): ($env{'user.name'} eq $auname)) {
6126:-24): $is_author = 1;
6127:-24): } else {
6128:-24): $is_coauthor = 1;
6129:-24): }
6130:-24): }
6131:-24): } elsif ($env{'request.course.id'}) {
.25(raeb 6132:-24): my ($cdom,$cnum);
6133:-24): $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
6134:-24): $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
6135:-24): if (($env{'request.editurl'} =~ m{^/priv/\Q$cdom/$cnum\E/}) ||
6136:-24): ($env{'request.editurl'} =~ m{^/uploaded/\Q$cdom/$cnum\E/(docs|supplemental)/}) ||
6137:-24): ($uri =~ m{^/uploaded/\Q$cdom/$cnum\E/(docs|supplemental)/})) {
6138:-24): $is_course = 1;
6139:-24): } elsif ($env{'request.editurl'} =~ m{^/priv/($match_domain)/($match_username)/}) {
.21(raeb 6140:-24): ($audom,$auname) = ($1,$2);
6141:-24): } elsif ($env{'request.uri'} =~ m{^/priv/($match_domain)/($match_username)/}) {
6142:-24): ($audom,$auname) = ($1,$2);
6143:-24): } elsif (($uri eq '/daxesave') &&
.25(raeb 6144:-24): (($env{'form.path'} =~ m{^/daxeopen/priv/\Q$cdom/$cnum\E/}) ||
6145:-24): ($env{'form.path'} =~ m{^/daxeopen/uploaded/\Q$cdom/$cnum\E/(docs|supplemental)/}))) {
6146:-24): $is_course = 1;
6147:-24): } elsif (($uri eq '/daxesave') &&
.21(raeb 6148:-24): ($env{'form.path'} =~ m{^/daxeopen/priv/($match_domain)/($match_username)/})) {
6149:-24): ($audom,$auname) = ($1,$2);
6150:-24): }
.25(raeb 6151:-24): unless ($is_course) {
6152:-24): if (($audom ne '') && ($auname ne '')) {
6153:-24): if (($env{'user.domain'} eq $audom) &&
6154:-24): ($env{'user.name'} eq $auname)) {
6155:-24): $is_author = 1;
6156:-24): } else {
6157:-24): $is_coauthor = 1;
6158:-24): }
.21(raeb 6159:-24): }
6160:-24): }
6161:-24): }
6162:-24): if ($is_author) {
6163:-24): if (exists($env{'environment.editors'})) {
6164:-24): map { $editors{$_} = 1; } split(/,/,$env{'environment.editors'});
6165:-24): } else {
6166:-24): %editors = ( edit => 1,
6167:-24): xml => 1,
6168:-24): );
6169:-24): }
6170:-24): } elsif ($is_coauthor) {
6171:-24): if (exists($env{"environment.internal.editors./$audom/$auname"})) {
6172:-24): map { $editors{$_} = 1; } split(/,/,$env{"environment.internal.editors./$audom/$auname"});
6173:-24): } else {
6174:-24): %editors = ( edit => 1,
6175:-24): xml => 1,
6176:-24): );
6177:-24): }
.25(raeb 6178:-24): } elsif ($is_course) {
6179:-24): if (exists($env{'course.'.$env{'request.course.id'}.'.internal.crseditors'})) {
6180:-24): map { $editors{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.internal.crseditors'});
6181:-24): } else {
6182:-24): my %domdefaults = &Apache::lonnet::get_domain_defaults($env{'course.'.$env{'request.course.id'}.'.domain'});
6183:-24): if (exists($domdefaults{'crseditors'})) {
6184:-24): map { $editors{$_} = 1; } split(/,/,$domdefaults{'crseditors'});
6185:-24): } else {
6186:-24): %editors = ( edit => 1,
6187:-24): xml => 1,
6188:-24): );
6189:-24): }
6190:-24): }
.21(raeb 6191:-24): } else {
6192:-24): %editors = ( edit => 1,
6193:-24): xml => 1,
6194:-24): );
6195:-24): }
6196:-24): return %editors;
6197:-24): }
6198:-24):
1.60 matthew 6199: ###############################################
6200: ###############################################
6201:
6202: =pod
6203:
1.112 bowersj2 6204: =back
6205:
1.549 albertel 6206: =head1 HTML Helpers
1.112 bowersj2 6207:
6208: =over 4
6209:
6210: =item * &bodytag()
1.60 matthew 6211:
6212: Returns a uniform header for LON-CAPA web pages.
6213:
6214: Inputs:
6215:
1.112 bowersj2 6216: =over 4
6217:
6218: =item * $title, A title to be displayed on the page.
6219:
6220: =item * $function, the current role (can be undef).
6221:
6222: =item * $addentries, extra parameters for the <body> tag.
6223:
6224: =item * $bodyonly, if defined, only return the <body> tag.
6225:
6226: =item * $domain, if defined, force a given domain.
6227:
6228: =item * $forcereg, if page should register as content page (relevant for
1.86 www 6229: text interface only)
1.60 matthew 6230:
1.814 bisitz 6231: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
6232: navigational links
1.317 albertel 6233:
1.338 albertel 6234: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
6235:
1.1075.2.12 raeburn 6236: =item * $no_inline_link, if true and in remote mode, don't show the
6237: 'Switch To Inline Menu' link
6238:
1.460 albertel 6239: =item * $args, optional argument valid values are
6240: no_auto_mt_title -> prevents &mt()ing the title arg
1.1075.2.133 raeburn 6241: use_absolute -> for external resource or syllabus, this will
6242: contain https://<hostname> if server uses
6243: https (as per hosts.tab), but request is for http
6244: hostname -> hostname, from $r->hostname().
1.460 albertel 6245:
1.1075.2.15 raeburn 6246: =item * $advtoolsref, optional argument, ref to an array containing
6247: inlineremote items to be added in "Functions" menu below
6248: breadcrumbs.
6249:
1.1075.2.161. .1(raebu 6250:21): =item * $ltiscope, optional argument, will be one of: resource, map or
6251:21): course, if LON-CAPA is in LTI Provider context. Value is
6252:21): the scope of use, i.e., launch was for access to a single, a map
6253:21): or the entire course.
6254:21):
6255:21): =item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
6256:21): context, this will contain the URL for the landing item in
6257:21): the course, after launch from an LTI Consumer
6258:21):
6259:21): =item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
6260:21): context, this will contain a reference to hash of items
6261:21): to be included in the page header and/or inline menu.
6262:21):
.8(raebu 6263:22): =item * $menucoll, optional argument, if specific menu collection is in
6264:22): effect, either set as the default for the course, or set for
6265:22): the deeplink paramater for $env{'request.deeplink.login'}
6266:22): then $menucoll will be the number of that collection.
6267:22):
6268:22): =item * $menuref, optional argument, reference to a hash, containing the
6269:22): menu options included for the menu in effect, based on the
6270:22): configuration for the numbered menu collection in use.
6271:22):
6272:22): =item * $showncrumbsref, reference to a scalar. Calls to lonmenu::innerregister
6273:22): within &bodytag() can result in calls to lonhtmlcommon::breadcrumbs(),
6274:22): if so, $showncrumbsref is set there to 1, and will propagate back
6275:22): via &bodytag() to &start_page(), to prevent lonhtmlcommon::breadcrumbs()
6276:22): being called a second time.
6277:22):
1.112 bowersj2 6278: =back
6279:
1.60 matthew 6280: Returns: A uniform header for LON-CAPA web pages.
6281: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
6282: If $bodyonly is undef or zero, an html string containing a <body> tag and
6283: other decorations will be returned.
6284:
6285: =cut
6286:
1.54 www 6287: sub bodytag {
1.831 bisitz 6288: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.161. .1(raebu 6289:21): $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref,
.8(raebu 6290:22): $ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref,$showncrumbsref)=@_;
1.339 albertel 6291:
1.954 raeburn 6292: my $public;
6293: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
6294: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
6295: $public = 1;
6296: }
1.460 albertel 6297: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 6298: my $httphost = $args->{'use_absolute'};
1.1075.2.133 raeburn 6299: my $hostname = $args->{'hostname'};
1.339 albertel 6300:
1.183 matthew 6301: $function = &get_users_function() if (!$function);
1.339 albertel 6302: my $img = &designparm($function.'.img',$domain);
6303: my $font = &designparm($function.'.font',$domain);
6304: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
6305:
1.803 bisitz 6306: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 6307: 'bgcolor' => $pgbg,
1.339 albertel 6308: 'text' => $font,
6309: 'alink' => &designparm($function.'.alink',$domain),
6310: 'vlink' => &designparm($function.'.vlink',$domain),
6311: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 6312: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 6313:
1.63 www 6314: # role and realm
1.1075.2.68 raeburn 6315: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
6316: if ($realm) {
6317: $realm = '/'.$realm;
6318: }
1.1075.2.159 raeburn 6319: if ($role eq 'ca') {
1.479 albertel 6320: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 6321: $realm = &plainname($rname,$rdom);
1.378 raeburn 6322: }
1.55 www 6323: # realm
1.1075.2.158 raeburn 6324: my ($cid,$sec);
1.258 albertel 6325: if ($env{'request.course.id'}) {
1.1075.2.158 raeburn 6326: $cid = $env{'request.course.id'};
6327: if ($env{'request.course.sec'}) {
6328: $sec = $env{'request.course.sec'};
6329: }
6330: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
6331: if (&Apache::lonnet::is_course($1,$2)) {
6332: $cid = $1.'_'.$2;
6333: $sec = $3;
6334: }
6335: }
6336: if ($cid) {
1.378 raeburn 6337: if ($env{'request.role'} !~ /^cr/) {
6338: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1075.2.115 raeburn 6339: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1075.2.121 raeburn 6340: if ($env{'request.role.desc'}) {
6341: $role = $env{'request.role.desc'};
6342: } else {
6343: $role = &mt('Helpdesk[_1]',' '.$2);
6344: }
1.1075.2.115 raeburn 6345: } else {
6346: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 6347: }
1.1075.2.158 raeburn 6348: if ($sec) {
6349: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 6350: }
1.1075.2.158 raeburn 6351: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 6352: } else {
6353: $role = &Apache::lonnet::plaintext($role);
1.54 www 6354: }
1.433 albertel 6355:
1.359 albertel 6356: if (!$realm) { $realm=' '; }
1.330 albertel 6357:
1.438 albertel 6358: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 6359:
1.101 www 6360: # construct main body tag
1.359 albertel 6361: my $bodytag = "<body $extra_body_attr>".
1.1075.2.100 raeburn 6362: &Apache::lontexconvert::init_math_support();
1.252 albertel 6363:
1.1075.2.38 raeburn 6364: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
6365:
6366: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 6367: return $bodytag;
1.1075.2.38 raeburn 6368: }
1.359 albertel 6369:
1.954 raeburn 6370: if ($public) {
1.433 albertel 6371: undef($role);
6372: }
1.1075.2.158 raeburn 6373:
1.1075.2.161. .1(raebu 6374:21): my $showcrstitle = 1;
6375:21): if (($cid) && ($env{'request.lti.login'})) {
6376:21): if (ref($ltimenu) eq 'HASH') {
6377:21): unless ($ltimenu->{'role'}) {
6378:21): undef($role);
6379:21): }
6380:21): unless ($ltimenu->{'coursetitle'}) {
6381:21): $realm=' ';
6382:21): $showcrstitle = 0;
6383:21): }
6384:21): }
6385:21): } elsif (($cid) && ($menucoll)) {
6386:21): if (ref($menuref) eq 'HASH') {
6387:21): unless ($menuref->{'role'}) {
6388:21): undef($role);
6389:21): }
6390:21): unless ($menuref->{'crs'}) {
6391:21): $realm=' ';
6392:21): $showcrstitle = 0;
6393:21): }
6394:21): }
6395:21): }
6396:21):
1.762 bisitz 6397: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 6398: #
6399: # Extra info if you are the DC
6400: my $dc_info = '';
1.1075.2.161. .1(raebu 6401:21): if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
1.1075.2.158 raeburn 6402: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 6403: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 6404: $dc_info =~ s/\s+$//;
1.359 albertel 6405: }
6406:
1.1075.2.161. .1(raebu 6407:21): my $crstype;
6408:21): if ($cid) {
6409:21): $crstype = $env{'course.'.$cid.'.type'};
6410:21): } elsif ($args->{'crstype'}) {
6411:21): $crstype = $args->{'crstype'};
6412:21): }
6413:21):
1.1075.2.108 raeburn 6414: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.903 droeschl 6415:
1.1075.2.13 raeburn 6416: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
6417:
1.1075.2.38 raeburn 6418:
6419:
1.1075.2.21 raeburn 6420: my $funclist;
6421: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.161. .31(raeb 6422:-24): unless ($args->{'switchserver'}) {
6423:-24): $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
6424:-24): Apache::lonmenu::serverform();
6425:-24): my $forbodytag;
6426:-24): &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6427:-24): $forcereg,$args->{'group'},
6428:-24): $args->{'bread_crumbs'},
6429:-24): $advtoolsref,'','',\$forbodytag);
6430:-24): unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
6431:-24): $funclist = $forbodytag;
6432:-24): }
6433:-24): $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.1075.2.21 raeburn 6434: }
6435: } else {
1.903 droeschl 6436:
6437: # if ($env{'request.state'} eq 'construct') {
6438: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
6439: # }
6440:
1.1075.2.161. .31(raeb 6441:-24): my $need_endlcint;
6442:-24): unless ($args->{'switchserver'}) {
6443:-24): $bodytag .= Apache::lonhtmlcommon::scripttag(
6444:-24): Apache::lonmenu::utilityfunctions($httphost), 'start');
6445:-24): $need_endlcint = 1;
6446:-24): }
1.359 albertel 6447:
1.1075.2.161. .23(raeb 6448:-24): my $collapsible;
.21(raeb 6449:-24): if ($args->{'collapsible_header'} ne '') {
.23(raeb 6450:-24): $collapsible = 1;
6451:-24): my ($menustate,$tiptext,$divclass);
6452:-24): if ($args->{'start_collapsed'}) {
6453:-24): $menustate = 'collapsed';
6454:-24): $tiptext = 'display';
6455:-24): $divclass = 'hidden';
6456:-24): } else {
6457:-24): $menustate = 'expanded';
6458:-24): $tiptext = 'hide';
6459:-24): $divclass = 'shown';
6460:-24): }
6461:-24): my $alttext = &mt('menu state: '.$menustate);
6462:-24): my $tooltip = &mt($tiptext.' standard menus');
.21(raeb 6463:-24): $bodytag .= <<"END";
6464:-24): <div id="LC_expandingContainer" style="display:inline;">
6465:-24): <div id="LC_collapsible" class="LC_collapse_trigger" style="position: absolute;top: -5px;left: 0px; z-index:101; display:inline;">
.23(raeb 6466:-24): <a href="#" style="text-decoration:none;"><img class="LC_collapsible_indicator" alt="$alttext" title="$tooltip" src="/res/adm/pages/$menustate.png" style="border:0;margin:0;padding:0;max-width:100%;height:auto" /></a></div>
6467:-24): <div class="LC_menus_content $divclass">
.21(raeb 6468:-24): END
6469:-24): }
.30(raeb 6470:-24): if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} eq 'construct')) {
6471:-24): unless ($env{'form.inhibitmenu'}) {
6472:-24): $bodytag .= &inline_for_remote($public,$role,$realm,$dc_info,$no_inline_link);
6473:-24): }
6474:-24): } elsif (!$args->{'no_primary_menu'}) {
.4(raebu 6475:22): my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
.6(raebu 6476:22): $args->{'links_disabled'},
.21(raeb 6477:-24): $args->{'links_target'},
.23(raeb 6478:-24): $collapsible);
.1(raebu 6479:21): if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
6480:21): if ($dc_info) {
6481:21): $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
6482:21): }
6483:21): $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
6484:21): <em>$realm</em> $dc_info</div>|;
.31(raeb 6485:-24): if ($need_endlcint) {
6486:-24): $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6487:-24): }
.1(raebu 6488:21): return $bodytag;
1.1075.2.1 raeburn 6489: }
1.894 droeschl 6490:
1.1075.2.161. .1(raebu 6491:21): unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
6492:21): $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
6493:21): }
1.916 droeschl 6494:
1.1075.2.161. .1(raebu 6495:21): $bodytag .= $right;
1.852 droeschl 6496:
1.1075.2.161. .1(raebu 6497:21): if ($dc_info) {
6498:21): $dc_info = &dc_courseid_toggle($dc_info);
6499:21): }
6500:21): $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 6501: }
1.916 droeschl 6502:
1.1075.2.61 raeburn 6503: #if directed to not display the secondary menu, don't.
6504: if ($args->{'no_secondary_menu'}) {
1.1075.2.161. .31(raeb 6505:-24): if ($need_endlcint) {
6506:-24): $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6507:-24): }
1.1075.2.61 raeburn 6508: return $bodytag;
6509: }
1.903 droeschl 6510: #don't show menus for public users
1.954 raeburn 6511: if (!$public){
1.1075.2.161. .30(raeb 6512:-24): unless (($args->{'no_inline_menu'}) ||
6513:-24): (($env{'environment.remote'} eq 'on') &&
6514:-24): ($env{'request.state'} eq 'construct'))) {
.1(raebu 6515:21): $bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
6516:21): $args->{'no_primary_menu'},
6517:21): $menucoll,$menuref,
.6(raebu 6518:22): $args->{'links_disabled'},
6519:22): $args->{'links_target'});
.1(raebu 6520:21): }
1.903 droeschl 6521: $bodytag .= Apache::lonmenu::serverform();
1.1075.2.161. .31(raeb 6522:-24): if ($need_endlcint) {
6523:-24): $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6524:-24): }
1.920 raeburn 6525: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 6526: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1075.2.161. .8(raebu 6527:22): $args->{'bread_crumbs'},'','',$hostname,
6528:22): $ltiscope,$ltiuri,$showncrumbsref);
1.1075.2.116 raeburn 6529: } elsif ($forcereg) {
1.1075.2.22 raeburn 6530: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1075.2.161. .8(raebu 6531:22): $args->{'group'},$args->{'hide_buttons'},
6532:22): $hostname,$ltiscope,$ltiuri,$showncrumbsref);
1.1075.2.15 raeburn 6533: } else {
1.1075.2.21 raeburn 6534: my $forbodytag;
6535: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
6536: $forcereg,$args->{'group'},
6537: $args->{'bread_crumbs'},
1.1075.2.133 raeburn 6538: $advtoolsref,'',$hostname,
6539: \$forbodytag);
1.1075.2.21 raeburn 6540: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
6541: $bodytag .= $forbodytag;
6542: }
1.920 raeburn 6543: }
1.1075.2.161. .31(raeb 6544:-24): } else {
6545:-24): # this is to separate menu from content when there's no secondary
1.903 droeschl 6546: # menu. Especially needed for public accessible ressources.
6547: $bodytag .= '<hr style="clear:both" />';
1.1075.2.161. .31(raeb 6548:-24): if ($need_endlcint) {
6549:-24): $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
6550:-24): }
1.235 raeburn 6551: }
1.1075.2.161. .21(raeb 6552:-24): if ($args->{'collapsible_header'} ne '') {
6553:-24): $bodytag .= $args->{'collapsible_header'}.
6554:-24): '<div id="LC_collapsible_separator"></div>'.
6555:-24): '</div></div>';
6556:-24): }
1.235 raeburn 6557: return $bodytag;
1.1075.2.12 raeburn 6558: }
6559:
6560: #
6561: # Top frame rendering, Remote is up
6562: #
6563:
1.1075.2.161. .31(raeb 6564:-24): my $linkattr;
6565:-24): if ($args->{'links_disabled'}) {
6566:-24): $linkattr = 'class="LCisDisabled" aria-disabled="true"';
6567:-24): }
6568:-24):
1.1075.2.60 raeburn 6569: my $help=($no_inline_link?''
1.1075.2.161. .31(raeb 6570:-24): :&top_nav_help('Help',$linkattr));
1.1075.2.60 raeburn 6571:
1.1075.2.12 raeburn 6572: # Explicit link to get inline menu
6573: my $menu= ($no_inline_link?''
1.1075.2.161. .31(raeb 6574:-24): :'<a href="/adm/remote?action=collapse" $linkattr target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
1.1075.2.12 raeburn 6575:
6576: if ($dc_info) {
6577: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
6578: }
6579:
1.1075.2.38 raeburn 6580: my $name = &plainname($env{'user.name'},$env{'user.domain'});
6581: unless ($public) {
1.1075.2.161. .31(raeb 6582:-24): my $class = 'LC_menubuttons_link';
6583:-24): if ($args->{'links_disabled'}) {
6584:-24): $class .= ' LCisDisabled';
6585:-24): }
1.1075.2.38 raeburn 6586: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
1.1075.2.161. .31(raeb 6587:-24): undef,$class);
1.1075.2.38 raeburn 6588: }
6589:
1.1075.2.12 raeburn 6590: unless ($env{'form.inhibitmenu'}) {
1.1075.2.161. .30(raeb 6591:-24): $bodytag .= &inline_for_remote($public,$role,$realm,$dc_info,$no_inline_link);
1.1075.2.13 raeburn 6592: }
1.1075.2.21 raeburn 6593: return $bodytag."\n".$funclist;
1.182 matthew 6594: }
6595:
1.1075.2.161. .30(raeb 6596:-24): sub inline_for_remote {
6597:-24): my ($public,$role,$realm,$dc_info,$no_inline_link) = @_;
6598:-24): my $help=($no_inline_link?''
6599:-24): :&Apache::loncommon::top_nav_help('Help'));
6600:-24):
6601:-24): # Explicit link to get inline menu
6602:-24): my $menu= ($no_inline_link?''
6603:-24): :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
6604:-24):
6605:-24): if ($dc_info) {
6606:-24): $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
6607:-24): }
6608:-24):
6609:-24): my $name = &plainname($env{'user.name'},$env{'user.domain'});
6610:-24): unless ($public) {
6611:-24): $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
6612:-24): undef,'LC_menubuttons_link');
6613:-24): }
6614:-24):
6615:-24): return qq|<div id="LC_nav_bar">$name $role</div>
6616:-24): <ol class="LC_primary_menu LC_floatright LC_right">
6617:-24): <li>$help</li>
6618:-24): <li>$menu</li>
6619:-24): </ol><div id="LC_realm"> $realm $dc_info</div>|;
6620:-24): }
6621:-24):
1.917 raeburn 6622: sub dc_courseid_toggle {
6623: my ($dc_info) = @_;
1.980 raeburn 6624: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 6625: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 6626: &mt('(More ...)').'</a></span>'.
6627: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
6628: }
6629:
1.330 albertel 6630: sub make_attr_string {
6631: my ($register,$attr_ref) = @_;
6632:
6633: if ($attr_ref && !ref($attr_ref)) {
6634: die("addentries Must be a hash ref ".
6635: join(':',caller(1))." ".
6636: join(':',caller(0))." ");
6637: }
6638:
6639: if ($register) {
1.339 albertel 6640: my ($on_load,$on_unload);
6641: foreach my $key (keys(%{$attr_ref})) {
6642: if (lc($key) eq 'onload') {
6643: $on_load.=$attr_ref->{$key}.';';
6644: delete($attr_ref->{$key});
6645:
6646: } elsif (lc($key) eq 'onunload') {
6647: $on_unload.=$attr_ref->{$key}.';';
6648: delete($attr_ref->{$key});
6649: }
6650: }
1.1075.2.12 raeburn 6651: if ($env{'environment.remote'} eq 'on') {
6652: $attr_ref->{'onload'} =
6653: &Apache::lonmenu::loadevents(). $on_load;
6654: $attr_ref->{'onunload'}=
6655: &Apache::lonmenu::unloadevents().$on_unload;
6656: } else {
6657: $attr_ref->{'onload'} = $on_load;
6658: $attr_ref->{'onunload'}= $on_unload;
6659: }
1.330 albertel 6660: }
1.339 albertel 6661:
1.330 albertel 6662: my $attr_string;
1.1075.2.56 raeburn 6663: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6664: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6665: }
6666: return $attr_string;
6667: }
6668:
6669:
1.182 matthew 6670: ###############################################
1.251 albertel 6671: ###############################################
6672:
6673: =pod
6674:
6675: =item * &endbodytag()
6676:
6677: Returns a uniform footer for LON-CAPA web pages.
6678:
1.635 raeburn 6679: Inputs: 1 - optional reference to an args hash
6680: If in the hash, key for noredirectlink has a value which evaluates to true,
6681: a 'Continue' link is not displayed if the page contains an
6682: internal redirect in the <head></head> section,
6683: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6684:
6685: =cut
6686:
6687: sub endbodytag {
1.635 raeburn 6688: my ($args) = @_;
1.1075.2.6 raeburn 6689: my $endbodytag;
6690: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6691: $endbodytag='</body>';
6692: }
1.315 albertel 6693: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6694: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
1.1075.2.161. .9(raebu 6695:22): my ($endbodyjs,$idattr);
6696:22): if ($env{'internal.head.to_opener'}) {
6697:22): my $linkid = 'LC_continue_link';
6698:22): $idattr = ' id="'.$linkid.'"';
6699:22): my $redirect_for_js = &js_escape($env{'internal.head.redirect'});
6700:22): $endbodyjs=<<ENDJS;
6701:22): <script type="text/javascript">
6702:22): // <![CDATA[
6703:22): function ebFunction(evt) {
6704:22): evt.preventDefault();
6705:22): var dest = '$redirect_for_js';
6706:22): if (window.opener != null && !window.opener.closed) {
6707:22): window.opener.location.href=dest;
6708:22): window.close();
6709:22): } else {
6710:22): window.location.href=dest;
6711:22): }
6712:22): return false;
6713:22): }
6714:22):
6715:22): \$(document).ready(function () {
6716:22): if (document.getElementById('$linkid')) {
6717:22): var clickelem = document.getElementById('$linkid');
6718:22): clickelem.addEventListener('click',ebFunction,false);
6719:22): }
6720:22): });
6721:22): // ]]>
6722:22): </script>
6723:22): ENDJS
6724:22): }
1.635 raeburn 6725: $endbodytag=
1.1075.2.161. .9(raebu 6726:22): "$endbodyjs<br /><a href=\"$env{'internal.head.redirect'}\"$idattr>".
1.635 raeburn 6727: &mt('Continue').'</a>'.
6728: $endbodytag;
6729: }
1.315 albertel 6730: }
1.1075.2.161. .19(raeb 6731:-23): if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
6732:-23): $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
6733:-23): }
1.251 albertel 6734: return $endbodytag;
6735: }
6736:
1.352 albertel 6737: =pod
6738:
6739: =item * &standard_css()
6740:
6741: Returns a style sheet
6742:
6743: Inputs: (all optional)
6744: domain -> force to color decorate a page for a specific
6745: domain
6746: function -> force usage of a specific rolish color scheme
6747: bgcolor -> override the default page bgcolor
6748:
6749: =cut
6750:
1.343 albertel 6751: sub standard_css {
1.345 albertel 6752: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6753: $function = &get_users_function() if (!$function);
6754: my $img = &designparm($function.'.img', $domain);
6755: my $tabbg = &designparm($function.'.tabbg', $domain);
6756: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6757: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6758: #second colour for later usage
1.345 albertel 6759: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6760: my $pgbg_or_bgcolor =
6761: $bgcolor ||
1.352 albertel 6762: &designparm($function.'.pgbg', $domain);
1.382 albertel 6763: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6764: my $alink = &designparm($function.'.alink', $domain);
6765: my $vlink = &designparm($function.'.vlink', $domain);
6766: my $link = &designparm($function.'.link', $domain);
6767:
1.602 albertel 6768: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6769: my $mono = 'monospace';
1.850 bisitz 6770: my $data_table_head = $sidebg;
6771: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6772: my $data_table_dark = '#E0E0E0';
1.470 banghart 6773: my $data_table_darker = '#CCCCCC';
1.349 albertel 6774: my $data_table_highlight = '#FFFF00';
1.352 albertel 6775: my $mail_new = '#FFBB77';
6776: my $mail_new_hover = '#DD9955';
6777: my $mail_read = '#BBBB77';
6778: my $mail_read_hover = '#999944';
6779: my $mail_replied = '#AAAA88';
6780: my $mail_replied_hover = '#888855';
6781: my $mail_other = '#99BBBB';
6782: my $mail_other_hover = '#669999';
1.391 albertel 6783: my $table_header = '#DDDDDD';
1.489 raeburn 6784: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6785: my $lg_border_color = '#C8C8C8';
1.952 onken 6786: my $button_hover = '#BF2317';
1.392 albertel 6787:
1.608 albertel 6788: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6789: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6790: : '0 3px 0 4px';
1.448 albertel 6791:
1.523 albertel 6792:
1.343 albertel 6793: return <<END;
1.947 droeschl 6794:
6795: /* needed for iframe to allow 100% height in FF */
6796: body, html {
6797: margin: 0;
6798: padding: 0 0.5%;
6799: height: 99%; /* to avoid scrollbars */
6800: }
6801:
1.795 www 6802: body {
1.911 bisitz 6803: font-family: $sans;
6804: line-height:130%;
6805: font-size:0.83em;
6806: color:$font;
1.1075.2.161. .32(raeb 6807:-25): background-color: $pgbg_or_bgcolor;
1.795 www 6808: }
6809:
1.959 onken 6810: a:focus,
6811: a:focus img {
1.795 www 6812: color: red;
6813: }
1.698 harmsja 6814:
1.911 bisitz 6815: form, .inline {
6816: display: inline;
1.795 www 6817: }
1.721 harmsja 6818:
1.1075.2.161. .21(raeb 6819:-24): .LC_menus_content.shown{
.24(raeb 6820:-24): display: block;
.21(raeb 6821:-24): }
6822:-24):
6823:-24): .LC_menus_content.hidden {
6824:-24): display: none;
6825:-24): }
6826:-24):
1.795 www 6827: .LC_right {
1.911 bisitz 6828: text-align:right;
1.795 www 6829: }
6830:
6831: .LC_middle {
1.911 bisitz 6832: vertical-align:middle;
1.795 www 6833: }
1.721 harmsja 6834:
1.1075.2.38 raeburn 6835: .LC_floatleft {
6836: float: left;
6837: }
6838:
6839: .LC_floatright {
6840: float: right;
6841: }
6842:
1.911 bisitz 6843: .LC_400Box {
6844: width:400px;
6845: }
1.721 harmsja 6846:
1.1075.2.161. .21(raeb 6847:-24): #LC_collapsible_separator {
6848:-24): border: 1px solid black;
6849:-24): width: 99.9%;
6850:-24): height: 0px;
6851:-24): }
6852:-24):
1.947 droeschl 6853: .LC_iframecontainer {
6854: width: 98%;
6855: margin: 0;
6856: position: fixed;
6857: top: 8.5em;
6858: bottom: 0;
6859: }
6860:
6861: .LC_iframecontainer iframe{
6862: border: none;
6863: width: 100%;
6864: height: 100%;
6865: }
6866:
1.778 bisitz 6867: .LC_filename {
6868: font-family: $mono;
6869: white-space:pre;
1.921 bisitz 6870: font-size: 120%;
1.778 bisitz 6871: }
6872:
6873: .LC_fileicon {
6874: border: none;
6875: height: 1.3em;
6876: vertical-align: text-bottom;
6877: margin-right: 0.3em;
6878: text-decoration:none;
6879: }
6880:
1.1008 www 6881: .LC_setting {
6882: text-decoration:underline;
6883: }
6884:
1.350 albertel 6885: .LC_error {
6886: color: red;
6887: }
1.795 www 6888:
1.1075.2.15 raeburn 6889: .LC_warning {
6890: color: darkorange;
6891: }
6892:
1.457 albertel 6893: .LC_diff_removed {
1.733 bisitz 6894: color: red;
1.394 albertel 6895: }
1.532 albertel 6896:
6897: .LC_info,
1.457 albertel 6898: .LC_success,
6899: .LC_diff_added {
1.350 albertel 6900: color: green;
6901: }
1.795 www 6902:
1.802 bisitz 6903: div.LC_confirm_box {
6904: background-color: #FAFAFA;
6905: border: 1px solid $lg_border_color;
6906: margin-right: 0;
6907: padding: 5px;
6908: }
6909:
6910: div.LC_confirm_box .LC_error img,
6911: div.LC_confirm_box .LC_success img {
6912: vertical-align: middle;
6913: }
6914:
1.1075.2.108 raeburn 6915: .LC_maxwidth {
6916: max-width: 100%;
6917: height: auto;
6918: }
6919:
6920: .LC_textsize_mobile {
6921: \@media only screen and (max-device-width: 480px) {
6922: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6923: }
6924: }
6925:
1.440 albertel 6926: .LC_icon {
1.771 droeschl 6927: border: none;
1.790 droeschl 6928: vertical-align: middle;
1.771 droeschl 6929: }
6930:
1.543 albertel 6931: .LC_docs_spacer {
6932: width: 25px;
6933: height: 1px;
1.771 droeschl 6934: border: none;
1.543 albertel 6935: }
1.346 albertel 6936:
1.532 albertel 6937: .LC_internal_info {
1.735 bisitz 6938: color: #999999;
1.532 albertel 6939: }
6940:
1.794 www 6941: .LC_discussion {
1.1050 www 6942: background: $data_table_dark;
1.911 bisitz 6943: border: 1px solid black;
6944: margin: 2px;
1.794 www 6945: }
6946:
6947: .LC_disc_action_left {
1.1050 www 6948: background: $sidebg;
1.911 bisitz 6949: text-align: left;
1.1050 www 6950: padding: 4px;
6951: margin: 2px;
1.794 www 6952: }
6953:
6954: .LC_disc_action_right {
1.1050 www 6955: background: $sidebg;
1.911 bisitz 6956: text-align: right;
1.1050 www 6957: padding: 4px;
6958: margin: 2px;
1.794 www 6959: }
6960:
6961: .LC_disc_new_item {
1.911 bisitz 6962: background: white;
6963: border: 2px solid red;
1.1050 www 6964: margin: 4px;
6965: padding: 4px;
1.794 www 6966: }
6967:
6968: .LC_disc_old_item {
1.911 bisitz 6969: background: white;
1.1050 www 6970: margin: 4px;
6971: padding: 4px;
1.794 www 6972: }
6973:
1.458 albertel 6974: table.LC_pastsubmission {
6975: border: 1px solid black;
6976: margin: 2px;
6977: }
6978:
1.924 bisitz 6979: table#LC_menubuttons {
1.345 albertel 6980: width: 100%;
6981: background: $pgbg;
1.392 albertel 6982: border: 2px;
1.402 albertel 6983: border-collapse: separate;
1.803 bisitz 6984: padding: 0;
1.345 albertel 6985: }
1.392 albertel 6986:
1.801 tempelho 6987: table#LC_title_bar a {
6988: color: $fontmenu;
6989: }
1.836 bisitz 6990:
1.807 droeschl 6991: table#LC_title_bar {
1.819 tempelho 6992: clear: both;
1.836 bisitz 6993: display: none;
1.807 droeschl 6994: }
6995:
1.795 www 6996: table#LC_title_bar,
1.933 droeschl 6997: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6998: table#LC_title_bar.LC_with_remote {
1.359 albertel 6999: width: 100%;
1.392 albertel 7000: border-color: $pgbg;
7001: border-style: solid;
7002: border-width: $border;
1.379 albertel 7003: background: $pgbg;
1.801 tempelho 7004: color: $fontmenu;
1.392 albertel 7005: border-collapse: collapse;
1.803 bisitz 7006: padding: 0;
1.819 tempelho 7007: margin: 0;
1.359 albertel 7008: }
1.795 www 7009:
1.933 droeschl 7010: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 7011: margin: 0;
7012: padding: 0;
1.933 droeschl 7013: position: relative;
7014: list-style: none;
1.913 droeschl 7015: }
1.933 droeschl 7016: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 7017: display: inline;
7018: }
1.933 droeschl 7019:
7020: .LC_breadcrumb_tools_navigation {
1.913 droeschl 7021: padding: 0;
1.933 droeschl 7022: margin: 0;
7023: float: left;
1.913 droeschl 7024: }
1.933 droeschl 7025: .LC_breadcrumb_tools_tools {
7026: padding: 0;
7027: margin: 0;
1.913 droeschl 7028: float: right;
7029: }
7030:
1.359 albertel 7031: table#LC_title_bar td {
7032: background: $tabbg;
7033: }
1.795 www 7034:
1.911 bisitz 7035: table#LC_menubuttons img {
1.803 bisitz 7036: border: none;
1.346 albertel 7037: }
1.795 www 7038:
1.842 droeschl 7039: .LC_breadcrumbs_component {
1.911 bisitz 7040: float: right;
7041: margin: 0 1em;
1.357 albertel 7042: }
1.842 droeschl 7043: .LC_breadcrumbs_component img {
1.911 bisitz 7044: vertical-align: middle;
1.777 tempelho 7045: }
1.795 www 7046:
1.1075.2.108 raeburn 7047: .LC_breadcrumbs_hoverable {
7048: background: $sidebg;
7049: }
7050:
1.383 albertel 7051: td.LC_table_cell_checkbox {
7052: text-align: center;
7053: }
1.795 www 7054:
7055: .LC_fontsize_small {
1.911 bisitz 7056: font-size: 70%;
1.705 tempelho 7057: }
7058:
1.844 bisitz 7059: #LC_breadcrumbs {
1.911 bisitz 7060: clear:both;
7061: background: $sidebg;
7062: border-bottom: 1px solid $lg_border_color;
7063: line-height: 2.5em;
1.933 droeschl 7064: overflow: hidden;
1.911 bisitz 7065: margin: 0;
7066: padding: 0;
1.995 raeburn 7067: text-align: left;
1.819 tempelho 7068: }
1.862 bisitz 7069:
1.1075.2.16 raeburn 7070: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 7071: clear:both;
7072: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 7073: border: 1px solid $sidebg;
1.1075.2.16 raeburn 7074: margin: 0 0 10px 0;
1.966 bisitz 7075: padding: 3px;
1.995 raeburn 7076: text-align: left;
1.822 bisitz 7077: }
7078:
1.795 www 7079: .LC_fontsize_medium {
1.911 bisitz 7080: font-size: 85%;
1.705 tempelho 7081: }
7082:
1.795 www 7083: .LC_fontsize_large {
1.911 bisitz 7084: font-size: 120%;
1.705 tempelho 7085: }
7086:
1.346 albertel 7087: .LC_menubuttons_inline_text {
7088: color: $font;
1.698 harmsja 7089: font-size: 90%;
1.701 harmsja 7090: padding-left:3px;
1.346 albertel 7091: }
7092:
1.934 droeschl 7093: .LC_menubuttons_inline_text img{
7094: vertical-align: middle;
7095: }
7096:
1.1051 www 7097: li.LC_menubuttons_inline_text img {
1.951 onken 7098: cursor:pointer;
1.1002 droeschl 7099: text-decoration: none;
1.951 onken 7100: }
7101:
1.526 www 7102: .LC_menubuttons_link {
7103: text-decoration: none;
7104: }
1.795 www 7105:
1.522 albertel 7106: .LC_menubuttons_category {
1.521 www 7107: color: $font;
1.526 www 7108: background: $pgbg;
1.521 www 7109: font-size: larger;
7110: font-weight: bold;
7111: }
7112:
1.346 albertel 7113: td.LC_menubuttons_text {
1.911 bisitz 7114: color: $font;
1.346 albertel 7115: }
1.706 harmsja 7116:
1.346 albertel 7117: .LC_current_location {
7118: background: $tabbg;
7119: }
1.795 www 7120:
1.1075.2.134 raeburn 7121: td.LC_zero_height {
7122: line-height: 0;
7123: cellpadding: 0;
7124: }
7125:
1.938 bisitz 7126: table.LC_data_table {
1.347 albertel 7127: border: 1px solid #000000;
1.402 albertel 7128: border-collapse: separate;
1.426 albertel 7129: border-spacing: 1px;
1.610 albertel 7130: background: $pgbg;
1.347 albertel 7131: }
1.795 www 7132:
1.422 albertel 7133: .LC_data_table_dense {
7134: font-size: small;
7135: }
1.795 www 7136:
1.507 raeburn 7137: table.LC_nested_outer {
7138: border: 1px solid #000000;
1.589 raeburn 7139: border-collapse: collapse;
1.803 bisitz 7140: border-spacing: 0;
1.507 raeburn 7141: width: 100%;
7142: }
1.795 www 7143:
1.879 raeburn 7144: table.LC_innerpickbox,
1.507 raeburn 7145: table.LC_nested {
1.803 bisitz 7146: border: none;
1.589 raeburn 7147: border-collapse: collapse;
1.803 bisitz 7148: border-spacing: 0;
1.507 raeburn 7149: width: 100%;
7150: }
1.795 www 7151:
1.911 bisitz 7152: table.LC_data_table tr th,
7153: table.LC_calendar tr th,
1.879 raeburn 7154: table.LC_prior_tries tr th,
7155: table.LC_innerpickbox tr th {
1.349 albertel 7156: font-weight: bold;
7157: background-color: $data_table_head;
1.801 tempelho 7158: color:$fontmenu;
1.701 harmsja 7159: font-size:90%;
1.347 albertel 7160: }
1.795 www 7161:
1.879 raeburn 7162: table.LC_innerpickbox tr th,
7163: table.LC_innerpickbox tr td {
7164: vertical-align: top;
7165: }
7166:
1.711 raeburn 7167: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 7168: background-color: #CCCCCC;
1.711 raeburn 7169: font-weight: bold;
7170: text-align: left;
7171: }
1.795 www 7172:
1.912 bisitz 7173: table.LC_data_table tr.LC_odd_row > td {
7174: background-color: $data_table_light;
7175: padding: 2px;
7176: vertical-align: top;
7177: }
7178:
1.809 bisitz 7179: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 7180: background-color: $data_table_light;
1.912 bisitz 7181: vertical-align: top;
7182: }
7183:
7184: table.LC_data_table tr.LC_even_row > td {
7185: background-color: $data_table_dark;
1.425 albertel 7186: padding: 2px;
1.900 bisitz 7187: vertical-align: top;
1.347 albertel 7188: }
1.795 www 7189:
1.809 bisitz 7190: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 7191: background-color: $data_table_dark;
1.900 bisitz 7192: vertical-align: top;
1.347 albertel 7193: }
1.795 www 7194:
1.425 albertel 7195: table.LC_data_table tr.LC_data_table_highlight td {
7196: background-color: $data_table_darker;
7197: }
1.795 www 7198:
1.639 raeburn 7199: table.LC_data_table tr td.LC_leftcol_header {
7200: background-color: $data_table_head;
7201: font-weight: bold;
7202: }
1.795 www 7203:
1.451 albertel 7204: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 7205: table.LC_nested tr.LC_empty_row td {
1.421 albertel 7206: font-weight: bold;
7207: font-style: italic;
7208: text-align: center;
7209: padding: 8px;
1.347 albertel 7210: }
1.795 www 7211:
1.1075.2.30 raeburn 7212: table.LC_data_table tr.LC_empty_row td,
7213: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 7214: background-color: $sidebg;
7215: }
7216:
7217: table.LC_nested tr.LC_empty_row td {
7218: background-color: #FFFFFF;
7219: }
7220:
1.890 droeschl 7221: table.LC_caption {
7222: }
7223:
1.507 raeburn 7224: table.LC_nested tr.LC_empty_row td {
1.465 albertel 7225: padding: 4ex
7226: }
1.795 www 7227:
1.507 raeburn 7228: table.LC_nested_outer tr th {
7229: font-weight: bold;
1.801 tempelho 7230: color:$fontmenu;
1.507 raeburn 7231: background-color: $data_table_head;
1.701 harmsja 7232: font-size: small;
1.507 raeburn 7233: border-bottom: 1px solid #000000;
7234: }
1.795 www 7235:
1.507 raeburn 7236: table.LC_nested_outer tr td.LC_subheader {
7237: background-color: $data_table_head;
7238: font-weight: bold;
7239: font-size: small;
7240: border-bottom: 1px solid #000000;
7241: text-align: right;
1.451 albertel 7242: }
1.795 www 7243:
1.507 raeburn 7244: table.LC_nested tr.LC_info_row td {
1.735 bisitz 7245: background-color: #CCCCCC;
1.451 albertel 7246: font-weight: bold;
7247: font-size: small;
1.507 raeburn 7248: text-align: center;
7249: }
1.795 www 7250:
1.589 raeburn 7251: table.LC_nested tr.LC_info_row td.LC_left_item,
7252: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 7253: text-align: left;
1.451 albertel 7254: }
1.795 www 7255:
1.507 raeburn 7256: table.LC_nested td {
1.735 bisitz 7257: background-color: #FFFFFF;
1.451 albertel 7258: font-size: small;
1.507 raeburn 7259: }
1.795 www 7260:
1.507 raeburn 7261: table.LC_nested_outer tr th.LC_right_item,
7262: table.LC_nested tr.LC_info_row td.LC_right_item,
7263: table.LC_nested tr.LC_odd_row td.LC_right_item,
7264: table.LC_nested tr td.LC_right_item {
1.451 albertel 7265: text-align: right;
7266: }
7267:
1.507 raeburn 7268: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 7269: background-color: #EEEEEE;
1.451 albertel 7270: }
7271:
1.473 raeburn 7272: table.LC_createuser {
7273: }
7274:
7275: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 7276: font-size: small;
1.473 raeburn 7277: }
7278:
7279: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 7280: background-color: #CCCCCC;
1.473 raeburn 7281: font-weight: bold;
7282: text-align: center;
7283: }
7284:
1.349 albertel 7285: table.LC_calendar {
7286: border: 1px solid #000000;
7287: border-collapse: collapse;
1.917 raeburn 7288: width: 98%;
1.349 albertel 7289: }
1.795 www 7290:
1.349 albertel 7291: table.LC_calendar_pickdate {
7292: font-size: xx-small;
7293: }
1.795 www 7294:
1.349 albertel 7295: table.LC_calendar tr td {
7296: border: 1px solid #000000;
7297: vertical-align: top;
1.917 raeburn 7298: width: 14%;
1.349 albertel 7299: }
1.795 www 7300:
1.349 albertel 7301: table.LC_calendar tr td.LC_calendar_day_empty {
7302: background-color: $data_table_dark;
7303: }
1.795 www 7304:
1.779 bisitz 7305: table.LC_calendar tr td.LC_calendar_day_current {
7306: background-color: $data_table_highlight;
1.777 tempelho 7307: }
1.795 www 7308:
1.938 bisitz 7309: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 7310: background-color: $mail_new;
7311: }
1.795 www 7312:
1.938 bisitz 7313: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 7314: background-color: $mail_new_hover;
7315: }
1.795 www 7316:
1.938 bisitz 7317: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 7318: background-color: $mail_read;
7319: }
1.795 www 7320:
1.938 bisitz 7321: /*
7322: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 7323: background-color: $mail_read_hover;
7324: }
1.938 bisitz 7325: */
1.795 www 7326:
1.938 bisitz 7327: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 7328: background-color: $mail_replied;
7329: }
1.795 www 7330:
1.938 bisitz 7331: /*
7332: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 7333: background-color: $mail_replied_hover;
7334: }
1.938 bisitz 7335: */
1.795 www 7336:
1.938 bisitz 7337: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 7338: background-color: $mail_other;
7339: }
1.795 www 7340:
1.938 bisitz 7341: /*
7342: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 7343: background-color: $mail_other_hover;
7344: }
1.938 bisitz 7345: */
1.494 raeburn 7346:
1.777 tempelho 7347: table.LC_data_table tr > td.LC_browser_file,
7348: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 7349: background: #AAEE77;
1.389 albertel 7350: }
1.795 www 7351:
1.777 tempelho 7352: table.LC_data_table tr > td.LC_browser_file_locked,
7353: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 7354: background: #FFAA99;
1.387 albertel 7355: }
1.795 www 7356:
1.777 tempelho 7357: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 7358: background: #888888;
1.779 bisitz 7359: }
1.795 www 7360:
1.777 tempelho 7361: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 7362: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 7363: background: #F8F866;
1.777 tempelho 7364: }
1.795 www 7365:
1.696 bisitz 7366: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 7367: background: #E0E8FF;
1.387 albertel 7368: }
1.696 bisitz 7369:
1.707 bisitz 7370: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 7371: /* background: #77FF77; */
1.707 bisitz 7372: }
1.795 www 7373:
1.707 bisitz 7374: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 7375: border-right: 8px solid #FFFF77;
1.707 bisitz 7376: }
1.795 www 7377:
1.707 bisitz 7378: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 7379: border-right: 8px solid #FFAA77;
1.707 bisitz 7380: }
1.795 www 7381:
1.707 bisitz 7382: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 7383: border-right: 8px solid #FF7777;
1.707 bisitz 7384: }
1.795 www 7385:
1.707 bisitz 7386: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 7387: border-right: 8px solid #AAFF77;
1.707 bisitz 7388: }
1.795 www 7389:
1.707 bisitz 7390: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 7391: border-right: 8px solid #11CC55;
1.707 bisitz 7392: }
7393:
1.388 albertel 7394: span.LC_current_location {
1.701 harmsja 7395: font-size:larger;
1.388 albertel 7396: background: $pgbg;
7397: }
1.387 albertel 7398:
1.1029 www 7399: span.LC_current_nav_location {
7400: font-weight:bold;
7401: background: $sidebg;
7402: }
7403:
1.395 albertel 7404: span.LC_parm_menu_item {
7405: font-size: larger;
7406: }
1.795 www 7407:
1.395 albertel 7408: span.LC_parm_scope_all {
7409: color: red;
7410: }
1.795 www 7411:
1.395 albertel 7412: span.LC_parm_scope_folder {
7413: color: green;
7414: }
1.795 www 7415:
1.395 albertel 7416: span.LC_parm_scope_resource {
7417: color: orange;
7418: }
1.795 www 7419:
1.395 albertel 7420: span.LC_parm_part {
7421: color: blue;
7422: }
1.795 www 7423:
1.911 bisitz 7424: span.LC_parm_folder,
7425: span.LC_parm_symb {
1.395 albertel 7426: font-size: x-small;
7427: font-family: $mono;
7428: color: #AAAAAA;
7429: }
7430:
1.977 bisitz 7431: ul.LC_parm_parmlist li {
7432: display: inline-block;
7433: padding: 0.3em 0.8em;
7434: vertical-align: top;
7435: width: 150px;
7436: border-top:1px solid $lg_border_color;
7437: }
7438:
1.795 www 7439: td.LC_parm_overview_level_menu,
7440: td.LC_parm_overview_map_menu,
7441: td.LC_parm_overview_parm_selectors,
7442: td.LC_parm_overview_restrictions {
1.396 albertel 7443: border: 1px solid black;
7444: border-collapse: collapse;
7445: }
1.795 www 7446:
1.396 albertel 7447: table.LC_parm_overview_restrictions td {
7448: border-width: 1px 4px 1px 4px;
7449: border-style: solid;
7450: border-color: $pgbg;
7451: text-align: center;
7452: }
1.795 www 7453:
1.396 albertel 7454: table.LC_parm_overview_restrictions th {
7455: background: $tabbg;
7456: border-width: 1px 4px 1px 4px;
7457: border-style: solid;
7458: border-color: $pgbg;
7459: }
1.795 www 7460:
1.398 albertel 7461: table#LC_helpmenu {
1.803 bisitz 7462: border: none;
1.398 albertel 7463: height: 55px;
1.803 bisitz 7464: border-spacing: 0;
1.398 albertel 7465: }
7466:
7467: table#LC_helpmenu fieldset legend {
7468: font-size: larger;
7469: }
1.795 www 7470:
1.397 albertel 7471: table#LC_helpmenu_links {
7472: width: 100%;
7473: border: 1px solid black;
7474: background: $pgbg;
1.803 bisitz 7475: padding: 0;
1.397 albertel 7476: border-spacing: 1px;
7477: }
1.795 www 7478:
1.397 albertel 7479: table#LC_helpmenu_links tr td {
7480: padding: 1px;
7481: background: $tabbg;
1.399 albertel 7482: text-align: center;
7483: font-weight: bold;
1.397 albertel 7484: }
1.396 albertel 7485:
1.795 www 7486: table#LC_helpmenu_links a:link,
7487: table#LC_helpmenu_links a:visited,
1.397 albertel 7488: table#LC_helpmenu_links a:active {
7489: text-decoration: none;
7490: color: $font;
7491: }
1.795 www 7492:
1.397 albertel 7493: table#LC_helpmenu_links a:hover {
7494: text-decoration: underline;
7495: color: $vlink;
7496: }
1.396 albertel 7497:
1.417 albertel 7498: .LC_chrt_popup_exists {
7499: border: 1px solid #339933;
7500: margin: -1px;
7501: }
1.795 www 7502:
1.417 albertel 7503: .LC_chrt_popup_up {
7504: border: 1px solid yellow;
7505: margin: -1px;
7506: }
1.795 www 7507:
1.417 albertel 7508: .LC_chrt_popup {
7509: border: 1px solid #8888FF;
7510: background: #CCCCFF;
7511: }
1.795 www 7512:
1.421 albertel 7513: table.LC_pick_box {
7514: border-collapse: separate;
7515: background: white;
7516: border: 1px solid black;
7517: border-spacing: 1px;
7518: }
1.795 www 7519:
1.421 albertel 7520: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 7521: background: $sidebg;
1.421 albertel 7522: font-weight: bold;
1.900 bisitz 7523: text-align: left;
1.740 bisitz 7524: vertical-align: top;
1.421 albertel 7525: width: 184px;
7526: padding: 8px;
7527: }
1.795 www 7528:
1.579 raeburn 7529: table.LC_pick_box td.LC_pick_box_value {
7530: text-align: left;
7531: padding: 8px;
7532: }
1.795 www 7533:
1.579 raeburn 7534: table.LC_pick_box td.LC_pick_box_select {
7535: text-align: left;
7536: padding: 8px;
7537: }
1.795 www 7538:
1.424 albertel 7539: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 7540: padding: 0;
1.421 albertel 7541: height: 1px;
7542: background: black;
7543: }
1.795 www 7544:
1.421 albertel 7545: table.LC_pick_box td.LC_pick_box_submit {
7546: text-align: right;
7547: }
1.795 www 7548:
1.579 raeburn 7549: table.LC_pick_box td.LC_evenrow_value {
7550: text-align: left;
7551: padding: 8px;
7552: background-color: $data_table_light;
7553: }
1.795 www 7554:
1.579 raeburn 7555: table.LC_pick_box td.LC_oddrow_value {
7556: text-align: left;
7557: padding: 8px;
7558: background-color: $data_table_light;
7559: }
1.795 www 7560:
1.579 raeburn 7561: span.LC_helpform_receipt_cat {
7562: font-weight: bold;
7563: }
1.795 www 7564:
1.424 albertel 7565: table.LC_group_priv_box {
7566: background: white;
7567: border: 1px solid black;
7568: border-spacing: 1px;
7569: }
1.795 www 7570:
1.424 albertel 7571: table.LC_group_priv_box td.LC_pick_box_title {
7572: background: $tabbg;
7573: font-weight: bold;
7574: text-align: right;
7575: width: 184px;
7576: }
1.795 www 7577:
1.424 albertel 7578: table.LC_group_priv_box td.LC_groups_fixed {
7579: background: $data_table_light;
7580: text-align: center;
7581: }
1.795 www 7582:
1.424 albertel 7583: table.LC_group_priv_box td.LC_groups_optional {
7584: background: $data_table_dark;
7585: text-align: center;
7586: }
1.795 www 7587:
1.424 albertel 7588: table.LC_group_priv_box td.LC_groups_functionality {
7589: background: $data_table_darker;
7590: text-align: center;
7591: font-weight: bold;
7592: }
1.795 www 7593:
1.424 albertel 7594: table.LC_group_priv td {
7595: text-align: left;
1.803 bisitz 7596: padding: 0;
1.424 albertel 7597: }
7598:
7599: .LC_navbuttons {
7600: margin: 2ex 0ex 2ex 0ex;
7601: }
1.795 www 7602:
1.423 albertel 7603: .LC_topic_bar {
7604: font-weight: bold;
7605: background: $tabbg;
1.918 wenzelju 7606: margin: 1em 0em 1em 2em;
1.805 bisitz 7607: padding: 3px;
1.918 wenzelju 7608: font-size: 1.2em;
1.423 albertel 7609: }
1.795 www 7610:
1.423 albertel 7611: .LC_topic_bar span {
1.918 wenzelju 7612: left: 0.5em;
7613: position: absolute;
1.423 albertel 7614: vertical-align: middle;
1.918 wenzelju 7615: font-size: 1.2em;
1.423 albertel 7616: }
1.795 www 7617:
1.423 albertel 7618: table.LC_course_group_status {
7619: margin: 20px;
7620: }
1.795 www 7621:
1.423 albertel 7622: table.LC_status_selector td {
7623: vertical-align: top;
7624: text-align: center;
1.424 albertel 7625: padding: 4px;
7626: }
1.795 www 7627:
1.599 albertel 7628: div.LC_feedback_link {
1.616 albertel 7629: clear: both;
1.829 kalberla 7630: background: $sidebg;
1.779 bisitz 7631: width: 100%;
1.829 kalberla 7632: padding-bottom: 10px;
7633: border: 1px $tabbg solid;
1.833 kalberla 7634: height: 22px;
7635: line-height: 22px;
7636: padding-top: 5px;
7637: }
7638:
7639: div.LC_feedback_link img {
7640: height: 22px;
1.867 kalberla 7641: vertical-align:middle;
1.829 kalberla 7642: }
7643:
1.911 bisitz 7644: div.LC_feedback_link a {
1.829 kalberla 7645: text-decoration: none;
1.489 raeburn 7646: }
1.795 www 7647:
1.867 kalberla 7648: div.LC_comblock {
1.911 bisitz 7649: display:inline;
1.867 kalberla 7650: color:$font;
7651: font-size:90%;
7652: }
7653:
7654: div.LC_feedback_link div.LC_comblock {
7655: padding-left:5px;
7656: }
7657:
7658: div.LC_feedback_link div.LC_comblock a {
7659: color:$font;
7660: }
7661:
1.489 raeburn 7662: span.LC_feedback_link {
1.858 bisitz 7663: /* background: $feedback_link_bg; */
1.599 albertel 7664: font-size: larger;
7665: }
1.795 www 7666:
1.599 albertel 7667: span.LC_message_link {
1.858 bisitz 7668: /* background: $feedback_link_bg; */
1.599 albertel 7669: font-size: larger;
7670: position: absolute;
7671: right: 1em;
1.489 raeburn 7672: }
1.421 albertel 7673:
1.515 albertel 7674: table.LC_prior_tries {
1.524 albertel 7675: border: 1px solid #000000;
7676: border-collapse: separate;
7677: border-spacing: 1px;
1.515 albertel 7678: }
1.523 albertel 7679:
1.515 albertel 7680: table.LC_prior_tries td {
1.524 albertel 7681: padding: 2px;
1.515 albertel 7682: }
1.523 albertel 7683:
7684: .LC_answer_correct {
1.795 www 7685: background: lightgreen;
7686: color: darkgreen;
7687: padding: 6px;
1.523 albertel 7688: }
1.795 www 7689:
1.523 albertel 7690: .LC_answer_charged_try {
1.797 www 7691: background: #FFAAAA;
1.795 www 7692: color: darkred;
7693: padding: 6px;
1.523 albertel 7694: }
1.795 www 7695:
1.779 bisitz 7696: .LC_answer_not_charged_try,
1.523 albertel 7697: .LC_answer_no_grade,
7698: .LC_answer_late {
1.795 www 7699: background: lightyellow;
1.523 albertel 7700: color: black;
1.795 www 7701: padding: 6px;
1.523 albertel 7702: }
1.795 www 7703:
1.523 albertel 7704: .LC_answer_previous {
1.795 www 7705: background: lightblue;
7706: color: darkblue;
7707: padding: 6px;
1.523 albertel 7708: }
1.795 www 7709:
1.779 bisitz 7710: .LC_answer_no_message {
1.777 tempelho 7711: background: #FFFFFF;
7712: color: black;
1.795 www 7713: padding: 6px;
1.779 bisitz 7714: }
1.795 www 7715:
1.1075.2.140 raeburn 7716: .LC_answer_unknown,
7717: .LC_answer_warning {
1.779 bisitz 7718: background: orange;
7719: color: black;
1.795 www 7720: padding: 6px;
1.777 tempelho 7721: }
1.795 www 7722:
1.529 albertel 7723: span.LC_prior_numerical,
7724: span.LC_prior_string,
7725: span.LC_prior_custom,
7726: span.LC_prior_reaction,
7727: span.LC_prior_math {
1.925 bisitz 7728: font-family: $mono;
1.523 albertel 7729: white-space: pre;
7730: }
7731:
1.525 albertel 7732: span.LC_prior_string {
1.925 bisitz 7733: font-family: $mono;
1.525 albertel 7734: white-space: pre;
7735: }
7736:
1.523 albertel 7737: table.LC_prior_option {
7738: width: 100%;
7739: border-collapse: collapse;
7740: }
1.795 www 7741:
1.911 bisitz 7742: table.LC_prior_rank,
1.795 www 7743: table.LC_prior_match {
1.528 albertel 7744: border-collapse: collapse;
7745: }
1.795 www 7746:
1.528 albertel 7747: table.LC_prior_option tr td,
7748: table.LC_prior_rank tr td,
7749: table.LC_prior_match tr td {
1.524 albertel 7750: border: 1px solid #000000;
1.515 albertel 7751: }
7752:
1.855 bisitz 7753: .LC_nobreak {
1.544 albertel 7754: white-space: nowrap;
1.519 raeburn 7755: }
7756:
1.576 raeburn 7757: span.LC_cusr_emph {
7758: font-style: italic;
7759: }
7760:
1.633 raeburn 7761: span.LC_cusr_subheading {
7762: font-weight: normal;
7763: font-size: 85%;
7764: }
7765:
1.861 bisitz 7766: div.LC_docs_entry_move {
1.859 bisitz 7767: border: 1px solid #BBBBBB;
1.545 albertel 7768: background: #DDDDDD;
1.861 bisitz 7769: width: 22px;
1.859 bisitz 7770: padding: 1px;
7771: margin: 0;
1.545 albertel 7772: }
7773:
1.861 bisitz 7774: table.LC_data_table tr > td.LC_docs_entry_commands,
7775: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7776: font-size: x-small;
7777: }
1.795 www 7778:
1.861 bisitz 7779: .LC_docs_entry_parameter {
7780: white-space: nowrap;
7781: }
7782:
1.544 albertel 7783: .LC_docs_copy {
1.545 albertel 7784: color: #000099;
1.544 albertel 7785: }
1.795 www 7786:
1.544 albertel 7787: .LC_docs_cut {
1.545 albertel 7788: color: #550044;
1.544 albertel 7789: }
1.795 www 7790:
1.544 albertel 7791: .LC_docs_rename {
1.545 albertel 7792: color: #009900;
1.544 albertel 7793: }
1.795 www 7794:
1.544 albertel 7795: .LC_docs_remove {
1.545 albertel 7796: color: #990000;
7797: }
7798:
1.1075.2.134 raeburn 7799: .LC_domprefs_email,
1.547 albertel 7800: .LC_docs_reinit_warn,
7801: .LC_docs_ext_edit {
7802: font-size: x-small;
7803: }
7804:
1.545 albertel 7805: table.LC_docs_adddocs td,
7806: table.LC_docs_adddocs th {
7807: border: 1px solid #BBBBBB;
7808: padding: 4px;
7809: background: #DDDDDD;
1.543 albertel 7810: }
7811:
1.584 albertel 7812: table.LC_sty_begin {
7813: background: #BBFFBB;
7814: }
1.795 www 7815:
1.584 albertel 7816: table.LC_sty_end {
7817: background: #FFBBBB;
7818: }
7819:
1.589 raeburn 7820: table.LC_double_column {
1.803 bisitz 7821: border-width: 0;
1.589 raeburn 7822: border-collapse: collapse;
7823: width: 100%;
7824: padding: 2px;
7825: }
7826:
7827: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7828: top: 2px;
1.589 raeburn 7829: left: 2px;
7830: width: 47%;
7831: vertical-align: top;
7832: }
7833:
7834: table.LC_double_column tr td.LC_right_col {
7835: top: 2px;
1.779 bisitz 7836: right: 2px;
1.589 raeburn 7837: width: 47%;
7838: vertical-align: top;
7839: }
7840:
1.591 raeburn 7841: div.LC_left_float {
7842: float: left;
7843: padding-right: 5%;
1.597 albertel 7844: padding-bottom: 4px;
1.591 raeburn 7845: }
7846:
7847: div.LC_clear_float_header {
1.597 albertel 7848: padding-bottom: 2px;
1.591 raeburn 7849: }
7850:
7851: div.LC_clear_float_footer {
1.597 albertel 7852: padding-top: 10px;
1.591 raeburn 7853: clear: both;
7854: }
7855:
1.597 albertel 7856: div.LC_grade_show_user {
1.941 bisitz 7857: /* border-left: 5px solid $sidebg; */
7858: border-top: 5px solid #000000;
7859: margin: 50px 0 0 0;
1.936 bisitz 7860: padding: 15px 0 5px 10px;
1.597 albertel 7861: }
1.795 www 7862:
1.936 bisitz 7863: div.LC_grade_show_user_odd_row {
1.941 bisitz 7864: /* border-left: 5px solid #000000; */
7865: }
7866:
7867: div.LC_grade_show_user div.LC_Box {
7868: margin-right: 50px;
1.597 albertel 7869: }
7870:
7871: div.LC_grade_submissions,
7872: div.LC_grade_message_center,
1.936 bisitz 7873: div.LC_grade_info_links {
1.597 albertel 7874: margin: 5px;
7875: width: 99%;
7876: background: #FFFFFF;
7877: }
1.795 www 7878:
1.597 albertel 7879: div.LC_grade_submissions_header,
1.936 bisitz 7880: div.LC_grade_message_center_header {
1.705 tempelho 7881: font-weight: bold;
7882: font-size: large;
1.597 albertel 7883: }
1.795 www 7884:
1.597 albertel 7885: div.LC_grade_submissions_body,
1.936 bisitz 7886: div.LC_grade_message_center_body {
1.597 albertel 7887: border: 1px solid black;
7888: width: 99%;
7889: background: #FFFFFF;
7890: }
1.795 www 7891:
1.613 albertel 7892: table.LC_scantron_action {
7893: width: 100%;
7894: }
1.795 www 7895:
1.613 albertel 7896: table.LC_scantron_action tr th {
1.698 harmsja 7897: font-weight:bold;
7898: font-style:normal;
1.613 albertel 7899: }
1.795 www 7900:
1.779 bisitz 7901: .LC_edit_problem_header,
1.614 albertel 7902: div.LC_edit_problem_footer {
1.705 tempelho 7903: font-weight: normal;
7904: font-size: medium;
1.602 albertel 7905: margin: 2px;
1.1060 bisitz 7906: background-color: $sidebg;
1.600 albertel 7907: }
1.795 www 7908:
1.600 albertel 7909: div.LC_edit_problem_header,
1.602 albertel 7910: div.LC_edit_problem_header div,
1.614 albertel 7911: div.LC_edit_problem_footer,
7912: div.LC_edit_problem_footer div,
1.602 albertel 7913: div.LC_edit_problem_editxml_header,
7914: div.LC_edit_problem_editxml_header div {
1.1075.2.112 raeburn 7915: z-index: 100;
1.600 albertel 7916: }
1.795 www 7917:
1.600 albertel 7918: div.LC_edit_problem_header_title {
1.705 tempelho 7919: font-weight: bold;
7920: font-size: larger;
1.602 albertel 7921: background: $tabbg;
7922: padding: 3px;
1.1060 bisitz 7923: margin: 0 0 5px 0;
1.602 albertel 7924: }
1.795 www 7925:
1.602 albertel 7926: table.LC_edit_problem_header_title {
7927: width: 100%;
1.600 albertel 7928: background: $tabbg;
1.602 albertel 7929: }
7930:
1.1075.2.112 raeburn 7931: div.LC_edit_actionbar {
7932: background-color: $sidebg;
7933: margin: 0;
7934: padding: 0;
7935: line-height: 200%;
1.602 albertel 7936: }
1.795 www 7937:
1.1075.2.112 raeburn 7938: div.LC_edit_actionbar div{
7939: padding: 0;
7940: margin: 0;
7941: display: inline-block;
1.600 albertel 7942: }
1.795 www 7943:
1.1075.2.34 raeburn 7944: .LC_edit_opt {
7945: padding-left: 1em;
7946: white-space: nowrap;
7947: }
7948:
1.1075.2.57 raeburn 7949: .LC_edit_problem_latexhelper{
7950: text-align: right;
7951: }
7952:
7953: #LC_edit_problem_colorful div{
7954: margin-left: 40px;
7955: }
7956:
1.1075.2.112 raeburn 7957: #LC_edit_problem_codemirror div{
7958: margin-left: 0px;
7959: }
7960:
1.911 bisitz 7961: img.stift {
1.803 bisitz 7962: border-width: 0;
7963: vertical-align: middle;
1.677 riegler 7964: }
1.680 riegler 7965:
1.923 bisitz 7966: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7967: vertical-align: top;
1.777 tempelho 7968: }
1.795 www 7969:
1.716 raeburn 7970: div.LC_createcourse {
1.911 bisitz 7971: margin: 10px 10px 10px 10px;
1.716 raeburn 7972: }
7973:
1.917 raeburn 7974: .LC_dccid {
1.1075.2.38 raeburn 7975: float: right;
1.917 raeburn 7976: margin: 0.2em 0 0 0;
7977: padding: 0;
7978: font-size: 90%;
7979: display:none;
7980: }
7981:
1.897 wenzelju 7982: ol.LC_primary_menu a:hover,
1.721 harmsja 7983: ol#LC_MenuBreadcrumbs a:hover,
7984: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7985: ul#LC_secondary_menu a:hover,
1.721 harmsja 7986: .LC_FormSectionClearButton input:hover
1.795 www 7987: ul.LC_TabContent li:hover a {
1.952 onken 7988: color:$button_hover;
1.911 bisitz 7989: text-decoration:none;
1.693 droeschl 7990: }
7991:
1.779 bisitz 7992: h1 {
1.911 bisitz 7993: padding: 0;
7994: line-height:130%;
1.693 droeschl 7995: }
1.698 harmsja 7996:
1.911 bisitz 7997: h2,
7998: h3,
7999: h4,
8000: h5,
8001: h6 {
8002: margin: 5px 0 5px 0;
8003: padding: 0;
8004: line-height:130%;
1.693 droeschl 8005: }
1.795 www 8006:
8007: .LC_hcell {
1.911 bisitz 8008: padding:3px 15px 3px 15px;
8009: margin: 0;
8010: background-color:$tabbg;
8011: color:$fontmenu;
8012: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 8013: }
1.795 www 8014:
1.840 bisitz 8015: .LC_Box > .LC_hcell {
1.911 bisitz 8016: margin: 0 -10px 10px -10px;
1.835 bisitz 8017: }
8018:
1.721 harmsja 8019: .LC_noBorder {
1.911 bisitz 8020: border: 0;
1.698 harmsja 8021: }
1.693 droeschl 8022:
1.721 harmsja 8023: .LC_FormSectionClearButton input {
1.911 bisitz 8024: background-color:transparent;
8025: border: none;
8026: cursor:pointer;
8027: text-decoration:underline;
1.693 droeschl 8028: }
1.763 bisitz 8029:
8030: .LC_help_open_topic {
1.911 bisitz 8031: color: #FFFFFF;
8032: background-color: #EEEEFF;
8033: margin: 1px;
8034: padding: 4px;
8035: border: 1px solid #000033;
8036: white-space: nowrap;
8037: /* vertical-align: middle; */
1.759 neumanie 8038: }
1.693 droeschl 8039:
1.911 bisitz 8040: dl,
8041: ul,
8042: div,
8043: fieldset {
8044: margin: 10px 10px 10px 0;
8045: /* overflow: hidden; */
1.693 droeschl 8046: }
1.795 www 8047:
1.1075.2.161. .18(raeb 8048:-23): fieldset#LC_selectuser {
8049:-23): margin: 0;
8050:-23): padding: 0;
8051:-23): }
8052:-23):
1.1075.2.90 raeburn 8053: article.geogebraweb div {
8054: margin: 0;
8055: }
8056:
1.838 bisitz 8057: fieldset > legend {
1.911 bisitz 8058: font-weight: bold;
8059: padding: 0 5px 0 5px;
1.838 bisitz 8060: }
8061:
1.813 bisitz 8062: #LC_nav_bar {
1.911 bisitz 8063: float: left;
1.995 raeburn 8064: background-color: $pgbg_or_bgcolor;
1.966 bisitz 8065: margin: 0 0 2px 0;
1.807 droeschl 8066: }
8067:
1.916 droeschl 8068: #LC_realm {
8069: margin: 0.2em 0 0 0;
8070: padding: 0;
8071: font-weight: bold;
8072: text-align: center;
1.995 raeburn 8073: background-color: $pgbg_or_bgcolor;
1.916 droeschl 8074: }
8075:
1.911 bisitz 8076: #LC_nav_bar em {
8077: font-weight: bold;
8078: font-style: normal;
1.807 droeschl 8079: }
8080:
1.897 wenzelju 8081: ol.LC_primary_menu {
1.934 droeschl 8082: margin: 0;
1.1075.2.2 raeburn 8083: padding: 0;
1.807 droeschl 8084: }
8085:
1.852 droeschl 8086: ol#LC_PathBreadcrumbs {
1.911 bisitz 8087: margin: 0;
1.693 droeschl 8088: }
8089:
1.897 wenzelju 8090: ol.LC_primary_menu li {
1.1075.2.2 raeburn 8091: color: RGB(80, 80, 80);
8092: vertical-align: middle;
8093: text-align: left;
8094: list-style: none;
1.1075.2.112 raeburn 8095: position: relative;
1.1075.2.2 raeburn 8096: float: left;
1.1075.2.112 raeburn 8097: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
8098: line-height: 1.5em;
1.1075.2.2 raeburn 8099: }
8100:
1.1075.2.113 raeburn 8101: ol.LC_primary_menu li a,
1.1075.2.112 raeburn 8102: ol.LC_primary_menu li p {
1.1075.2.2 raeburn 8103: display: block;
8104: margin: 0;
8105: padding: 0 5px 0 10px;
8106: text-decoration: none;
8107: }
8108:
1.1075.2.112 raeburn 8109: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
8110: display: inline-block;
8111: width: 95%;
8112: text-align: left;
8113: }
8114:
8115: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
8116: display: inline-block;
8117: width: 5%;
8118: float: right;
8119: text-align: right;
8120: font-size: 70%;
8121: }
8122:
8123: ol.LC_primary_menu ul {
1.1075.2.2 raeburn 8124: display: none;
1.1075.2.112 raeburn 8125: width: 15em;
1.1075.2.2 raeburn 8126: background-color: $data_table_light;
1.1075.2.112 raeburn 8127: position: absolute;
8128: top: 100%;
8129: }
8130:
8131: ol.LC_primary_menu ul ul {
8132: left: 100%;
8133: top: 0;
1.1075.2.2 raeburn 8134: }
8135:
1.1075.2.112 raeburn 8136: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1075.2.2 raeburn 8137: display: block;
8138: position: absolute;
8139: margin: 0;
8140: padding: 0;
1.1075.2.5 raeburn 8141: z-index: 2;
1.1075.2.2 raeburn 8142: }
8143:
8144: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1075.2.112 raeburn 8145: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1075.2.2 raeburn 8146: font-size: 90%;
1.911 bisitz 8147: vertical-align: top;
1.1075.2.2 raeburn 8148: float: none;
1.1075.2.5 raeburn 8149: border-left: 1px solid black;
8150: border-right: 1px solid black;
1.1075.2.112 raeburn 8151: /* A dark bottom border to visualize different menu options;
8152: overwritten in the create_submenu routine for the last border-bottom of the menu */
8153: border-bottom: 1px solid $data_table_dark;
1.1075.2.2 raeburn 8154: }
8155:
1.1075.2.112 raeburn 8156: ol.LC_primary_menu li li p:hover {
8157: color:$button_hover;
8158: text-decoration:none;
8159: background-color:$data_table_dark;
1.1075.2.2 raeburn 8160: }
8161:
8162: ol.LC_primary_menu li li a:hover {
8163: color:$button_hover;
8164: background-color:$data_table_dark;
1.693 droeschl 8165: }
8166:
1.1075.2.112 raeburn 8167: /* Font-size equal to the size of the predecessors*/
8168: ol.LC_primary_menu li:hover li li {
8169: font-size: 100%;
8170: }
8171:
1.897 wenzelju 8172: ol.LC_primary_menu li img {
1.911 bisitz 8173: vertical-align: bottom;
1.934 droeschl 8174: height: 1.1em;
1.1075.2.3 raeburn 8175: margin: 0.2em 0 0 0;
1.693 droeschl 8176: }
8177:
1.897 wenzelju 8178: ol.LC_primary_menu a {
1.911 bisitz 8179: color: RGB(80, 80, 80);
8180: text-decoration: none;
1.693 droeschl 8181: }
1.795 www 8182:
1.949 droeschl 8183: ol.LC_primary_menu a.LC_new_message {
8184: font-weight:bold;
8185: color: darkred;
8186: }
8187:
1.975 raeburn 8188: ol.LC_docs_parameters {
8189: margin-left: 0;
8190: padding: 0;
8191: list-style: none;
8192: }
8193:
8194: ol.LC_docs_parameters li {
8195: margin: 0;
8196: padding-right: 20px;
8197: display: inline;
8198: }
8199:
1.976 raeburn 8200: ol.LC_docs_parameters li:before {
8201: content: "\\002022 \\0020";
8202: }
8203:
8204: li.LC_docs_parameters_title {
8205: font-weight: bold;
8206: }
8207:
8208: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
8209: content: "";
8210: }
8211:
1.897 wenzelju 8212: ul#LC_secondary_menu {
1.1075.2.23 raeburn 8213: clear: right;
1.911 bisitz 8214: color: $fontmenu;
8215: background: $tabbg;
8216: list-style: none;
8217: padding: 0;
8218: margin: 0;
8219: width: 100%;
1.995 raeburn 8220: text-align: left;
1.1075.2.4 raeburn 8221: float: left;
1.808 droeschl 8222: }
8223:
1.897 wenzelju 8224: ul#LC_secondary_menu li {
1.911 bisitz 8225: font-weight: bold;
8226: line-height: 1.8em;
8227: border-right: 1px solid black;
1.1075.2.4 raeburn 8228: float: left;
8229: }
8230:
8231: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
8232: background-color: $data_table_light;
8233: }
8234:
8235: ul#LC_secondary_menu li a {
8236: padding: 0 0.8em;
8237: }
8238:
8239: ul#LC_secondary_menu li ul {
8240: display: none;
8241: }
8242:
8243: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
8244: display: block;
8245: position: absolute;
8246: margin: 0;
8247: padding: 0;
8248: list-style:none;
8249: float: none;
8250: background-color: $data_table_light;
1.1075.2.5 raeburn 8251: z-index: 2;
1.1075.2.10 raeburn 8252: margin-left: -1px;
1.1075.2.4 raeburn 8253: }
8254:
8255: ul#LC_secondary_menu li ul li {
8256: font-size: 90%;
8257: vertical-align: top;
8258: border-left: 1px solid black;
8259: border-right: 1px solid black;
1.1075.2.33 raeburn 8260: background-color: $data_table_light;
1.1075.2.4 raeburn 8261: list-style:none;
8262: float: none;
8263: }
8264:
8265: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
8266: background-color: $data_table_dark;
1.807 droeschl 8267: }
8268:
1.847 tempelho 8269: ul.LC_TabContent {
1.911 bisitz 8270: display:block;
8271: background: $sidebg;
8272: border-bottom: solid 1px $lg_border_color;
8273: list-style:none;
1.1020 raeburn 8274: margin: -1px -10px 0 -10px;
1.911 bisitz 8275: padding: 0;
1.693 droeschl 8276: }
8277:
1.795 www 8278: ul.LC_TabContent li,
8279: ul.LC_TabContentBigger li {
1.911 bisitz 8280: float:left;
1.741 harmsja 8281: }
1.795 www 8282:
1.897 wenzelju 8283: ul#LC_secondary_menu li a {
1.911 bisitz 8284: color: $fontmenu;
8285: text-decoration: none;
1.693 droeschl 8286: }
1.795 www 8287:
1.721 harmsja 8288: ul.LC_TabContent {
1.952 onken 8289: min-height:20px;
1.721 harmsja 8290: }
1.795 www 8291:
8292: ul.LC_TabContent li {
1.911 bisitz 8293: vertical-align:middle;
1.959 onken 8294: padding: 0 16px 0 10px;
1.911 bisitz 8295: background-color:$tabbg;
8296: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 8297: border-left: solid 1px $font;
1.721 harmsja 8298: }
1.795 www 8299:
1.847 tempelho 8300: ul.LC_TabContent .right {
1.911 bisitz 8301: float:right;
1.847 tempelho 8302: }
8303:
1.911 bisitz 8304: ul.LC_TabContent li a,
8305: ul.LC_TabContent li {
8306: color:rgb(47,47,47);
8307: text-decoration:none;
8308: font-size:95%;
8309: font-weight:bold;
1.952 onken 8310: min-height:20px;
8311: }
8312:
1.959 onken 8313: ul.LC_TabContent li a:hover,
8314: ul.LC_TabContent li a:focus {
1.952 onken 8315: color: $button_hover;
1.959 onken 8316: background:none;
8317: outline:none;
1.952 onken 8318: }
8319:
8320: ul.LC_TabContent li:hover {
8321: color: $button_hover;
8322: cursor:pointer;
1.721 harmsja 8323: }
1.795 www 8324:
1.911 bisitz 8325: ul.LC_TabContent li.active {
1.952 onken 8326: color: $font;
1.911 bisitz 8327: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 8328: border-bottom:solid 1px #FFFFFF;
8329: cursor: default;
1.744 ehlerst 8330: }
1.795 www 8331:
1.959 onken 8332: ul.LC_TabContent li.active a {
8333: color:$font;
8334: background:#FFFFFF;
8335: outline: none;
8336: }
1.1047 raeburn 8337:
8338: ul.LC_TabContent li.goback {
8339: float: left;
8340: border-left: none;
8341: }
8342:
1.870 tempelho 8343: #maincoursedoc {
1.911 bisitz 8344: clear:both;
1.870 tempelho 8345: }
8346:
8347: ul.LC_TabContentBigger {
1.911 bisitz 8348: display:block;
8349: list-style:none;
8350: padding: 0;
1.870 tempelho 8351: }
8352:
1.795 www 8353: ul.LC_TabContentBigger li {
1.911 bisitz 8354: vertical-align:bottom;
8355: height: 30px;
8356: font-size:110%;
8357: font-weight:bold;
8358: color: #737373;
1.841 tempelho 8359: }
8360:
1.957 onken 8361: ul.LC_TabContentBigger li.active {
8362: position: relative;
8363: top: 1px;
8364: }
8365:
1.870 tempelho 8366: ul.LC_TabContentBigger li a {
1.911 bisitz 8367: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
8368: height: 30px;
8369: line-height: 30px;
8370: text-align: center;
8371: display: block;
8372: text-decoration: none;
1.958 onken 8373: outline: none;
1.741 harmsja 8374: }
1.795 www 8375:
1.870 tempelho 8376: ul.LC_TabContentBigger li.active a {
1.911 bisitz 8377: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
8378: color:$font;
1.744 ehlerst 8379: }
1.795 www 8380:
1.870 tempelho 8381: ul.LC_TabContentBigger li b {
1.911 bisitz 8382: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
8383: display: block;
8384: float: left;
8385: padding: 0 30px;
1.957 onken 8386: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 8387: }
8388:
1.956 onken 8389: ul.LC_TabContentBigger li:hover b {
8390: color:$button_hover;
8391: }
8392:
1.870 tempelho 8393: ul.LC_TabContentBigger li.active b {
1.911 bisitz 8394: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
8395: color:$font;
1.957 onken 8396: border: 0;
1.741 harmsja 8397: }
1.693 droeschl 8398:
1.870 tempelho 8399:
1.862 bisitz 8400: ul.LC_CourseBreadcrumbs {
8401: background: $sidebg;
1.1020 raeburn 8402: height: 2em;
1.862 bisitz 8403: padding-left: 10px;
1.1020 raeburn 8404: margin: 0;
1.862 bisitz 8405: list-style-position: inside;
8406: }
8407:
1.911 bisitz 8408: ol#LC_MenuBreadcrumbs,
1.862 bisitz 8409: ol#LC_PathBreadcrumbs {
1.911 bisitz 8410: padding-left: 10px;
8411: margin: 0;
1.933 droeschl 8412: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 8413: }
8414:
1.911 bisitz 8415: ol#LC_MenuBreadcrumbs li,
8416: ol#LC_PathBreadcrumbs li,
1.862 bisitz 8417: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 8418: display: inline;
1.933 droeschl 8419: white-space: normal;
1.693 droeschl 8420: }
8421:
1.823 bisitz 8422: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 8423: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 8424: text-decoration: none;
8425: font-size:90%;
1.693 droeschl 8426: }
1.795 www 8427:
1.969 droeschl 8428: ol#LC_MenuBreadcrumbs h1 {
8429: display: inline;
8430: font-size: 90%;
8431: line-height: 2.5em;
8432: margin: 0;
8433: padding: 0;
8434: }
8435:
1.795 www 8436: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 8437: text-decoration:none;
8438: font-size:100%;
8439: font-weight:bold;
1.693 droeschl 8440: }
1.795 www 8441:
1.840 bisitz 8442: .LC_Box {
1.911 bisitz 8443: border: solid 1px $lg_border_color;
8444: padding: 0 10px 10px 10px;
1.746 neumanie 8445: }
1.795 www 8446:
1.1020 raeburn 8447: .LC_DocsBox {
8448: border: solid 1px $lg_border_color;
8449: padding: 0 0 10px 10px;
8450: }
8451:
1.795 www 8452: .LC_AboutMe_Image {
1.911 bisitz 8453: float:left;
8454: margin-right:10px;
1.747 neumanie 8455: }
1.795 www 8456:
8457: .LC_Clear_AboutMe_Image {
1.911 bisitz 8458: clear:left;
1.747 neumanie 8459: }
1.795 www 8460:
1.721 harmsja 8461: dl.LC_ListStyleClean dt {
1.911 bisitz 8462: padding-right: 5px;
8463: display: table-header-group;
1.693 droeschl 8464: }
8465:
1.721 harmsja 8466: dl.LC_ListStyleClean dd {
1.911 bisitz 8467: display: table-row;
1.693 droeschl 8468: }
8469:
1.721 harmsja 8470: .LC_ListStyleClean,
8471: .LC_ListStyleSimple,
8472: .LC_ListStyleNormal,
1.795 www 8473: .LC_ListStyleSpecial {
1.911 bisitz 8474: /* display:block; */
8475: list-style-position: inside;
8476: list-style-type: none;
8477: overflow: hidden;
8478: padding: 0;
1.693 droeschl 8479: }
8480:
1.721 harmsja 8481: .LC_ListStyleSimple li,
8482: .LC_ListStyleSimple dd,
8483: .LC_ListStyleNormal li,
8484: .LC_ListStyleNormal dd,
8485: .LC_ListStyleSpecial li,
1.795 www 8486: .LC_ListStyleSpecial dd {
1.911 bisitz 8487: margin: 0;
8488: padding: 5px 5px 5px 10px;
8489: clear: both;
1.693 droeschl 8490: }
8491:
1.721 harmsja 8492: .LC_ListStyleClean li,
8493: .LC_ListStyleClean dd {
1.911 bisitz 8494: padding-top: 0;
8495: padding-bottom: 0;
1.693 droeschl 8496: }
8497:
1.721 harmsja 8498: .LC_ListStyleSimple dd,
1.795 www 8499: .LC_ListStyleSimple li {
1.911 bisitz 8500: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 8501: }
8502:
1.721 harmsja 8503: .LC_ListStyleSpecial li,
8504: .LC_ListStyleSpecial dd {
1.911 bisitz 8505: list-style-type: none;
8506: background-color: RGB(220, 220, 220);
8507: margin-bottom: 4px;
1.693 droeschl 8508: }
8509:
1.721 harmsja 8510: table.LC_SimpleTable {
1.911 bisitz 8511: margin:5px;
8512: border:solid 1px $lg_border_color;
1.795 www 8513: }
1.693 droeschl 8514:
1.721 harmsja 8515: table.LC_SimpleTable tr {
1.911 bisitz 8516: padding: 0;
8517: border:solid 1px $lg_border_color;
1.693 droeschl 8518: }
1.795 www 8519:
8520: table.LC_SimpleTable thead {
1.911 bisitz 8521: background:rgb(220,220,220);
1.693 droeschl 8522: }
8523:
1.721 harmsja 8524: div.LC_columnSection {
1.911 bisitz 8525: display: block;
8526: clear: both;
8527: overflow: hidden;
8528: margin: 0;
1.693 droeschl 8529: }
8530:
1.721 harmsja 8531: div.LC_columnSection>* {
1.911 bisitz 8532: float: left;
8533: margin: 10px 20px 10px 0;
8534: overflow:hidden;
1.693 droeschl 8535: }
1.721 harmsja 8536:
1.795 www 8537: table em {
1.911 bisitz 8538: font-weight: bold;
8539: font-style: normal;
1.748 schulted 8540: }
1.795 www 8541:
1.779 bisitz 8542: table.LC_tableBrowseRes,
1.795 www 8543: table.LC_tableOfContent {
1.911 bisitz 8544: border:none;
8545: border-spacing: 1px;
8546: padding: 3px;
8547: background-color: #FFFFFF;
8548: font-size: 90%;
1.753 droeschl 8549: }
1.789 droeschl 8550:
1.911 bisitz 8551: table.LC_tableOfContent {
8552: border-collapse: collapse;
1.789 droeschl 8553: }
8554:
1.771 droeschl 8555: table.LC_tableBrowseRes a,
1.768 schulted 8556: table.LC_tableOfContent a {
1.911 bisitz 8557: background-color: transparent;
8558: text-decoration: none;
1.753 droeschl 8559: }
8560:
1.795 www 8561: table.LC_tableOfContent img {
1.911 bisitz 8562: border: none;
8563: height: 1.3em;
8564: vertical-align: text-bottom;
8565: margin-right: 0.3em;
1.753 droeschl 8566: }
1.757 schulted 8567:
1.795 www 8568: a#LC_content_toolbar_firsthomework {
1.911 bisitz 8569: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 8570: }
8571:
1.795 www 8572: a#LC_content_toolbar_everything {
1.911 bisitz 8573: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 8574: }
8575:
1.795 www 8576: a#LC_content_toolbar_uncompleted {
1.911 bisitz 8577: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 8578: }
8579:
1.795 www 8580: #LC_content_toolbar_clearbubbles {
1.911 bisitz 8581: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 8582: }
8583:
1.795 www 8584: a#LC_content_toolbar_changefolder {
1.911 bisitz 8585: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 8586: }
8587:
1.795 www 8588: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 8589: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 8590: }
8591:
1.1043 raeburn 8592: a#LC_content_toolbar_edittoplevel {
8593: background-image:url(/res/adm/pages/edittoplevel.gif);
8594: }
8595:
1.1075.2.161. .12(raeb 8596:-23): a#LC_content_toolbar_printout {
8597:-23): background-image:url(/res/adm/pages/printout.gif);
8598:-23): }
8599:-23):
1.795 www 8600: ul#LC_toolbar li a:hover {
1.911 bisitz 8601: background-position: bottom center;
1.757 schulted 8602: }
8603:
1.795 www 8604: ul#LC_toolbar {
1.911 bisitz 8605: padding: 0;
8606: margin: 2px;
8607: list-style:none;
8608: position:relative;
8609: background-color:white;
1.1075.2.9 raeburn 8610: overflow: auto;
1.757 schulted 8611: }
8612:
1.795 www 8613: ul#LC_toolbar li {
1.911 bisitz 8614: border:1px solid white;
8615: padding: 0;
8616: margin: 0;
8617: float: left;
8618: display:inline;
8619: vertical-align:middle;
1.1075.2.9 raeburn 8620: white-space: nowrap;
1.911 bisitz 8621: }
1.757 schulted 8622:
1.783 amueller 8623:
1.795 www 8624: a.LC_toolbarItem {
1.911 bisitz 8625: display:block;
8626: padding: 0;
8627: margin: 0;
8628: height: 32px;
8629: width: 32px;
8630: color:white;
8631: border: none;
8632: background-repeat:no-repeat;
8633: background-color:transparent;
1.757 schulted 8634: }
8635:
1.915 droeschl 8636: ul.LC_funclist {
8637: margin: 0;
8638: padding: 0.5em 1em 0.5em 0;
8639: }
8640:
1.933 droeschl 8641: ul.LC_funclist > li:first-child {
8642: font-weight:bold;
8643: margin-left:0.8em;
8644: }
8645:
1.915 droeschl 8646: ul.LC_funclist + ul.LC_funclist {
8647: /*
8648: left border as a seperator if we have more than
8649: one list
8650: */
8651: border-left: 1px solid $sidebg;
8652: /*
8653: this hides the left border behind the border of the
8654: outer box if element is wrapped to the next 'line'
8655: */
8656: margin-left: -1px;
8657: }
8658:
1.843 bisitz 8659: ul.LC_funclist li {
1.915 droeschl 8660: display: inline;
1.782 bisitz 8661: white-space: nowrap;
1.915 droeschl 8662: margin: 0 0 0 25px;
8663: line-height: 150%;
1.782 bisitz 8664: }
8665:
1.974 wenzelju 8666: .LC_hidden {
8667: display: none;
8668: }
8669:
1.1030 www 8670: .LCmodal-overlay {
8671: position:fixed;
8672: top:0;
8673: right:0;
8674: bottom:0;
8675: left:0;
8676: height:100%;
8677: width:100%;
8678: margin:0;
8679: padding:0;
8680: background:#999;
8681: opacity:.75;
8682: filter: alpha(opacity=75);
8683: -moz-opacity: 0.75;
8684: z-index:101;
8685: }
8686:
8687: * html .LCmodal-overlay {
8688: position: absolute;
8689: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
8690: }
8691:
8692: .LCmodal-window {
8693: position:fixed;
8694: top:50%;
8695: left:50%;
8696: margin:0;
8697: padding:0;
8698: z-index:102;
8699: }
8700:
8701: * html .LCmodal-window {
8702: position:absolute;
8703: }
8704:
8705: .LCclose-window {
8706: position:absolute;
8707: width:32px;
8708: height:32px;
8709: right:8px;
8710: top:8px;
8711: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8712: text-indent:-99999px;
8713: overflow:hidden;
8714: cursor:pointer;
8715: }
8716:
1.1075.2.158 raeburn 8717: .LCisDisabled {
8718: cursor: not-allowed;
8719: opacity: 0.5;
8720: }
8721:
8722: a[aria-disabled="true"] {
8723: color: currentColor;
8724: display: inline-block; /* For IE11/ MS Edge bug */
8725: pointer-events: none;
8726: text-decoration: none;
8727: }
8728:
1.1075.2.141 raeburn 8729: pre.LC_wordwrap {
8730: white-space: pre-wrap;
8731: white-space: -moz-pre-wrap;
8732: white-space: -pre-wrap;
8733: white-space: -o-pre-wrap;
8734: word-wrap: break-word;
8735: }
8736:
1.1075.2.17 raeburn 8737: /*
1.1075.2.161. .21(raeb 8738:-24): styles used for response display
8739:-24): */
8740:-24): div.LC_radiofoil, div.LC_rankfoil {
8741:-24): margin: .5em 0em .5em 0em;
8742:-24): }
8743:-24): table.LC_itemgroup {
8744:-24): margin-top: 1em;
8745:-24): }
8746:-24):
8747:-24): /*
1.1075.2.17 raeburn 8748: styles used by TTH when "Default set of options to pass to tth/m
8749: when converting TeX" in course settings has been set
8750:
8751: option passed: -t
8752:
8753: */
8754:
8755: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8756: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8757: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8758: td div.norm {line-height:normal;}
8759:
8760: /*
8761: option passed -y3
8762: */
8763:
8764: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8765: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8766: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8767:
1.1075.2.161. .21(raeb 8768:-24): /*
8769:-24): sections with roles, for content only
8770:-24): */
8771:-24): section[class^="role-"] {
8772:-24): padding-left: 10px;
8773:-24): padding-right: 5px;
8774:-24): margin-top: 8px;
8775:-24): margin-bottom: 8px;
8776:-24): border: 1px solid #2A4;
8777:-24): border-radius: 5px;
8778:-24): box-shadow: 0px 1px 1px #BBB;
8779:-24): }
8780:-24): section[class^="role-"]>h1 {
8781:-24): position: relative;
8782:-24): margin: 0px;
8783:-24): padding-top: 10px;
8784:-24): padding-left: 40px;
8785:-24): }
8786:-24): section[class^="role-"]>h1:before {
8787:-24): position: absolute;
8788:-24): left: -5px;
8789:-24): top: 5px;
8790:-24): }
8791:-24): section.role-activity>h1:before {
8792:-24): content:url('/adm/daxe/images/section_icons/activity.png');
8793:-24): }
8794:-24): section.role-advice>h1:before {
8795:-24): content:url('/adm/daxe/images/section_icons/advice.png');
8796:-24): }
8797:-24): section.role-bibliography>h1:before {
8798:-24): content:url('/adm/daxe/images/section_icons/bibliography.png');
8799:-24): }
8800:-24): section.role-citation>h1:before {
8801:-24): content:url('/adm/daxe/images/section_icons/citation.png');
8802:-24): }
8803:-24): section.role-conclusion>h1:before {
8804:-24): content:url('/adm/daxe/images/section_icons/conclusion.png');
8805:-24): }
8806:-24): section.role-definition>h1:before {
8807:-24): content:url('/adm/daxe/images/section_icons/definition.png');
8808:-24): }
8809:-24): section.role-demonstration>h1:before {
8810:-24): content:url('/adm/daxe/images/section_icons/demonstration.png');
8811:-24): }
8812:-24): section.role-example>h1:before {
8813:-24): content:url('/adm/daxe/images/section_icons/example.png');
8814:-24): }
8815:-24): section.role-explanation>h1:before {
8816:-24): content:url('/adm/daxe/images/section_icons/explanation.png');
8817:-24): }
8818:-24): section.role-introduction>h1:before {
8819:-24): content:url('/adm/daxe/images/section_icons/introduction.png');
8820:-24): }
8821:-24): section.role-method>h1:before {
8822:-24): content:url('/adm/daxe/images/section_icons/method.png');
8823:-24): }
8824:-24): section.role-more_information>h1:before {
8825:-24): content:url('/adm/daxe/images/section_icons/more_information.png');
8826:-24): }
8827:-24): section.role-objectives>h1:before {
8828:-24): content:url('/adm/daxe/images/section_icons/objectives.png');
8829:-24): }
8830:-24): section.role-prerequisites>h1:before {
8831:-24): content:url('/adm/daxe/images/section_icons/prerequisites.png');
8832:-24): }
8833:-24): section.role-remark>h1:before {
8834:-24): content:url('/adm/daxe/images/section_icons/remark.png');
8835:-24): }
8836:-24): section.role-reminder>h1:before {
8837:-24): content:url('/adm/daxe/images/section_icons/reminder.png');
8838:-24): }
8839:-24): section.role-summary>h1:before {
8840:-24): content:url('/adm/daxe/images/section_icons/summary.png');
8841:-24): }
8842:-24): section.role-syntax>h1:before {
8843:-24): content:url('/adm/daxe/images/section_icons/syntax.png');
8844:-24): }
8845:-24): section.role-warning>h1:before {
8846:-24): content:url('/adm/daxe/images/section_icons/warning.png');
8847:-24): }
8848:-24):
1.1075.2.121 raeburn 8849: #LC_minitab_header {
8850: float:left;
8851: width:100%;
8852: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8853: font-size:93%;
8854: line-height:normal;
8855: margin: 0.5em 0 0.5em 0;
8856: }
8857: #LC_minitab_header ul {
8858: margin:0;
8859: padding:10px 10px 0;
8860: list-style:none;
8861: }
8862: #LC_minitab_header li {
8863: float:left;
8864: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8865: margin:0;
8866: padding:0 0 0 9px;
8867: }
8868: #LC_minitab_header a {
8869: display:block;
8870: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8871: padding:5px 15px 4px 6px;
8872: }
8873: #LC_minitab_header #LC_current_minitab {
8874: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8875: }
8876: #LC_minitab_header #LC_current_minitab a {
8877: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8878: padding-bottom:5px;
8879: }
8880:
8881:
1.343 albertel 8882: END
8883: }
8884:
1.306 albertel 8885: =pod
8886:
8887: =item * &headtag()
8888:
8889: Returns a uniform footer for LON-CAPA web pages.
8890:
1.307 albertel 8891: Inputs: $title - optional title for the head
8892: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8893: $args - optional arguments
1.319 albertel 8894: force_register - if is true call registerurl so the remote is
8895: informed
1.415 albertel 8896: redirect -> array ref of
8897: 1- seconds before redirect occurs
8898: 2- url to redirect to
8899: 3- whether the side effect should occur
1.315 albertel 8900: (side effect of setting
8901: $env{'internal.head.redirect'} to the url
1.1075.2.161. .9(raebu 8902:22): redirected to)
8903:22): 4- whether the redirect target should be
8904:22): the opener of the current (pop-up)
8905:22): window (side effect of setting
8906:22): $env{'internal.head.to_opener'} to
8907:22): 1, if true.
.10(raeb 8908:-22): 5- whether encrypt check should be skipped
1.352 albertel 8909: domain -> force to color decorate a page for a specific
8910: domain
8911: function -> force usage of a specific rolish color scheme
8912: bgcolor -> override the default page bgcolor
1.460 albertel 8913: no_auto_mt_title
8914: -> prevent &mt()ing the title arg
1.464 albertel 8915:
1.306 albertel 8916: =cut
8917:
8918: sub headtag {
1.313 albertel 8919: my ($title,$head_extra,$args) = @_;
1.306 albertel 8920:
1.363 albertel 8921: my $function = $args->{'function'} || &get_users_function();
8922: my $domain = $args->{'domain'} || &determinedomain();
8923: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 8924: my $httphost = $args->{'use_absolute'};
1.418 albertel 8925: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8926: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8927: #time(),
1.418 albertel 8928: $env{'environment.color.timestamp'},
1.363 albertel 8929: $function,$domain,$bgcolor);
8930:
1.369 www 8931: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8932:
1.308 albertel 8933: my $result =
8934: '<head>'.
1.1075.2.56 raeburn 8935: &font_settings($args);
1.319 albertel 8936:
1.1075.2.72 raeburn 8937: my $inhibitprint;
8938: if ($args->{'print_suppress'}) {
8939: $inhibitprint = &print_suppression();
8940: }
1.1064 raeburn 8941:
1.1075.2.161. .31(raeb 8942:-24): if (!$args->{'frameset'} && !$args->{'switchserver'}) {
1.461 albertel 8943: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8944: }
1.1075.2.12 raeburn 8945: if ($args->{'force_register'}) {
8946: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 8947: }
1.436 albertel 8948: if (!$args->{'no_nav_bar'}
8949: && !$args->{'only_body'}
1.1075.2.161. .31(raeb 8950:-24): && !$args->{'frameset'}
8951:-24): && !$args->{'switchserver'}) {
1.1075.2.52 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.1075.2.161. .10(raeb 8972:-22): my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
8973:-22): if (!$skip_enc_check) {
8974:-22): $url = &Apache::lonenc::check_encrypt($url);
8975:-22): }
1.414 albertel 8976: if (!$inhibit_continue) {
8977: $env{'internal.head.redirect'} = $url;
8978: }
1.1075.2.161. .9(raebu 8979:22): $result.=<<"ADDMETA";
1.313 albertel 8980: <meta http-equiv="pragma" content="no-cache" />
1.1075.2.161. .9(raebu 8981:22): ADDMETA
8982:22): if ($to_opener) {
8983:22): $env{'internal.head.to_opener'} = 1;
8984:22): my $dest = &js_escape($url);
8985:22): my $timeout = int($time * 1000);
8986:22): $result .=<<"ENDJS";
8987:22): <script type="text/javascript">
8988:22): // <![CDATA[
8989:22): function LC_To_Opener() {
8990:22): var dest = '$dest';
8991:22): if (dest != '') {
8992:22): if (window.opener != null && !window.opener.closed) {
8993:22): window.opener.location.href=dest;
8994:22): window.close();
8995:22): } else {
8996:22): window.location.href=dest;
8997:22): }
8998:22): }
8999:22): }
9000:22): \$(document).ready(function () {
9001:22): setTimeout('LC_To_Opener()',$timeout);
9002:22): });
9003:22): // ]]>
9004:22): </script>
9005:22): ENDJS
9006:22): } else {
9007:22): $result.=<<"ADDMETA";
1.344 albertel 9008: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 9009: ADDMETA
1.1075.2.161. .9(raebu 9010:22): }
1.1075.2.89 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.1075.2.145 raeburn 9024: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1075.2.151 raeburn 9025: my ($offload,$offloadoth);
1.1075.2.89 raeburn 9026: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
9027: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1075.2.145 raeburn 9028: $offload = 1;
1.1075.2.151 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.1075.2.145 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.1075.2.151 raeburn 9045: $offloadoth = 1;
1.1075.2.145 raeburn 9046: $dom_in_use = $env{'user.domain'};
9047: }
1.1075.2.89 raeburn 9048: }
1.1075.2.145 raeburn 9049: }
9050: }
9051: }
9052: if ($offload) {
1.1075.2.158 raeburn 9053: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1075.2.151 raeburn 9054: if (($newserver eq '') && ($offloadoth)) {
9055: my @domains = &Apache::lonnet::current_machine_domains();
1.1075.2.161. .1(raebu 9056:21): if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
1.1075.2.151 raeburn 9057: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
9058: }
9059: }
1.1075.2.145 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.1075.2.153 raeburn 9073: $msg = &mt('Once the following tasks are complete:')." \n".
1.1075.2.145 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".');
1.1075.2.89 raeburn 9077: } else {
1.1075.2.145 raeburn 9078: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
9079: }
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.1075.2.89 raeburn 9104: }
1.1075.2.145 raeburn 9105: if ($shownsymb) {
9106: &js_escape(\$shownsymb);
9107: $newurl .= '&symb='.$shownsymb;
1.1075.2.89 raeburn 9108: }
1.1075.2.145 raeburn 9109: } else {
9110: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
9111: &js_escape(\$shownurl);
9112: $newurl .= '&origurl='.$shownurl;
1.1075.2.89 raeburn 9113: }
1.1075.2.145 raeburn 9114: }
9115: &js_escape(\$msg);
9116: $result.=<<OFFLOAD
1.1075.2.89 raeburn 9117: <meta http-equiv="pragma" content="no-cache" />
9118: <script type="text/javascript">
1.1075.2.92 raeburn 9119: // <![CDATA[
1.1075.2.89 raeburn 9120: function LC_Offload_Now() {
9121: var dest = "$newurl";
9122: if (dest != '') {
9123: window.location.href="$newurl";
9124: }
9125: }
1.1075.2.92 raeburn 9126: \$(document).ready(function () {
9127: window.alert('$msg');
9128: if ($disable_submit) {
1.1075.2.89 raeburn 9129: \$(".LC_hwk_submit").prop("disabled", true);
9130: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92 raeburn 9131: }
9132: setTimeout('LC_Offload_Now()', $timeout);
9133: });
9134: // ]]>
1.1075.2.89 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); }
1.1075.2.161. .25(raeb 9147:-24): if ($title =~ /^LON-CAPA\s+/) {
9148:-24): $result .= '<title> '.$title.'</title>';
9149:-24): } else {
9150:-24): $result .= '<title> LON-CAPA '.$title.'</title>';
9151:-24): }
9152:-24): $result .= "\n".'<link rel="stylesheet" type="text/css" href="'.$url.'"';
1.1075.2.61 raeburn 9153: if (!$args->{'frameset'}) {
9154: $result .= ' /';
9155: }
9156: $result .= '>'
1.1064 raeburn 9157: .$inhibitprint
1.414 albertel 9158: .$head_extra;
1.1075.2.108 raeburn 9159: my $clientmobile;
9160: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
9161: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
9162: } else {
9163: $clientmobile = $env{'browser.mobile'};
9164: }
9165: if ($clientmobile) {
1.1075.2.42 raeburn 9166: $result .= '
9167: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
9168: <meta name="apple-mobile-web-app-capable" content="yes" />';
9169: }
1.1075.2.126 raeburn 9170: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 9171: return $result.'</head>';
1.306 albertel 9172: }
9173:
9174: =pod
9175:
1.340 albertel 9176: =item * &font_settings()
9177:
9178: Returns neccessary <meta> to set the proper encoding
9179:
1.1075.2.56 raeburn 9180: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 9181:
9182: =cut
9183:
9184: sub font_settings {
1.1075.2.56 raeburn 9185: my ($args) = @_;
1.340 albertel 9186: my $headerstring='';
1.1075.2.56 raeburn 9187: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
9188: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 9189: $headerstring.=
1.1075.2.61 raeburn 9190: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
9191: if (!$args->{'frameset'}) {
9192: $headerstring.= ' /';
9193: }
9194: $headerstring .= '>'."\n";
1.340 albertel 9195: }
9196: return $headerstring;
9197: }
9198:
1.341 albertel 9199: =pod
9200:
1.1064 raeburn 9201: =item * &print_suppression()
9202:
9203: In course context returns css which causes the body to be blank when media="print",
9204: if printout generation is unavailable for the current resource.
9205:
9206: This could be because:
9207:
9208: (a) printstartdate is in the future
9209:
9210: (b) printenddate is in the past
9211:
9212: (c) there is an active exam block with "printout"
9213: functionality blocked
9214:
9215: Users with pav, pfo or evb privileges are exempt.
9216:
9217: Inputs: none
9218:
9219: =cut
9220:
9221:
9222: sub print_suppression {
9223: my $noprint;
9224: if ($env{'request.course.id'}) {
9225: my $scope = $env{'request.course.id'};
9226: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9227: (&Apache::lonnet::allowed('pfo',$scope))) {
9228: return;
9229: }
9230: if ($env{'request.course.sec'} ne '') {
9231: $scope .= "/$env{'request.course.sec'}";
9232: if ((&Apache::lonnet::allowed('pav',$scope)) ||
9233: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 9234: return;
1.1064 raeburn 9235: }
9236: }
9237: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9238: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.158 raeburn 9239: my $clientip = &Apache::lonnet::get_requestor_ip();
9240: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 9241: if ($blocked) {
9242: my $checkrole = "cm./$cdom/$cnum";
9243: if ($env{'request.course.sec'} ne '') {
9244: $checkrole .= "/$env{'request.course.sec'}";
9245: }
9246: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
9247: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
9248: $noprint = 1;
9249: }
9250: }
9251: unless ($noprint) {
9252: my $symb = &Apache::lonnet::symbread();
9253: if ($symb ne '') {
9254: my $navmap = Apache::lonnavmaps::navmap->new();
9255: if (ref($navmap)) {
9256: my $res = $navmap->getBySymb($symb);
9257: if (ref($res)) {
9258: if (!$res->resprintable()) {
9259: $noprint = 1;
9260: }
9261: }
9262: }
9263: }
9264: }
9265: if ($noprint) {
9266: return <<"ENDSTYLE";
9267: <style type="text/css" media="print">
9268: body { display:none }
9269: </style>
9270: ENDSTYLE
9271: }
9272: }
9273: return;
9274: }
9275:
9276: =pod
9277:
1.341 albertel 9278: =item * &xml_begin()
9279:
9280: Returns the needed doctype and <html>
9281:
9282: Inputs: none
9283:
9284: =cut
9285:
9286: sub xml_begin {
1.1075.2.61 raeburn 9287: my ($is_frameset) = @_;
1.341 albertel 9288: my $output='';
9289:
9290: if ($env{'browser.mathml'}) {
9291: $output='<?xml version="1.0"?>'
9292: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
9293: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
9294:
9295: # .'<!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">] >'
9296: .'<!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">'
9297: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
9298: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 9299: } elsif ($is_frameset) {
9300: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
9301: '<html>'."\n";
1.341 albertel 9302: } else {
1.1075.2.61 raeburn 9303: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
9304: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 9305: }
9306: return $output;
9307: }
1.340 albertel 9308:
9309: =pod
9310:
1.306 albertel 9311: =item * &start_page()
9312:
9313: Returns a complete <html> .. <body> section for LON-CAPA web pages.
9314:
1.648 raeburn 9315: Inputs:
9316:
9317: =over 4
9318:
9319: $title - optional title for the page
9320:
9321: $head_extra - optional extra HTML to incude inside the <head>
9322:
9323: $args - additional optional args supported are:
9324:
9325: =over 8
9326:
9327: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 9328: arg on
1.814 bisitz 9329: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 9330: add_entries -> additional attributes to add to the <body>
9331: domain -> force to color decorate a page for a
1.317 albertel 9332: specific domain
1.648 raeburn 9333: function -> force usage of a specific rolish color
1.317 albertel 9334: scheme
1.648 raeburn 9335: redirect -> see &headtag()
9336: bgcolor -> override the default page bg color
9337: js_ready -> return a string ready for being used in
1.317 albertel 9338: a javascript writeln
1.648 raeburn 9339: html_encode -> return a string ready for being used in
1.320 albertel 9340: a html attribute
1.648 raeburn 9341: force_register -> if is true will turn on the &bodytag()
1.317 albertel 9342: $forcereg arg
1.648 raeburn 9343: frameset -> if true will start with a <frameset>
1.330 albertel 9344: rather than <body>
1.648 raeburn 9345: skip_phases -> hash ref of
1.338 albertel 9346: head -> skip the <html><head> generation
9347: body -> skip all <body> generation
1.1075.2.12 raeburn 9348: no_inline_link -> if true and in remote mode, don't show the
9349: 'Switch To Inline Menu' link
1.648 raeburn 9350: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 9351: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 9352: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.161. .29(raeb 9353:-24): bread_crumbs_style -> breadcrumbs are contained within <div id="LC_breadcrumbs">,
9354:-24): and &standard_css() contains CSS for #LC_breadcrumbs, if you want
9355:-24): to override those values, or add to them, specify the value to
9356:-24): include in the style attribute to include in the div tag by using
9357:-24): bread_crumbs_style (e.g., overflow: visible)
1.1075.2.123 raeburn 9358: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
9359: to lonhtmlcommon::breadcrumbs
1.1075.2.15 raeburn 9360: group -> includes the current group, if page is for a
9361: specific group
1.1075.2.133 raeburn 9362: use_absolute -> for request for external resource or syllabus, this
9363: will contain https://<hostname> if server uses
9364: https (as per hosts.tab), but request is for http
9365: hostname -> hostname, originally from $r->hostname(), (optional).
1.1075.2.158 raeburn 9366: links_disabled -> Links in primary and secondary menus are disabled
9367: (Can enable them once page has loaded - see lonroles.pm
9368: for an example).
1.1075.2.161. .6(raebu 9369:22): links_target -> Target for links, e.g., _parent (optional).
1.361 albertel 9370:
1.648 raeburn 9371: =back
1.460 albertel 9372:
1.648 raeburn 9373: =back
1.562 albertel 9374:
1.306 albertel 9375: =cut
9376:
9377: sub start_page {
1.309 albertel 9378: my ($title,$head_extra,$args) = @_;
1.318 albertel 9379: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 9380:
1.315 albertel 9381: $env{'internal.start_page'}++;
1.1075.2.161. .1(raebu 9382:21): my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
1.964 droeschl 9383:
1.338 albertel 9384: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 9385: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 9386: }
1.1075.2.161. .1(raebu 9387:21):
9388:21): if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
9389:21): if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
9390:21): unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
9391:21): $args->{'no_primary_menu'} = 1;
9392:21): }
9393:21): unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
9394:21): $args->{'no_inline_menu'} = 1;
9395:21): }
9396:21): if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
9397:21): map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
9398:21): }
9399:21): } else {
9400:21): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9401:21): my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
9402:21): if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
9403:21): unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
9404:21): $args->{'no_primary_menu'} = 1;
9405:21): }
9406:21): unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
9407:21): $args->{'no_inline_menu'} = 1;
9408:21): }
9409:21): if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
9410:21): map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
9411:21): }
9412:21): }
9413:21): }
9414:21): ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
9415:21): $env{'course.'.$env{'request.course.id'}.'.domain'},
9416:21): $env{'course.'.$env{'request.course.id'}.'.num'});
9417:21): } elsif ($env{'request.course.id'}) {
9418:21): my $expiretime=600;
9419:21): if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
9420:21): &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
9421:21): }
9422:21): my ($deeplinkmenu,$menuref);
9423:21): ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
9424:21): if ($menucoll) {
9425:21): if (ref($menuref) eq 'HASH') {
9426:21): %menu = %{$menuref};
9427:21): }
9428:21): if ($menu{'top'} eq 'n') {
9429:21): $args->{'no_primary_menu'} = 1;
9430:21): }
9431:21): if ($menu{'inline'} eq 'n') {
9432:21): unless (&Apache::lonnet::allowed('opa')) {
9433:21): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9434:21): my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9435:21): my $crstype = &course_type();
9436:21): my $now = time;
9437:21): my $ccrole;
9438:21): if ($crstype eq 'Community') {
9439:21): $ccrole = 'co';
9440:21): } else {
9441:21): $ccrole = 'cc';
9442:21): }
9443:21): if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
9444:21): my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
9445:21): if ((($start) && ($start<0)) ||
9446:21): (($end) && ($end<$now)) ||
9447:21): (($start) && ($now<$start))) {
9448:21): $args->{'no_inline_menu'} = 1;
9449:21): }
9450:21): } else {
9451:21): $args->{'no_inline_menu'} = 1;
9452:21): }
9453:21): }
9454:21): }
9455:21): }
9456:21): }
.4(raebu 9457:22):
.8(raebu 9458:22): my $showncrumbs;
1.338 albertel 9459: if (! exists($args->{'skip_phases'}{'body'}) ) {
9460: if ($args->{'frameset'}) {
9461: my $attr_string = &make_attr_string($args->{'force_register'},
9462: $args->{'add_entries'});
9463: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 9464: } else {
9465: $result .=
9466: &bodytag($title,
9467: $args->{'function'}, $args->{'add_entries'},
9468: $args->{'only_body'}, $args->{'domain'},
9469: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 9470: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.161. .1(raebu 9471:21): $args, \@advtools,
.8(raebu 9472:22): $ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu,\$showncrumbs);
1.831 bisitz 9473: }
1.330 albertel 9474: }
1.338 albertel 9475:
1.315 albertel 9476: if ($args->{'js_ready'}) {
1.713 kaisler 9477: $result = &js_ready($result);
1.315 albertel 9478: }
1.320 albertel 9479: if ($args->{'html_encode'}) {
1.713 kaisler 9480: $result = &html_encode($result);
9481: }
9482:
1.813 bisitz 9483: # Preparation for new and consistent functionlist at top of screen
9484: # if ($args->{'functionlist'}) {
9485: # $result .= &build_functionlist();
9486: #}
9487:
1.964 droeschl 9488: # Don't add anything more if only_body wanted or in const space
9489: return $result if $args->{'only_body'}
9490: || $env{'request.state'} eq 'construct';
1.813 bisitz 9491:
9492: #Breadcrumbs
1.758 kaisler 9493: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
1.1075.2.161. .8(raebu 9494:22): unless ($showncrumbs) {
1.758 kaisler 9495: &Apache::lonhtmlcommon::clear_breadcrumbs();
9496: #if any br links exists, add them to the breadcrumbs
9497: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
9498: foreach my $crumb (@{$args->{'bread_crumbs'}}){
9499: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
9500: }
9501: }
1.1075.2.19 raeburn 9502: # if @advtools array contains items add then to the breadcrumbs
9503: if (@advtools > 0) {
9504: &Apache::lonmenu::advtools_crumbs(@advtools);
9505: }
1.1075.2.123 raeburn 9506: my $menulink;
9507: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
1.1075.2.161. .1(raebu 9508:21): if ((exists($args->{'bread_crumbs_nomenu'})) ||
9509:21): ($ltiscope eq 'map') || ($ltiscope eq 'resource')) {
1.1075.2.123 raeburn 9510: $menulink = 0;
9511: } else {
9512: undef($menulink);
9513: }
1.1075.2.161. .8(raebu 9514:22): my $linkprotout;
9515:22): if ($env{'request.deeplink.login'}) {
9516:22): my $linkprotout = &Apache::lonmenu::linkprot_exit();
9517:22): if ($linkprotout) {
9518:22): &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
9519:22): }
9520:22): }
1.758 kaisler 9521: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
9522: if(exists($args->{'bread_crumbs_component'})){
1.1075.2.161. .29(raeb 9523:-24): $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},
9524:-24): '',$menulink,'',
9525:-24): $args->{'bread_crumbs_style'});
.1(raebu 9526:21): } else {
.29(raeb 9527:-24): $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink,'',
9528:-24): $args->{'bread_crumbs_style'});
1.758 kaisler 9529: }
1.1075.2.161. .8(raebu 9530:22): }
1.1075.2.24 raeburn 9531: } elsif (($env{'environment.remote'} eq 'on') &&
9532: ($env{'form.inhibitmenu'} ne 'yes') &&
9533: ($env{'request.noversionuri'} =~ m{^/res/}) &&
9534: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 9535: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 9536: }
1.315 albertel 9537: return $result;
1.306 albertel 9538: }
9539:
9540: sub end_page {
1.315 albertel 9541: my ($args) = @_;
9542: $env{'internal.end_page'}++;
1.330 albertel 9543: my $result;
1.335 albertel 9544: if ($args->{'discussion'}) {
9545: my ($target,$parser);
9546: if (ref($args->{'discussion'})) {
9547: ($target,$parser) =($args->{'discussion'}{'target'},
9548: $args->{'discussion'}{'parser'});
9549: }
9550: $result .= &Apache::lonxml::xmlend($target,$parser);
9551: }
1.330 albertel 9552: if ($args->{'frameset'}) {
9553: $result .= '</frameset>';
9554: } else {
1.635 raeburn 9555: $result .= &endbodytag($args);
1.330 albertel 9556: }
1.1075.2.6 raeburn 9557: unless ($args->{'notbody'}) {
9558: $result .= "\n</html>";
9559: }
1.330 albertel 9560:
1.315 albertel 9561: if ($args->{'js_ready'}) {
1.317 albertel 9562: $result = &js_ready($result);
1.315 albertel 9563: }
1.335 albertel 9564:
1.320 albertel 9565: if ($args->{'html_encode'}) {
9566: $result = &html_encode($result);
9567: }
1.335 albertel 9568:
1.315 albertel 9569: return $result;
9570: }
9571:
1.1075.2.161. .1(raebu 9572:21): sub menucoll_in_effect {
9573:21): my ($menucoll,$deeplinkmenu,%menu);
9574:21): if ($env{'request.course.id'}) {
9575:21): $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
9576:21): if ($env{'request.deeplink.login'}) {
9577:21): my ($deeplink_symb,$deeplink,$check_login_symb);
9578:21): my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9579:21): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9580:21): if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
9581:21): if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
9582:21): my $navmap = Apache::lonnavmaps::navmap->new();
9583:21): if (ref($navmap)) {
9584:21): $deeplink = $navmap->get_mapparam(undef,
9585:21): &Apache::lonnet::declutter($env{'request.noversionuri'}),
9586:21): '0.deeplink');
9587:21): } else {
9588:21): $check_login_symb = 1;
9589:21): }
9590:21): } else {
9591:21): my $symb=&Apache::lonnet::symbread();
9592:21): if ($symb) {
9593:21): $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
9594:21): } else {
9595:21): $check_login_symb = 1;
9596:21): }
9597:21): }
9598:21): } else {
9599:21): $check_login_symb = 1;
9600:21): }
9601:21): if ($check_login_symb) {
9602:21): $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
9603:21): if ($deeplink_symb =~ /\.(page|sequence)$/) {
9604:21): my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
9605:21): my $navmap = Apache::lonnavmaps::navmap->new();
9606:21): if (ref($navmap)) {
9607:21): $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
9608:21): }
9609:21): } else {
9610:21): $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
9611:21): }
9612:21): }
9613:21): if ($deeplink ne '') {
.6(raebu 9614:22): my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
.1(raebu 9615:21): if ($display =~ /^\d+$/) {
9616:21): $deeplinkmenu = 1;
9617:21): $menucoll = $display;
9618:21): }
9619:21): }
9620:21): }
9621:21): if ($menucoll) {
9622:21): %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
9623:21): }
9624:21): }
9625:21): return ($menucoll,$deeplinkmenu,\%menu);
9626:21): }
9627:21):
9628:21): sub deeplink_login_symb {
9629:21): my ($cnum,$cdom) = @_;
9630:21): my $login_symb;
9631:21): if ($env{'request.deeplink.login'}) {
9632:21): $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
9633:21): }
9634:21): return $login_symb;
9635:21): }
9636:21):
9637:21): sub symb_from_tinyurl {
9638:21): my ($url,$cnum,$cdom) = @_;
9639:21): if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
9640:21): my $key = $1;
9641:21): my ($tinyurl,$login);
9642:21): my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
9643:21): if (defined($cached)) {
9644:21): $tinyurl = $result;
9645:21): } else {
9646:21): my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
9647:21): my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
9648:21): if ($currtiny{$key} ne '') {
9649:21): $tinyurl = $currtiny{$key};
9650:21): &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
9651:21): }
9652:21): }
9653:21): if ($tinyurl ne '') {
9654:21): my ($cnumreq,$symb) = split(/\&/,$tinyurl);
9655:21): if (wantarray) {
9656:21): return ($cnumreq,$symb);
9657:21): } elsif ($cnumreq eq $cnum) {
9658:21): return $symb;
9659:21): }
9660:21): }
9661:21): }
9662:21): if (wantarray) {
9663:21): return ();
9664:21): } else {
9665:21): return;
9666:21): }
9667:21): }
9668:21):
.17(raeb 9669:-23): sub usable_exttools {
9670:-23): my %tooltypes;
9671:-23): if ($env{'request.course.id'}) {
9672:-23): if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {
9673:-23): if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {
9674:-23): %tooltypes = (
9675:-23): crs => 1,
9676:-23): dom => 1,
9677:-23): );
9678:-23): } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {
9679:-23): $tooltypes{'crs'} = 1;
9680:-23): } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {
9681:-23): $tooltypes{'dom'} = 1;
9682:-23): }
9683:-23): } else {
9684:-23): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9685:-23): my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
9686:-23): my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});
9687:-23): if ($crstype eq '') {
9688:-23): $crstype = 'course';
9689:-23): }
9690:-23): if ($crstype eq 'course') {
9691:-23): if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {
9692:-23): $crstype = 'official';
9693:-23): } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {
9694:-23): $crstype = 'textbook';
9695:-23): } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {
9696:-23): $crstype = 'lti';
9697:-23): } else {
9698:-23): $crstype = 'unofficial';
9699:-23): }
9700:-23): }
9701:-23): my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
9702:-23): if ($domdefaults{$crstype.'domexttool'}) {
9703:-23): $tooltypes{'dom'} = 1;
9704:-23): }
9705:-23): if ($domdefaults{$crstype.'exttool'}) {
9706:-23): $tooltypes{'crs'} = 1;
9707:-23): }
9708:-23): }
9709:-23): }
9710:-23): return %tooltypes;
9711:-23): }
9712:-23):
1.1034 www 9713: sub wishlist_window {
9714: return(<<'ENDWISHLIST');
1.1046 raeburn 9715: <script type="text/javascript">
1.1034 www 9716: // <![CDATA[
9717: // <!-- BEGIN LON-CAPA Internal
9718: function set_wishlistlink(title, path) {
9719: if (!title) {
9720: title = document.title;
9721: title = title.replace(/^LON-CAPA /,'');
9722: }
1.1075.2.65 raeburn 9723: title = encodeURIComponent(title);
1.1075.2.83 raeburn 9724: title = title.replace("'","\\\'");
1.1034 www 9725: if (!path) {
9726: path = location.pathname;
9727: }
1.1075.2.65 raeburn 9728: path = encodeURIComponent(path);
1.1075.2.83 raeburn 9729: path = path.replace("'","\\\'");
1.1034 www 9730: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
9731: 'wishlistNewLink','width=560,height=350,scrollbars=0');
9732: }
9733: // END LON-CAPA Internal -->
9734: // ]]>
9735: </script>
9736: ENDWISHLIST
9737: }
9738:
1.1030 www 9739: sub modal_window {
9740: return(<<'ENDMODAL');
1.1046 raeburn 9741: <script type="text/javascript">
1.1030 www 9742: // <![CDATA[
9743: // <!-- BEGIN LON-CAPA Internal
9744: var modalWindow = {
9745: parent:"body",
9746: windowId:null,
9747: content:null,
9748: width:null,
9749: height:null,
9750: close:function()
9751: {
9752: $(".LCmodal-window").remove();
9753: $(".LCmodal-overlay").remove();
9754: },
9755: open:function()
9756: {
9757: var modal = "";
9758: modal += "<div class=\"LCmodal-overlay\"></div>";
9759: 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;\">";
9760: modal += this.content;
9761: modal += "</div>";
9762:
9763: $(this.parent).append(modal);
9764:
9765: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
9766: $(".LCclose-window").click(function(){modalWindow.close();});
9767: $(".LCmodal-overlay").click(function(){modalWindow.close();});
9768: }
9769: };
1.1075.2.42 raeburn 9770: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 9771: {
1.1075.2.119 raeburn 9772: source = source.replace(/'/g,"'");
1.1030 www 9773: modalWindow.windowId = "myModal";
9774: modalWindow.width = width;
9775: modalWindow.height = height;
1.1075.2.80 raeburn 9776: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 9777: modalWindow.open();
1.1075.2.87 raeburn 9778: };
1.1030 www 9779: // END LON-CAPA Internal -->
9780: // ]]>
9781: </script>
9782: ENDMODAL
9783: }
9784:
9785: sub modal_link {
1.1075.2.42 raeburn 9786: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 9787: unless ($width) { $width=480; }
9788: unless ($height) { $height=400; }
1.1031 www 9789: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 9790: unless ($transparency) { $transparency='true'; }
9791:
1.1074 raeburn 9792: my $target_attr;
9793: if (defined($target)) {
9794: $target_attr = 'target="'.$target.'"';
9795: }
9796: return <<"ENDLINK";
1.1075.2.143 raeburn 9797: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 9798: ENDLINK
1.1030 www 9799: }
9800:
1.1032 www 9801: sub modal_adhoc_script {
1.1075.2.155 raeburn 9802: my ($funcname,$width,$height,$content,$possmathjax)=@_;
9803: my $mathjax;
9804: if ($possmathjax) {
9805: $mathjax = <<'ENDJAX';
9806: if (typeof MathJax == 'object') {
9807: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
9808: }
9809: ENDJAX
9810: }
1.1032 www 9811: return (<<ENDADHOC);
1.1046 raeburn 9812: <script type="text/javascript">
1.1032 www 9813: // <![CDATA[
9814: var $funcname = function()
9815: {
9816: modalWindow.windowId = "myModal";
9817: modalWindow.width = $width;
9818: modalWindow.height = $height;
9819: modalWindow.content = '$content';
9820: modalWindow.open();
1.1075.2.155 raeburn 9821: $mathjax
1.1032 www 9822: };
9823: // ]]>
9824: </script>
9825: ENDADHOC
9826: }
9827:
1.1041 www 9828: sub modal_adhoc_inner {
1.1075.2.155 raeburn 9829: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 9830: my $innerwidth=$width-20;
9831: $content=&js_ready(
1.1042 www 9832: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 9833: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
9834: $content.
1.1041 www 9835: &end_scrollbox().
1.1075.2.42 raeburn 9836: &end_page()
1.1041 www 9837: );
1.1075.2.155 raeburn 9838: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 9839: }
9840:
9841: sub modal_adhoc_window {
1.1075.2.155 raeburn 9842: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
9843: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 9844: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
9845: }
9846:
9847: sub modal_adhoc_launch {
9848: my ($funcname,$width,$height,$content)=@_;
9849: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
9850: <script type="text/javascript">
9851: // <![CDATA[
9852: $funcname();
9853: // ]]>
9854: </script>
9855: ENDLAUNCH
9856: }
9857:
9858: sub modal_adhoc_close {
9859: return (<<ENDCLOSE);
9860: <script type="text/javascript">
9861: // <![CDATA[
9862: modalWindow.close();
9863: // ]]>
9864: </script>
9865: ENDCLOSE
9866: }
9867:
1.1038 www 9868: sub togglebox_script {
9869: return(<<ENDTOGGLE);
9870: <script type="text/javascript">
9871: // <![CDATA[
9872: function LCtoggleDisplay(id,hidetext,showtext) {
9873: link = document.getElementById(id + "link").childNodes[0];
9874: with (document.getElementById(id).style) {
9875: if (display == "none" ) {
9876: display = "inline";
9877: link.nodeValue = hidetext;
9878: } else {
9879: display = "none";
9880: link.nodeValue = showtext;
9881: }
9882: }
9883: }
9884: // ]]>
9885: </script>
9886: ENDTOGGLE
9887: }
9888:
1.1039 www 9889: sub start_togglebox {
9890: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
9891: unless ($heading) { $heading=''; } else { $heading.=' '; }
9892: unless ($showtext) { $showtext=&mt('show'); }
9893: unless ($hidetext) { $hidetext=&mt('hide'); }
9894: unless ($headerbg) { $headerbg='#FFFFFF'; }
9895: return &start_data_table().
9896: &start_data_table_header_row().
9897: '<td bgcolor="'.$headerbg.'">'.$heading.
9898: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
9899: $showtext.'\')">'.$showtext.'</a>]</td>'.
9900: &end_data_table_header_row().
9901: '<tr id="'.$id.'" style="display:none""><td>';
9902: }
9903:
9904: sub end_togglebox {
9905: return '</td></tr>'.&end_data_table();
9906: }
9907:
1.1041 www 9908: sub LCprogressbar_script {
1.1075.2.130 raeburn 9909: my ($id,$number_to_do)=@_;
9910: if ($number_to_do) {
9911: return(<<ENDPROGRESS);
1.1041 www 9912: <script type="text/javascript">
9913: // <![CDATA[
1.1045 www 9914: \$('#progressbar$id').progressbar({
1.1041 www 9915: value: 0,
9916: change: function(event, ui) {
9917: var newVal = \$(this).progressbar('option', 'value');
9918: \$('.pblabel', this).text(LCprogressTxt);
9919: }
9920: });
9921: // ]]>
9922: </script>
9923: ENDPROGRESS
1.1075.2.130 raeburn 9924: } else {
9925: return(<<ENDPROGRESS);
9926: <script type="text/javascript">
9927: // <![CDATA[
9928: \$('#progressbar$id').progressbar({
9929: value: false,
9930: create: function(event, ui) {
9931: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
9932: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
9933: }
9934: });
9935: // ]]>
9936: </script>
9937: ENDPROGRESS
9938: }
1.1041 www 9939: }
9940:
9941: sub LCprogressbarUpdate_script {
9942: return(<<ENDPROGRESSUPDATE);
9943: <style type="text/css">
9944: .ui-progressbar { position:relative; }
1.1075.2.130 raeburn 9945: .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 9946: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
9947: </style>
9948: <script type="text/javascript">
9949: // <![CDATA[
1.1045 www 9950: var LCprogressTxt='---';
9951:
1.1075.2.130 raeburn 9952: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 9953: LCprogressTxt=progresstext;
1.1075.2.130 raeburn 9954: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
9955: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
9956: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
9957: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
9958: } else {
9959: \$('#progressbar'+id).progressbar('value',percent);
9960: }
1.1041 www 9961: }
9962: // ]]>
9963: </script>
9964: ENDPROGRESSUPDATE
9965: }
9966:
1.1042 www 9967: my $LClastpercent;
1.1045 www 9968: my $LCidcnt;
9969: my $LCcurrentid;
1.1042 www 9970:
1.1041 www 9971: sub LCprogressbar {
1.1075.2.130 raeburn 9972: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 9973: $LClastpercent=0;
1.1045 www 9974: $LCidcnt++;
9975: $LCcurrentid=$$.'_'.$LCidcnt;
1.1075.2.130 raeburn 9976: my ($starting,$content);
9977: if ($number_to_do) {
9978: $starting=&mt('Starting');
9979: $content=(<<ENDPROGBAR);
9980: $preamble
1.1045 www 9981: <div id="progressbar$LCcurrentid">
1.1041 www 9982: <span class="pblabel">$starting</span>
9983: </div>
9984: ENDPROGBAR
1.1075.2.130 raeburn 9985: } else {
9986: $starting=&mt('Loading...');
9987: $LClastpercent='false';
9988: $content=(<<ENDPROGBAR);
9989: $preamble
9990: <div id="progressbar$LCcurrentid">
9991: <div class="progress-label">$starting</div>
9992: </div>
9993: ENDPROGBAR
9994: }
9995: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 9996: }
9997:
9998: sub LCprogressbarUpdate {
1.1075.2.130 raeburn 9999: my ($r,$val,$text,$number_to_do)=@_;
10000: if ($number_to_do) {
10001: unless ($val) {
10002: if ($LClastpercent) {
10003: $val=$LClastpercent;
10004: } else {
10005: $val=0;
10006: }
10007: }
10008: if ($val<0) { $val=0; }
10009: if ($val>100) { $val=0; }
10010: $LClastpercent=$val;
10011: unless ($text) { $text=$val.'%'; }
10012: } else {
10013: $val = 'false';
1.1042 www 10014: }
1.1041 www 10015: $text=&js_ready($text);
1.1044 www 10016: &r_print($r,<<ENDUPDATE);
1.1041 www 10017: <script type="text/javascript">
10018: // <![CDATA[
1.1075.2.130 raeburn 10019: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 10020: // ]]>
10021: </script>
10022: ENDUPDATE
1.1035 www 10023: }
10024:
1.1042 www 10025: sub LCprogressbarClose {
10026: my ($r)=@_;
10027: $LClastpercent=0;
1.1044 www 10028: &r_print($r,<<ENDCLOSE);
1.1042 www 10029: <script type="text/javascript">
10030: // <![CDATA[
1.1045 www 10031: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 10032: // ]]>
10033: </script>
10034: ENDCLOSE
1.1044 www 10035: }
10036:
10037: sub r_print {
10038: my ($r,$to_print)=@_;
10039: if ($r) {
10040: $r->print($to_print);
10041: $r->rflush();
10042: } else {
10043: print($to_print);
10044: }
1.1042 www 10045: }
10046:
1.320 albertel 10047: sub html_encode {
10048: my ($result) = @_;
10049:
1.322 albertel 10050: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 10051:
10052: return $result;
10053: }
1.1044 www 10054:
1.317 albertel 10055: sub js_ready {
10056: my ($result) = @_;
10057:
1.323 albertel 10058: $result =~ s/[\n\r]/ /xmsg;
10059: $result =~ s/\\/\\\\/xmsg;
10060: $result =~ s/'/\\'/xmsg;
1.372 albertel 10061: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 10062:
10063: return $result;
10064: }
10065:
1.315 albertel 10066: sub validate_page {
10067: if ( exists($env{'internal.start_page'})
1.316 albertel 10068: && $env{'internal.start_page'} > 1) {
10069: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 10070: $env{'internal.start_page'}.' '.
1.316 albertel 10071: $ENV{'request.filename'});
1.315 albertel 10072: }
10073: if ( exists($env{'internal.end_page'})
1.316 albertel 10074: && $env{'internal.end_page'} > 1) {
10075: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 10076: $env{'internal.end_page'}.' '.
1.316 albertel 10077: $env{'request.filename'});
1.315 albertel 10078: }
10079: if ( exists($env{'internal.start_page'})
10080: && ! exists($env{'internal.end_page'})) {
1.316 albertel 10081: &Apache::lonnet::logthis('start_page called without end_page '.
10082: $env{'request.filename'});
1.315 albertel 10083: }
10084: if ( ! exists($env{'internal.start_page'})
10085: && exists($env{'internal.end_page'})) {
1.316 albertel 10086: &Apache::lonnet::logthis('end_page called without start_page'.
10087: $env{'request.filename'});
1.315 albertel 10088: }
1.306 albertel 10089: }
1.315 albertel 10090:
1.996 www 10091:
10092: sub start_scrollbox {
1.1075.2.56 raeburn 10093: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 10094: unless ($outerwidth) { $outerwidth='520px'; }
10095: unless ($width) { $width='500px'; }
10096: unless ($height) { $height='200px'; }
1.1075 raeburn 10097: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 10098: if ($id ne '') {
1.1075.2.42 raeburn 10099: $table_id = ' id="table_'.$id.'"';
10100: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 10101: }
1.1075 raeburn 10102: if ($bgcolor ne '') {
10103: $tdcol = "background-color: $bgcolor;";
10104: }
1.1075.2.42 raeburn 10105: my $nicescroll_js;
10106: if ($env{'browser.mobile'}) {
10107: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
10108: }
1.1075 raeburn 10109: return <<"END";
1.1075.2.42 raeburn 10110: $nicescroll_js
10111:
10112: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 10113: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 10114: END
1.996 www 10115: }
10116:
10117: sub end_scrollbox {
1.1036 www 10118: return '</div></td></tr></table>';
1.996 www 10119: }
10120:
1.1075.2.42 raeburn 10121: sub nicescroll_javascript {
10122: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
10123: my %options;
10124: if (ref($cursor) eq 'HASH') {
10125: %options = %{$cursor};
10126: }
10127: unless ($options{'railalign'} =~ /^left|right$/) {
10128: $options{'railalign'} = 'left';
10129: }
10130: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
10131: my $function = &get_users_function();
10132: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
10133: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
10134: $options{'cursorcolor'} = '#00F';
10135: }
10136: }
10137: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
10138: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
10139: $options{'cursoropacity'}='1.0';
10140: }
10141: } else {
10142: $options{'cursoropacity'}='1.0';
10143: }
10144: if ($options{'cursorfixedheight'} eq 'none') {
10145: delete($options{'cursorfixedheight'});
10146: } else {
10147: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
10148: }
10149: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
10150: delete($options{'railoffset'});
10151: }
10152: my @niceoptions;
10153: while (my($key,$value) = each(%options)) {
10154: if ($value =~ /^\{.+\}$/) {
10155: push(@niceoptions,$key.':'.$value);
10156: } else {
10157: push(@niceoptions,$key.':"'.$value.'"');
10158: }
10159: }
10160: my $nicescroll_js = '
10161: $(document).ready(
10162: function() {
10163: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
10164: }
10165: );
10166: ';
10167: if ($framecheck) {
10168: $nicescroll_js .= '
10169: function expand_div(caller) {
10170: if (top === self) {
10171: document.getElementById("'.$id.'").style.width = "auto";
10172: document.getElementById("'.$id.'").style.height = "auto";
10173: } else {
10174: try {
10175: if (parent.frames) {
10176: if (parent.frames.length > 1) {
10177: var framesrc = parent.frames[1].location.href;
10178: var currsrc = framesrc.replace(/\#.*$/,"");
10179: if ((caller == "search") || (currsrc == "'.$location.'")) {
10180: document.getElementById("'.$id.'").style.width = "auto";
10181: document.getElementById("'.$id.'").style.height = "auto";
10182: }
10183: }
10184: }
10185: } catch (e) {
10186: return;
10187: }
10188: }
10189: return;
10190: }
10191: ';
10192: }
10193: if ($needjsready) {
10194: $nicescroll_js = '
10195: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
10196: } else {
10197: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
10198: }
10199: return $nicescroll_js;
10200: }
10201:
1.318 albertel 10202: sub simple_error_page {
1.1075.2.49 raeburn 10203: my ($r,$title,$msg,$args) = @_;
1.1075.2.161. .4(raebu 10204:22): my %displayargs;
1.1075.2.49 raeburn 10205: if (ref($args) eq 'HASH') {
10206: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
1.1075.2.161. .4(raebu 10207:22): if ($args->{'only_body'}) {
10208:22): $displayargs{'only_body'} = 1;
10209:22): }
10210:22): if ($args->{'no_nav_bar'}) {
10211:22): $displayargs{'no_nav_bar'} = 1;
10212:22): }
1.1075.2.49 raeburn 10213: } else {
10214: $msg = &mt($msg);
10215: }
10216:
1.318 albertel 10217: my $page =
1.1075.2.161. .4(raebu 10218:22): &Apache::loncommon::start_page($title,'',\%displayargs).
1.1075.2.49 raeburn 10219: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 10220: &Apache::loncommon::end_page();
10221: if (ref($r)) {
10222: $r->print($page);
1.327 albertel 10223: return;
1.318 albertel 10224: }
10225: return $page;
10226: }
1.347 albertel 10227:
10228: {
1.610 albertel 10229: my @row_count;
1.961 onken 10230:
10231: sub start_data_table_count {
10232: unshift(@row_count, 0);
10233: return;
10234: }
10235:
10236: sub end_data_table_count {
10237: shift(@row_count);
10238: return;
10239: }
10240:
1.347 albertel 10241: sub start_data_table {
1.1018 raeburn 10242: my ($add_class,$id) = @_;
1.422 albertel 10243: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 10244: my $table_id;
10245: if (defined($id)) {
10246: $table_id = ' id="'.$id.'"';
10247: }
1.961 onken 10248: &start_data_table_count();
1.1018 raeburn 10249: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 10250: }
10251:
10252: sub end_data_table {
1.961 onken 10253: &end_data_table_count();
1.389 albertel 10254: return '</table>'."\n";;
1.347 albertel 10255: }
10256:
10257: sub start_data_table_row {
1.974 wenzelju 10258: my ($add_class, $id) = @_;
1.610 albertel 10259: $row_count[0]++;
10260: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 10261: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 10262: $id = (' id="'.$id.'"') unless ($id eq '');
10263: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 10264: }
1.471 banghart 10265:
10266: sub continue_data_table_row {
1.974 wenzelju 10267: my ($add_class, $id) = @_;
1.610 albertel 10268: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 10269: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
10270: $id = (' id="'.$id.'"') unless ($id eq '');
10271: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 10272: }
1.347 albertel 10273:
10274: sub end_data_table_row {
1.389 albertel 10275: return '</tr>'."\n";;
1.347 albertel 10276: }
1.367 www 10277:
1.421 albertel 10278: sub start_data_table_empty_row {
1.707 bisitz 10279: # $row_count[0]++;
1.421 albertel 10280: return '<tr class="LC_empty_row" >'."\n";;
10281: }
10282:
10283: sub end_data_table_empty_row {
10284: return '</tr>'."\n";;
10285: }
10286:
1.367 www 10287: sub start_data_table_header_row {
1.389 albertel 10288: return '<tr class="LC_header_row">'."\n";;
1.367 www 10289: }
10290:
10291: sub end_data_table_header_row {
1.389 albertel 10292: return '</tr>'."\n";;
1.367 www 10293: }
1.890 droeschl 10294:
10295: sub data_table_caption {
10296: my $caption = shift;
10297: return "<caption class=\"LC_caption\">$caption</caption>";
10298: }
1.347 albertel 10299: }
10300:
1.548 albertel 10301: =pod
10302:
10303: =item * &inhibit_menu_check($arg)
10304:
10305: Checks for a inhibitmenu state and generates output to preserve it
10306:
10307: Inputs: $arg - can be any of
10308: - undef - in which case the return value is a string
10309: to add into arguments list of a uri
10310: - 'input' - in which case the return value is a HTML
10311: <form> <input> field of type hidden to
10312: preserve the value
10313: - a url - in which case the return value is the url with
10314: the neccesary cgi args added to preserve the
10315: inhibitmenu state
10316: - a ref to a url - no return value, but the string is
10317: updated to include the neccessary cgi
10318: args to preserve the inhibitmenu state
10319:
10320: =cut
10321:
10322: sub inhibit_menu_check {
10323: my ($arg) = @_;
10324: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
10325: if ($arg eq 'input') {
10326: if ($env{'form.inhibitmenu'}) {
10327: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
10328: } else {
10329: return
10330: }
10331: }
10332: if ($env{'form.inhibitmenu'}) {
10333: if (ref($arg)) {
10334: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10335: } elsif ($arg eq '') {
10336: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
10337: } else {
10338: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
10339: }
10340: }
10341: if (!ref($arg)) {
10342: return $arg;
10343: }
10344: }
10345:
1.251 albertel 10346: ###############################################
1.182 matthew 10347:
10348: =pod
10349:
1.549 albertel 10350: =back
10351:
10352: =head1 User Information Routines
10353:
10354: =over 4
10355:
1.405 albertel 10356: =item * &get_users_function()
1.182 matthew 10357:
10358: Used by &bodytag to determine the current users primary role.
10359: Returns either 'student','coordinator','admin', or 'author'.
10360:
10361: =cut
10362:
10363: ###############################################
10364: sub get_users_function {
1.815 tempelho 10365: my $function = 'norole';
1.818 tempelho 10366: if ($env{'request.role'}=~/^(st)/) {
10367: $function='student';
10368: }
1.907 raeburn 10369: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 10370: $function='coordinator';
10371: }
1.258 albertel 10372: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 10373: $function='admin';
10374: }
1.826 bisitz 10375: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 10376: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 10377: $function='author';
10378: }
10379: return $function;
1.54 www 10380: }
1.99 www 10381:
10382: ###############################################
10383:
1.233 raeburn 10384: =pod
10385:
1.821 raeburn 10386: =item * &show_course()
10387:
10388: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
10389: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
10390:
10391: Inputs:
10392: None
10393:
10394: Outputs:
10395: Scalar: 1 if 'Course' to be used, 0 otherwise.
10396:
10397: =cut
10398:
10399: ###############################################
10400: sub show_course {
10401: my $course = !$env{'user.adv'};
10402: if (!$env{'user.adv'}) {
10403: foreach my $env (keys(%env)) {
10404: next if ($env !~ m/^user\.priv\./);
10405: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
10406: $course = 0;
10407: last;
10408: }
10409: }
10410: }
10411: return $course;
10412: }
10413:
10414: ###############################################
10415:
10416: =pod
10417:
1.542 raeburn 10418: =item * &check_user_status()
1.274 raeburn 10419:
10420: Determines current status of supplied role for a
10421: specific user. Roles can be active, previous or future.
10422:
10423: Inputs:
10424: user's domain, user's username, course's domain,
1.375 raeburn 10425: course's number, optional section ID.
1.274 raeburn 10426:
10427: Outputs:
10428: role status: active, previous or future.
10429:
10430: =cut
10431:
10432: sub check_user_status {
1.412 raeburn 10433: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 10434: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85 raeburn 10435: my @uroles = keys(%userinfo);
1.274 raeburn 10436: my $srchstr;
10437: my $active_chk = 'none';
1.412 raeburn 10438: my $now = time;
1.274 raeburn 10439: if (@uroles > 0) {
1.908 raeburn 10440: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 10441: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
10442: } else {
1.412 raeburn 10443: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
10444: }
10445: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 10446: my $role_end = 0;
10447: my $role_start = 0;
10448: $active_chk = 'active';
1.412 raeburn 10449: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
10450: $role_end = $1;
10451: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
10452: $role_start = $1;
1.274 raeburn 10453: }
10454: }
10455: if ($role_start > 0) {
1.412 raeburn 10456: if ($now < $role_start) {
1.274 raeburn 10457: $active_chk = 'future';
10458: }
10459: }
10460: if ($role_end > 0) {
1.412 raeburn 10461: if ($now > $role_end) {
1.274 raeburn 10462: $active_chk = 'previous';
10463: }
10464: }
10465: }
10466: }
10467: return $active_chk;
10468: }
10469:
10470: ###############################################
10471:
10472: =pod
10473:
1.405 albertel 10474: =item * &get_sections()
1.233 raeburn 10475:
10476: Determines all the sections for a course including
10477: sections with students and sections containing other roles.
1.419 raeburn 10478: Incoming parameters:
10479:
10480: 1. domain
10481: 2. course number
10482: 3. reference to array containing roles for which sections should
10483: be gathered (optional).
10484: 4. reference to array containing status types for which sections
10485: should be gathered (optional).
10486:
10487: If the third argument is undefined, sections are gathered for any role.
10488: If the fourth argument is undefined, sections are gathered for any status.
10489: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 10490:
1.374 raeburn 10491: Returns section hash (keys are section IDs, values are
10492: number of users in each section), subject to the
1.419 raeburn 10493: optional roles filter, optional status filter
1.233 raeburn 10494:
10495: =cut
10496:
10497: ###############################################
10498: sub get_sections {
1.419 raeburn 10499: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 10500: if (!defined($cdom) || !defined($cnum)) {
10501: my $cid = $env{'request.course.id'};
10502:
10503: return if (!defined($cid));
10504:
10505: $cdom = $env{'course.'.$cid.'.domain'};
10506: $cnum = $env{'course.'.$cid.'.num'};
10507: }
10508:
10509: my %sectioncount;
1.419 raeburn 10510: my $now = time;
1.240 albertel 10511:
1.1075.2.33 raeburn 10512: my $check_students = 1;
10513: my $only_students = 0;
10514: if (ref($possible_roles) eq 'ARRAY') {
10515: if (grep(/^st$/,@{$possible_roles})) {
10516: if (@{$possible_roles} == 1) {
10517: $only_students = 1;
10518: }
10519: } else {
10520: $check_students = 0;
10521: }
10522: }
10523:
10524: if ($check_students) {
1.276 albertel 10525: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 10526: my $sec_index = &Apache::loncoursedata::CL_SECTION();
10527: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 10528: my $start_index = &Apache::loncoursedata::CL_START();
10529: my $end_index = &Apache::loncoursedata::CL_END();
10530: my $status;
1.366 albertel 10531: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 10532: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
10533: $data->[$status_index],
10534: $data->[$start_index],
10535: $data->[$end_index]);
10536: if ($stu_status eq 'Active') {
10537: $status = 'active';
10538: } elsif ($end < $now) {
10539: $status = 'previous';
10540: } elsif ($start > $now) {
10541: $status = 'future';
10542: }
10543: if ($section ne '-1' && $section !~ /^\s*$/) {
10544: if ((!defined($possible_status)) || (($status ne '') &&
10545: (grep/^\Q$status\E$/,@{$possible_status}))) {
10546: $sectioncount{$section}++;
10547: }
1.240 albertel 10548: }
10549: }
10550: }
1.1075.2.33 raeburn 10551: if ($only_students) {
10552: return %sectioncount;
10553: }
1.240 albertel 10554: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10555: foreach my $user (sort(keys(%courseroles))) {
10556: if ($user !~ /^(\w{2})/) { next; }
10557: my ($role) = ($user =~ /^(\w{2})/);
10558: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 10559: my ($section,$status);
1.240 albertel 10560: if ($role eq 'cr' &&
10561: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
10562: $section=$1;
10563: }
10564: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
10565: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 10566: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
10567: if ($end == -1 && $start == -1) {
10568: next; #deleted role
10569: }
10570: if (!defined($possible_status)) {
10571: $sectioncount{$section}++;
10572: } else {
10573: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
10574: $status = 'active';
10575: } elsif ($end < $now) {
10576: $status = 'future';
10577: } elsif ($start > $now) {
10578: $status = 'previous';
10579: }
10580: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
10581: $sectioncount{$section}++;
10582: }
10583: }
1.233 raeburn 10584: }
1.366 albertel 10585: return %sectioncount;
1.233 raeburn 10586: }
10587:
1.274 raeburn 10588: ###############################################
1.294 raeburn 10589:
10590: =pod
1.405 albertel 10591:
10592: =item * &get_course_users()
10593:
1.275 raeburn 10594: Retrieves usernames:domains for users in the specified course
10595: with specific role(s), and access status.
10596:
10597: Incoming parameters:
1.277 albertel 10598: 1. course domain
10599: 2. course number
10600: 3. access status: users must have - either active,
1.275 raeburn 10601: previous, future, or all.
1.277 albertel 10602: 4. reference to array of permissible roles
1.288 raeburn 10603: 5. reference to array of section restrictions (optional)
10604: 6. reference to results object (hash of hashes).
10605: 7. reference to optional userdata hash
1.609 raeburn 10606: 8. reference to optional statushash
1.630 raeburn 10607: 9. flag if privileged users (except those set to unhide in
10608: course settings) should be excluded
1.609 raeburn 10609: Keys of top level results hash are roles.
1.275 raeburn 10610: Keys of inner hashes are username:domain, with
10611: values set to access type.
1.288 raeburn 10612: Optional userdata hash returns an array with arguments in the
10613: same order as loncoursedata::get_classlist() for student data.
10614:
1.609 raeburn 10615: Optional statushash returns
10616:
1.288 raeburn 10617: Entries for end, start, section and status are blank because
10618: of the possibility of multiple values for non-student roles.
10619:
1.275 raeburn 10620: =cut
1.405 albertel 10621:
1.275 raeburn 10622: ###############################################
1.405 albertel 10623:
1.275 raeburn 10624: sub get_course_users {
1.630 raeburn 10625: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 10626: my %idx = ();
1.419 raeburn 10627: my %seclists;
1.288 raeburn 10628:
10629: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
10630: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
10631: $idx{end} = &Apache::loncoursedata::CL_END();
10632: $idx{start} = &Apache::loncoursedata::CL_START();
10633: $idx{id} = &Apache::loncoursedata::CL_ID();
10634: $idx{section} = &Apache::loncoursedata::CL_SECTION();
10635: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
10636: $idx{status} = &Apache::loncoursedata::CL_STATUS();
10637:
1.290 albertel 10638: if (grep(/^st$/,@{$roles})) {
1.276 albertel 10639: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 10640: my $now = time;
1.277 albertel 10641: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 10642: my $match = 0;
1.412 raeburn 10643: my $secmatch = 0;
1.419 raeburn 10644: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 10645: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 10646: if ($section eq '') {
10647: $section = 'none';
10648: }
1.291 albertel 10649: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10650: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10651: $secmatch = 1;
10652: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 10653: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10654: $secmatch = 1;
10655: }
10656: } else {
1.419 raeburn 10657: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 10658: $secmatch = 1;
10659: }
1.290 albertel 10660: }
1.412 raeburn 10661: if (!$secmatch) {
10662: next;
10663: }
1.419 raeburn 10664: }
1.275 raeburn 10665: if (defined($$types{'active'})) {
1.288 raeburn 10666: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 10667: push(@{$$users{st}{$student}},'active');
1.288 raeburn 10668: $match = 1;
1.275 raeburn 10669: }
10670: }
10671: if (defined($$types{'previous'})) {
1.609 raeburn 10672: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 10673: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 10674: $match = 1;
1.275 raeburn 10675: }
10676: }
10677: if (defined($$types{'future'})) {
1.609 raeburn 10678: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 10679: push(@{$$users{st}{$student}},'future');
1.288 raeburn 10680: $match = 1;
1.275 raeburn 10681: }
10682: }
1.609 raeburn 10683: if ($match) {
10684: push(@{$seclists{$student}},$section);
10685: if (ref($userdata) eq 'HASH') {
10686: $$userdata{$student} = $$classlist{$student};
10687: }
10688: if (ref($statushash) eq 'HASH') {
10689: $statushash->{$student}{'st'}{$section} = $status;
10690: }
1.288 raeburn 10691: }
1.275 raeburn 10692: }
10693: }
1.412 raeburn 10694: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 10695: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10696: my $now = time;
1.609 raeburn 10697: my %displaystatus = ( previous => 'Expired',
10698: active => 'Active',
10699: future => 'Future',
10700: );
1.1075.2.36 raeburn 10701: my (%nothide,@possdoms);
1.630 raeburn 10702: if ($hidepriv) {
10703: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
10704: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
10705: if ($user !~ /:/) {
10706: $nothide{join(':',split(/[\@]/,$user))}=1;
10707: } else {
10708: $nothide{$user} = 1;
10709: }
10710: }
1.1075.2.36 raeburn 10711: my @possdoms = ($cdom);
10712: if ($coursehash{'checkforpriv'}) {
10713: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
10714: }
1.630 raeburn 10715: }
1.439 raeburn 10716: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 10717: my $match = 0;
1.412 raeburn 10718: my $secmatch = 0;
1.439 raeburn 10719: my $status;
1.412 raeburn 10720: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 10721: $user =~ s/:$//;
1.439 raeburn 10722: my ($end,$start) = split(/:/,$coursepersonnel{$person});
10723: if ($end == -1 || $start == -1) {
10724: next;
10725: }
10726: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
10727: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 10728: my ($uname,$udom) = split(/:/,$user);
10729: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 10730: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 10731: $secmatch = 1;
10732: } elsif ($usec eq '') {
1.420 albertel 10733: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 10734: $secmatch = 1;
10735: }
10736: } else {
10737: if (grep(/^\Q$usec\E$/,@{$sections})) {
10738: $secmatch = 1;
10739: }
10740: }
10741: if (!$secmatch) {
10742: next;
10743: }
1.288 raeburn 10744: }
1.419 raeburn 10745: if ($usec eq '') {
10746: $usec = 'none';
10747: }
1.275 raeburn 10748: if ($uname ne '' && $udom ne '') {
1.630 raeburn 10749: if ($hidepriv) {
1.1075.2.36 raeburn 10750: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 10751: (!$nothide{$uname.':'.$udom})) {
10752: next;
10753: }
10754: }
1.503 raeburn 10755: if ($end > 0 && $end < $now) {
1.439 raeburn 10756: $status = 'previous';
10757: } elsif ($start > $now) {
10758: $status = 'future';
10759: } else {
10760: $status = 'active';
10761: }
1.277 albertel 10762: foreach my $type (keys(%{$types})) {
1.275 raeburn 10763: if ($status eq $type) {
1.420 albertel 10764: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 10765: push(@{$$users{$role}{$user}},$type);
10766: }
1.288 raeburn 10767: $match = 1;
10768: }
10769: }
1.419 raeburn 10770: if (($match) && (ref($userdata) eq 'HASH')) {
10771: if (!exists($$userdata{$uname.':'.$udom})) {
10772: &get_user_info($udom,$uname,\%idx,$userdata);
10773: }
1.420 albertel 10774: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 10775: push(@{$seclists{$uname.':'.$udom}},$usec);
10776: }
1.609 raeburn 10777: if (ref($statushash) eq 'HASH') {
10778: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
10779: }
1.275 raeburn 10780: }
10781: }
10782: }
10783: }
1.290 albertel 10784: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 10785: if ((defined($cdom)) && (defined($cnum))) {
10786: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
10787: if ( defined($csettings{'internal.courseowner'}) ) {
10788: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 10789: next if ($owner eq '');
10790: my ($ownername,$ownerdom);
10791: if ($owner =~ /^([^:]+):([^:]+)$/) {
10792: $ownername = $1;
10793: $ownerdom = $2;
10794: } else {
10795: $ownername = $owner;
10796: $ownerdom = $cdom;
10797: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 10798: }
10799: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 10800: if (defined($userdata) &&
1.609 raeburn 10801: !exists($$userdata{$owner})) {
10802: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
10803: if (!grep(/^none$/,@{$seclists{$owner}})) {
10804: push(@{$seclists{$owner}},'none');
10805: }
10806: if (ref($statushash) eq 'HASH') {
10807: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 10808: }
1.290 albertel 10809: }
1.279 raeburn 10810: }
10811: }
10812: }
1.419 raeburn 10813: foreach my $user (keys(%seclists)) {
10814: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
10815: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
10816: }
1.275 raeburn 10817: }
10818: return;
10819: }
10820:
1.288 raeburn 10821: sub get_user_info {
10822: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 10823: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
10824: &plainname($uname,$udom,'lastname');
1.291 albertel 10825: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 10826: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 10827: my %idhash = &Apache::lonnet::idrget($udom,($uname));
10828: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 10829: return;
10830: }
1.275 raeburn 10831:
1.472 raeburn 10832: ###############################################
10833:
10834: =pod
10835:
10836: =item * &get_user_quota()
10837:
1.1075.2.41 raeburn 10838: Retrieves quota assigned for storage of user files.
10839: Default is to report quota for portfolio files.
1.472 raeburn 10840:
10841: Incoming parameters:
10842: 1. user's username
10843: 2. user's domain
1.1075.2.41 raeburn 10844: 3. quota name - portfolio, author, or course
10845: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 10846: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 10847: course
1.472 raeburn 10848:
10849: Returns:
1.1075.2.58 raeburn 10850: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 10851: 2. (Optional) Type of setting: custom or default
10852: (individually assigned or default for user's
10853: institutional status).
10854: 3. (Optional) - User's institutional status (e.g., faculty, staff
10855: or student - types as defined in localenroll::inst_usertypes
10856: for user's domain, which determines default quota for user.
10857: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 10858:
10859: If a value has been stored in the user's environment,
1.536 raeburn 10860: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 10861: defined for the user's institutional status(es) in the domain.
1.472 raeburn 10862:
10863: =cut
10864:
10865: ###############################################
10866:
10867:
10868: sub get_user_quota {
1.1075.2.42 raeburn 10869: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 10870: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 10871: if (!defined($udom)) {
10872: $udom = $env{'user.domain'};
10873: }
10874: if (!defined($uname)) {
10875: $uname = $env{'user.name'};
10876: }
10877: if (($udom eq '' || $uname eq '') ||
10878: ($udom eq 'public') && ($uname eq 'public')) {
10879: $quota = 0;
1.536 raeburn 10880: $quotatype = 'default';
10881: $defquota = 0;
1.472 raeburn 10882: } else {
1.536 raeburn 10883: my $inststatus;
1.1075.2.41 raeburn 10884: if ($quotaname eq 'course') {
10885: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
10886: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
10887: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
10888: } else {
10889: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
10890: $quota = $cenv{'internal.uploadquota'};
10891: }
1.536 raeburn 10892: } else {
1.1075.2.41 raeburn 10893: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
10894: if ($quotaname eq 'author') {
10895: $quota = $env{'environment.authorquota'};
10896: } else {
10897: $quota = $env{'environment.portfolioquota'};
10898: }
10899: $inststatus = $env{'environment.inststatus'};
10900: } else {
10901: my %userenv =
10902: &Apache::lonnet::get('environment',['portfolioquota',
10903: 'authorquota','inststatus'],$udom,$uname);
10904: my ($tmp) = keys(%userenv);
10905: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
10906: if ($quotaname eq 'author') {
10907: $quota = $userenv{'authorquota'};
10908: } else {
10909: $quota = $userenv{'portfolioquota'};
10910: }
10911: $inststatus = $userenv{'inststatus'};
10912: } else {
10913: undef(%userenv);
10914: }
10915: }
10916: }
10917: if ($quota eq '' || wantarray) {
10918: if ($quotaname eq 'course') {
10919: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 10920: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
10921: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 10922: $defquota = $domdefs{$crstype.'quota'};
10923: }
10924: if ($defquota eq '') {
10925: $defquota = 500;
10926: }
1.1075.2.41 raeburn 10927: } else {
10928: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
10929: }
10930: if ($quota eq '') {
10931: $quota = $defquota;
10932: $quotatype = 'default';
10933: } else {
10934: $quotatype = 'custom';
10935: }
1.472 raeburn 10936: }
10937: }
1.536 raeburn 10938: if (wantarray) {
10939: return ($quota,$quotatype,$settingstatus,$defquota);
10940: } else {
10941: return $quota;
10942: }
1.472 raeburn 10943: }
10944:
10945: ###############################################
10946:
10947: =pod
10948:
10949: =item * &default_quota()
10950:
1.536 raeburn 10951: Retrieves default quota assigned for storage of user portfolio files,
10952: given an (optional) user's institutional status.
1.472 raeburn 10953:
10954: Incoming parameters:
1.1075.2.42 raeburn 10955:
1.472 raeburn 10956: 1. domain
1.536 raeburn 10957: 2. (Optional) institutional status(es). This is a : separated list of
10958: status types (e.g., faculty, staff, student etc.)
10959: which apply to the user for whom the default is being retrieved.
10960: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 10961: default quota will be returned.
10962: 3. quota name - portfolio, author, or course
10963: (if no quota name provided, defaults to portfolio).
1.472 raeburn 10964:
10965: Returns:
1.1075.2.42 raeburn 10966:
1.1075.2.58 raeburn 10967: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 10968: 2. (Optional) institutional type which determined the value of the
10969: default quota.
1.472 raeburn 10970:
10971: If a value has been stored in the domain's configuration db,
10972: it will return that, otherwise it returns 20 (for backwards
10973: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 10974: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 10975:
1.536 raeburn 10976: If the user's status includes multiple types (e.g., staff and student),
10977: the largest default quota which applies to the user determines the
10978: default quota returned.
10979:
1.472 raeburn 10980: =cut
10981:
10982: ###############################################
10983:
10984:
10985: sub default_quota {
1.1075.2.41 raeburn 10986: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 10987: my ($defquota,$settingstatus);
10988: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 10989: ['quotas'],$udom);
1.1075.2.41 raeburn 10990: my $key = 'defaultquota';
10991: if ($quotaname eq 'author') {
10992: $key = 'authorquota';
10993: }
1.622 raeburn 10994: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 10995: if ($inststatus ne '') {
1.765 raeburn 10996: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 10997: foreach my $item (@statuses) {
1.1075.2.41 raeburn 10998: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
10999: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 11000: if ($defquota eq '') {
1.1075.2.41 raeburn 11001: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 11002: $settingstatus = $item;
1.1075.2.41 raeburn 11003: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
11004: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 11005: $settingstatus = $item;
11006: }
11007: }
1.1075.2.41 raeburn 11008: } elsif ($key eq 'defaultquota') {
1.711 raeburn 11009: if ($quotahash{'quotas'}{$item} ne '') {
11010: if ($defquota eq '') {
11011: $defquota = $quotahash{'quotas'}{$item};
11012: $settingstatus = $item;
11013: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
11014: $defquota = $quotahash{'quotas'}{$item};
11015: $settingstatus = $item;
11016: }
1.536 raeburn 11017: }
11018: }
11019: }
11020: }
11021: if ($defquota eq '') {
1.1075.2.41 raeburn 11022: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
11023: $defquota = $quotahash{'quotas'}{$key}{'default'};
11024: } elsif ($key eq 'defaultquota') {
1.711 raeburn 11025: $defquota = $quotahash{'quotas'}{'default'};
11026: }
1.536 raeburn 11027: $settingstatus = 'default';
1.1075.2.42 raeburn 11028: if ($defquota eq '') {
11029: if ($quotaname eq 'author') {
11030: $defquota = 500;
11031: }
11032: }
1.536 raeburn 11033: }
11034: } else {
11035: $settingstatus = 'default';
1.1075.2.41 raeburn 11036: if ($quotaname eq 'author') {
11037: $defquota = 500;
11038: } else {
11039: $defquota = 20;
11040: }
1.536 raeburn 11041: }
11042: if (wantarray) {
11043: return ($defquota,$settingstatus);
1.472 raeburn 11044: } else {
1.536 raeburn 11045: return $defquota;
1.472 raeburn 11046: }
11047: }
11048:
1.1075.2.41 raeburn 11049: ###############################################
11050:
11051: =pod
11052:
1.1075.2.42 raeburn 11053: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 11054:
11055: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 11056: of existing file within authoring space will cause quota for the authoring
11057: space to be exceeded.
11058:
11059: Same, if upload of a file directly to a course/community via Course Editor
11060: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 11061:
1.1075.2.61 raeburn 11062: Inputs: 7
1.1075.2.42 raeburn 11063: 1. username or coursenum
1.1075.2.41 raeburn 11064: 2. domain
1.1075.2.42 raeburn 11065: 3. context ('author' or 'course')
1.1075.2.41 raeburn 11066: 4. filename of file for which action is being requested
11067: 5. filesize (kB) of file
11068: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 11069: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 11070:
11071: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
11072: otherwise return null.
11073:
1.1075.2.42 raeburn 11074: =back
11075:
1.1075.2.41 raeburn 11076: =cut
11077:
1.1075.2.42 raeburn 11078: sub excess_filesize_warning {
1.1075.2.59 raeburn 11079: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 11080: my $current_disk_usage = 0;
1.1075.2.59 raeburn 11081: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 11082: if ($context eq 'author') {
11083: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
11084: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
11085: } else {
11086: foreach my $subdir ('docs','supplemental') {
11087: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
11088: }
11089: }
1.1075.2.41 raeburn 11090: $disk_quota = int($disk_quota * 1000);
11091: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69 raeburn 11092: return '<p class="LC_warning">'.
1.1075.2.41 raeburn 11093: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69 raeburn 11094: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
11095: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41 raeburn 11096: $disk_quota,$current_disk_usage).
11097: '</p>';
11098: }
11099: return;
11100: }
11101:
11102: ###############################################
11103:
11104:
1.384 raeburn 11105: sub get_secgrprole_info {
11106: my ($cdom,$cnum,$needroles,$type) = @_;
11107: my %sections_count = &get_sections($cdom,$cnum);
11108: my @sections = (sort {$a <=> $b} keys(%sections_count));
11109: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
11110: my @groups = sort(keys(%curr_groups));
11111: my $allroles = [];
11112: my $rolehash;
11113: my $accesshash = {
11114: active => 'Currently has access',
11115: future => 'Will have future access',
11116: previous => 'Previously had access',
11117: };
11118: if ($needroles) {
11119: $rolehash = {'all' => 'all'};
1.385 albertel 11120: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
11121: if (&Apache::lonnet::error(%user_roles)) {
11122: undef(%user_roles);
11123: }
11124: foreach my $item (keys(%user_roles)) {
1.384 raeburn 11125: my ($role)=split(/\:/,$item,2);
11126: if ($role eq 'cr') { next; }
11127: if ($role =~ /^cr/) {
11128: $$rolehash{$role} = (split('/',$role))[3];
11129: } else {
11130: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
11131: }
11132: }
11133: foreach my $key (sort(keys(%{$rolehash}))) {
11134: push(@{$allroles},$key);
11135: }
11136: push (@{$allroles},'st');
11137: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
11138: }
11139: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
11140: }
11141:
1.555 raeburn 11142: sub user_picker {
1.1075.2.127 raeburn 11143: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 11144: my $currdom = $dom;
1.1075.2.114 raeburn 11145: my @alldoms = &Apache::lonnet::all_domains();
11146: if (@alldoms == 1) {
11147: my %domsrch = &Apache::lonnet::get_dom('configuration',
11148: ['directorysrch'],$alldoms[0]);
11149: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
11150: my $showdom = $domdesc;
11151: if ($showdom eq '') {
11152: $showdom = $dom;
11153: }
11154: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
11155: if ((!$domsrch{'directorysrch'}{'available'}) &&
11156: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
11157: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
11158: }
11159: }
11160: }
1.555 raeburn 11161: my %curr_selected = (
11162: srchin => 'dom',
1.580 raeburn 11163: srchby => 'lastname',
1.555 raeburn 11164: );
11165: my $srchterm;
1.625 raeburn 11166: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 11167: if ($srch->{'srchby'} ne '') {
11168: $curr_selected{'srchby'} = $srch->{'srchby'};
11169: }
11170: if ($srch->{'srchin'} ne '') {
11171: $curr_selected{'srchin'} = $srch->{'srchin'};
11172: }
11173: if ($srch->{'srchtype'} ne '') {
11174: $curr_selected{'srchtype'} = $srch->{'srchtype'};
11175: }
11176: if ($srch->{'srchdomain'} ne '') {
11177: $currdom = $srch->{'srchdomain'};
11178: }
11179: $srchterm = $srch->{'srchterm'};
11180: }
1.1075.2.98 raeburn 11181: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 11182: 'usr' => 'Search criteria',
1.563 raeburn 11183: 'doma' => 'Domain/institution to search',
1.558 albertel 11184: 'uname' => 'username',
11185: 'lastname' => 'last name',
1.555 raeburn 11186: 'lastfirst' => 'last name, first name',
1.558 albertel 11187: 'crs' => 'in this course',
1.576 raeburn 11188: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 11189: 'alc' => 'all LON-CAPA',
1.573 raeburn 11190: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 11191: 'exact' => 'is',
11192: 'contains' => 'contains',
1.569 raeburn 11193: 'begins' => 'begins with',
1.1075.2.98 raeburn 11194: );
11195: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 11196: 'youm' => "You must include some text to search for.",
11197: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
11198: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
11199: 'yomc' => "You must choose a domain when using an institutional directory search.",
11200: 'ymcd' => "You must choose a domain when using a domain search.",
11201: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
11202: 'whse' => "When searching by last,first you must include at least one character in the first name.",
11203: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 11204: );
1.1075.2.98 raeburn 11205: &html_escape(\%html_lt);
11206: &js_escape(\%js_lt);
1.1075.2.115 raeburn 11207: my $domform;
1.1075.2.126 raeburn 11208: my $allow_blank = 1;
1.1075.2.115 raeburn 11209: if ($fixeddom) {
1.1075.2.126 raeburn 11210: $allow_blank = 0;
11211: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1075.2.115 raeburn 11212: } else {
1.1075.2.126 raeburn 11213: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
1.1075.2.115 raeburn 11214: }
1.563 raeburn 11215: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 11216:
11217: my @srchins = ('crs','dom','alc','instd');
11218:
11219: foreach my $option (@srchins) {
11220: # FIXME 'alc' option unavailable until
11221: # loncreateuser::print_user_query_page()
11222: # has been completed.
11223: next if ($option eq 'alc');
1.880 raeburn 11224: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 11225: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1075.2.127 raeburn 11226: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 11227: if ($curr_selected{'srchin'} eq $option) {
11228: $srchinsel .= '
1.1075.2.98 raeburn 11229: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 11230: } else {
11231: $srchinsel .= '
1.1075.2.98 raeburn 11232: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 11233: }
1.555 raeburn 11234: }
1.563 raeburn 11235: $srchinsel .= "\n </select>\n";
1.555 raeburn 11236:
11237: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 11238: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 11239: if ($curr_selected{'srchby'} eq $option) {
11240: $srchbysel .= '
1.1075.2.98 raeburn 11241: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11242: } else {
11243: $srchbysel .= '
1.1075.2.98 raeburn 11244: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11245: }
11246: }
11247: $srchbysel .= "\n </select>\n";
11248:
11249: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 11250: foreach my $option ('begins','contains','exact') {
1.555 raeburn 11251: if ($curr_selected{'srchtype'} eq $option) {
11252: $srchtypesel .= '
1.1075.2.98 raeburn 11253: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 11254: } else {
11255: $srchtypesel .= '
1.1075.2.98 raeburn 11256: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 11257: }
11258: }
11259: $srchtypesel .= "\n </select>\n";
11260:
1.558 albertel 11261: my ($newuserscript,$new_user_create);
1.994 raeburn 11262: my $context_dom = $env{'request.role.domain'};
11263: if ($context eq 'requestcrs') {
11264: if ($env{'form.coursedom'} ne '') {
11265: $context_dom = $env{'form.coursedom'};
11266: }
11267: }
1.556 raeburn 11268: if ($forcenewuser) {
1.576 raeburn 11269: if (ref($srch) eq 'HASH') {
1.994 raeburn 11270: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 11271: if ($cancreate) {
11272: $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>';
11273: } else {
1.799 bisitz 11274: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 11275: my %usertypetext = (
11276: official => 'institutional',
11277: unofficial => 'non-institutional',
11278: );
1.799 bisitz 11279: $new_user_create = '<p class="LC_warning">'
11280: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
11281: .' '
11282: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
11283: ,'<a href="'.$helplink.'">','</a>')
11284: .'</p><br />';
1.627 raeburn 11285: }
1.576 raeburn 11286: }
11287: }
11288:
1.556 raeburn 11289: $newuserscript = <<"ENDSCRIPT";
11290:
1.570 raeburn 11291: function setSearch(createnew,callingForm) {
1.556 raeburn 11292: if (createnew == 1) {
1.570 raeburn 11293: for (var i=0; i<callingForm.srchby.length; i++) {
11294: if (callingForm.srchby.options[i].value == 'uname') {
11295: callingForm.srchby.selectedIndex = i;
1.556 raeburn 11296: }
11297: }
1.570 raeburn 11298: for (var i=0; i<callingForm.srchin.length; i++) {
11299: if ( callingForm.srchin.options[i].value == 'dom') {
11300: callingForm.srchin.selectedIndex = i;
1.556 raeburn 11301: }
11302: }
1.570 raeburn 11303: for (var i=0; i<callingForm.srchtype.length; i++) {
11304: if (callingForm.srchtype.options[i].value == 'exact') {
11305: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 11306: }
11307: }
1.570 raeburn 11308: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 11309: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 11310: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 11311: }
11312: }
11313: }
11314: }
11315: ENDSCRIPT
1.558 albertel 11316:
1.556 raeburn 11317: }
11318:
1.555 raeburn 11319: my $output = <<"END_BLOCK";
1.556 raeburn 11320: <script type="text/javascript">
1.824 bisitz 11321: // <![CDATA[
1.570 raeburn 11322: function validateEntry(callingForm) {
1.558 albertel 11323:
1.556 raeburn 11324: var checkok = 1;
1.558 albertel 11325: var srchin;
1.570 raeburn 11326: for (var i=0; i<callingForm.srchin.length; i++) {
11327: if ( callingForm.srchin[i].checked ) {
11328: srchin = callingForm.srchin[i].value;
1.558 albertel 11329: }
11330: }
11331:
1.570 raeburn 11332: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
11333: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
11334: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
11335: var srchterm = callingForm.srchterm.value;
11336: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 11337: var msg = "";
11338:
11339: if (srchterm == "") {
11340: checkok = 0;
1.1075.2.98 raeburn 11341: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 11342: }
11343:
1.569 raeburn 11344: if (srchtype== 'begins') {
11345: if (srchterm.length < 2) {
11346: checkok = 0;
1.1075.2.98 raeburn 11347: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 11348: }
11349: }
11350:
1.556 raeburn 11351: if (srchtype== 'contains') {
11352: if (srchterm.length < 3) {
11353: checkok = 0;
1.1075.2.98 raeburn 11354: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 11355: }
11356: }
11357: if (srchin == 'instd') {
11358: if (srchdomain == '') {
11359: checkok = 0;
1.1075.2.98 raeburn 11360: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 11361: }
11362: }
11363: if (srchin == 'dom') {
11364: if (srchdomain == '') {
11365: checkok = 0;
1.1075.2.98 raeburn 11366: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 11367: }
11368: }
11369: if (srchby == 'lastfirst') {
11370: if (srchterm.indexOf(",") == -1) {
11371: checkok = 0;
1.1075.2.98 raeburn 11372: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 11373: }
11374: if (srchterm.indexOf(",") == srchterm.length -1) {
11375: checkok = 0;
1.1075.2.98 raeburn 11376: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 11377: }
11378: }
11379: if (checkok == 0) {
1.1075.2.98 raeburn 11380: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 11381: return;
11382: }
11383: if (checkok == 1) {
1.570 raeburn 11384: callingForm.submit();
1.556 raeburn 11385: }
11386: }
11387:
11388: $newuserscript
11389:
1.824 bisitz 11390: // ]]>
1.556 raeburn 11391: </script>
1.558 albertel 11392:
11393: $new_user_create
11394:
1.555 raeburn 11395: END_BLOCK
1.558 albertel 11396:
1.876 raeburn 11397: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98 raeburn 11398: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 11399: $domform.
11400: &Apache::lonhtmlcommon::row_closure().
1.1075.2.98 raeburn 11401: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 11402: $srchbysel.
11403: $srchtypesel.
11404: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
11405: $srchinsel.
11406: &Apache::lonhtmlcommon::row_closure(1).
11407: &Apache::lonhtmlcommon::end_pick_box().
11408: '<br />';
1.1075.2.114 raeburn 11409: return ($output,1);
1.555 raeburn 11410: }
11411:
1.612 raeburn 11412: sub user_rule_check {
1.615 raeburn 11413: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99 raeburn 11414: my ($response,%inst_response);
1.612 raeburn 11415: if (ref($usershash) eq 'HASH') {
1.1075.2.99 raeburn 11416: if (keys(%{$usershash}) > 1) {
11417: my (%by_username,%by_id,%userdoms);
11418: my $checkid;
1.612 raeburn 11419: if (ref($checks) eq 'HASH') {
1.1075.2.99 raeburn 11420: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
11421: $checkid = 1;
11422: }
11423: }
11424: foreach my $user (keys(%{$usershash})) {
11425: my ($uname,$udom) = split(/:/,$user);
11426: if ($checkid) {
11427: if (ref($usershash->{$user}) eq 'HASH') {
11428: if ($usershash->{$user}->{'id'} ne '') {
11429: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
11430: $userdoms{$udom} = 1;
11431: if (ref($inst_results) eq 'HASH') {
11432: $inst_results->{$uname.':'.$udom} = {};
11433: }
11434: }
11435: }
11436: } else {
11437: $by_username{$udom}{$uname} = 1;
11438: $userdoms{$udom} = 1;
11439: if (ref($inst_results) eq 'HASH') {
11440: $inst_results->{$uname.':'.$udom} = {};
11441: }
11442: }
11443: }
11444: foreach my $udom (keys(%userdoms)) {
11445: if (!$got_rules->{$udom}) {
11446: my %domconfig = &Apache::lonnet::get_dom('configuration',
11447: ['usercreation'],$udom);
11448: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11449: foreach my $item ('username','id') {
11450: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
11451: $$curr_rules{$udom}{$item} =
11452: $domconfig{'usercreation'}{$item.'_rule'};
11453: }
11454: }
11455: }
11456: $got_rules->{$udom} = 1;
11457: }
11458: }
11459: if ($checkid) {
11460: foreach my $udom (keys(%by_id)) {
11461: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
11462: if ($outcome eq 'ok') {
11463: foreach my $id (keys(%{$by_id{$udom}})) {
11464: my $uname = $by_id{$udom}{$id};
11465: $inst_response{$uname.':'.$udom} = $outcome;
11466: }
11467: if (ref($results) eq 'HASH') {
11468: foreach my $uname (keys(%{$results})) {
11469: if (exists($inst_response{$uname.':'.$udom})) {
11470: $inst_response{$uname.':'.$udom} = $outcome;
11471: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11472: }
11473: }
11474: }
11475: }
1.612 raeburn 11476: }
1.615 raeburn 11477: } else {
1.1075.2.99 raeburn 11478: foreach my $udom (keys(%by_username)) {
11479: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
11480: if ($outcome eq 'ok') {
11481: foreach my $uname (keys(%{$by_username{$udom}})) {
11482: $inst_response{$uname.':'.$udom} = $outcome;
11483: }
11484: if (ref($results) eq 'HASH') {
11485: foreach my $uname (keys(%{$results})) {
11486: $inst_results->{$uname.':'.$udom} = $results->{$uname};
11487: }
11488: }
11489: }
11490: }
1.612 raeburn 11491: }
1.1075.2.99 raeburn 11492: } elsif (keys(%{$usershash}) == 1) {
11493: my $user = (keys(%{$usershash}))[0];
11494: my ($uname,$udom) = split(/:/,$user);
11495: if (($udom ne '') && ($uname ne '')) {
11496: if (ref($usershash->{$user}) eq 'HASH') {
11497: if (ref($checks) eq 'HASH') {
11498: if (defined($checks->{'username'})) {
11499: ($inst_response{$user},%{$inst_results->{$user}}) =
11500: &Apache::lonnet::get_instuser($udom,$uname);
11501: } elsif (defined($checks->{'id'})) {
11502: if ($usershash->{$user}->{'id'} ne '') {
11503: ($inst_response{$user},%{$inst_results->{$user}}) =
11504: &Apache::lonnet::get_instuser($udom,undef,
11505: $usershash->{$user}->{'id'});
11506: } else {
11507: ($inst_response{$user},%{$inst_results->{$user}}) =
11508: &Apache::lonnet::get_instuser($udom,$uname);
11509: }
11510: }
11511: } else {
11512: ($inst_response{$user},%{$inst_results->{$user}}) =
11513: &Apache::lonnet::get_instuser($udom,$uname);
11514: return;
11515: }
11516: if (!$got_rules->{$udom}) {
11517: my %domconfig = &Apache::lonnet::get_dom('configuration',
11518: ['usercreation'],$udom);
11519: if (ref($domconfig{'usercreation'}) eq 'HASH') {
11520: foreach my $item ('username','id') {
11521: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
11522: $$curr_rules{$udom}{$item} =
11523: $domconfig{'usercreation'}{$item.'_rule'};
11524: }
11525: }
1.585 raeburn 11526: }
1.1075.2.99 raeburn 11527: $got_rules->{$udom} = 1;
1.585 raeburn 11528: }
11529: }
1.1075.2.99 raeburn 11530: } else {
11531: return;
11532: }
11533: } else {
11534: return;
11535: }
11536: foreach my $user (keys(%{$usershash})) {
11537: my ($uname,$udom) = split(/:/,$user);
11538: next if (($udom eq '') || ($uname eq ''));
11539: my $id;
11540: if (ref($inst_results) eq 'HASH') {
11541: if (ref($inst_results->{$user}) eq 'HASH') {
11542: $id = $inst_results->{$user}->{'id'};
11543: }
11544: }
11545: if ($id eq '') {
11546: if (ref($usershash->{$user})) {
11547: $id = $usershash->{$user}->{'id'};
11548: }
1.585 raeburn 11549: }
1.612 raeburn 11550: foreach my $item (keys(%{$checks})) {
11551: if (ref($$curr_rules{$udom}) eq 'HASH') {
11552: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
11553: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99 raeburn 11554: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
11555: $$curr_rules{$udom}{$item});
1.612 raeburn 11556: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
11557: if ($rule_check{$rule}) {
11558: $$rulematch{$user}{$item} = $rule;
1.1075.2.99 raeburn 11559: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 11560: if (ref($inst_results) eq 'HASH') {
11561: if (ref($inst_results->{$user}) eq 'HASH') {
11562: if (keys(%{$inst_results->{$user}}) == 0) {
11563: $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99 raeburn 11564: } elsif ($item eq 'id') {
11565: if ($inst_results->{$user}->{'id'} eq '') {
11566: $$alerts{$item}{$udom}{$uname} = 1;
11567: }
1.615 raeburn 11568: }
1.612 raeburn 11569: }
11570: }
1.615 raeburn 11571: }
11572: last;
1.585 raeburn 11573: }
11574: }
11575: }
11576: }
11577: }
11578: }
11579: }
11580: }
1.612 raeburn 11581: return;
11582: }
11583:
11584: sub user_rule_formats {
11585: my ($domain,$domdesc,$curr_rules,$check) = @_;
11586: my %text = (
11587: 'username' => 'Usernames',
11588: 'id' => 'IDs',
11589: );
11590: my $output;
11591: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
11592: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
11593: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 11594: $output = '<br />'.
11595: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
11596: '<span class="LC_cusr_emph">','</span>',$domdesc).
11597: ' <ul>';
1.612 raeburn 11598: foreach my $rule (@{$ruleorder}) {
11599: if (ref($curr_rules) eq 'ARRAY') {
11600: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
11601: if (ref($rules->{$rule}) eq 'HASH') {
11602: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
11603: $rules->{$rule}{'desc'}.'</li>';
11604: }
11605: }
11606: }
11607: }
11608: $output .= '</ul>';
11609: }
11610: }
11611: return $output;
11612: }
11613:
11614: sub instrule_disallow_msg {
1.615 raeburn 11615: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 11616: my $response;
11617: my %text = (
11618: item => 'username',
11619: items => 'usernames',
11620: match => 'matches',
11621: do => 'does',
11622: action => 'a username',
11623: one => 'one',
11624: );
11625: if ($count > 1) {
11626: $text{'item'} = 'usernames';
11627: $text{'match'} ='match';
11628: $text{'do'} = 'do';
11629: $text{'action'} = 'usernames',
11630: $text{'one'} = 'ones';
11631: }
11632: if ($checkitem eq 'id') {
11633: $text{'items'} = 'IDs';
11634: $text{'item'} = 'ID';
11635: $text{'action'} = 'an ID';
1.615 raeburn 11636: if ($count > 1) {
11637: $text{'item'} = 'IDs';
11638: $text{'action'} = 'IDs';
11639: }
1.612 raeburn 11640: }
1.674 bisitz 11641: $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 11642: if ($mode eq 'upload') {
11643: if ($checkitem eq 'username') {
11644: $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'}.");
11645: } elsif ($checkitem eq 'id') {
1.674 bisitz 11646: $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 11647: }
1.669 raeburn 11648: } elsif ($mode eq 'selfcreate') {
11649: if ($checkitem eq 'id') {
11650: $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.");
11651: }
1.615 raeburn 11652: } else {
11653: if ($checkitem eq 'username') {
11654: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
11655: } elsif ($checkitem eq 'id') {
11656: $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.");
11657: }
1.612 raeburn 11658: }
11659: return $response;
1.585 raeburn 11660: }
11661:
1.624 raeburn 11662: sub personal_data_fieldtitles {
11663: my %fieldtitles = &Apache::lonlocal::texthash (
11664: id => 'Student/Employee ID',
11665: permanentemail => 'E-mail address',
11666: lastname => 'Last Name',
11667: firstname => 'First Name',
11668: middlename => 'Middle Name',
11669: generation => 'Generation',
11670: gen => 'Generation',
1.765 raeburn 11671: inststatus => 'Affiliation',
1.624 raeburn 11672: );
11673: return %fieldtitles;
11674: }
11675:
1.642 raeburn 11676: sub sorted_inst_types {
11677: my ($dom) = @_;
1.1075.2.70 raeburn 11678: my ($usertypes,$order);
11679: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
11680: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
11681: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
11682: $order = $domdefaults{'inststatus'}{'inststatusorder'};
11683: } else {
11684: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
11685: }
1.642 raeburn 11686: my $othertitle = &mt('All users');
11687: if ($env{'request.course.id'}) {
1.668 raeburn 11688: $othertitle = &mt('Any users');
1.642 raeburn 11689: }
11690: my @types;
11691: if (ref($order) eq 'ARRAY') {
11692: @types = @{$order};
11693: }
11694: if (@types == 0) {
11695: if (ref($usertypes) eq 'HASH') {
11696: @types = sort(keys(%{$usertypes}));
11697: }
11698: }
11699: if (keys(%{$usertypes}) > 0) {
11700: $othertitle = &mt('Other users');
11701: }
11702: return ($othertitle,$usertypes,\@types);
11703: }
11704:
1.645 raeburn 11705: sub get_institutional_codes {
1.1075.2.157 raeburn 11706: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 11707: # Get complete list of course sections to update
11708: my @currsections = ();
11709: my @currxlists = ();
1.1075.2.157 raeburn 11710: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 11711: my $coursecode = $$settings{'internal.coursecode'};
1.1075.2.157 raeburn 11712: my $crskey = $crs.':'.$coursecode;
11713: @{$unclutteredsec{$crskey}} = ();
11714: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 11715:
11716: if ($$settings{'internal.sectionnums'} ne '') {
11717: @currsections = split(/,/,$$settings{'internal.sectionnums'});
11718: }
11719:
11720: if ($$settings{'internal.crosslistings'} ne '') {
11721: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
11722: }
11723:
11724: if (@currxlists > 0) {
1.1075.2.157 raeburn 11725: foreach my $xl (@currxlists) {
11726: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 11727: unless (grep/^$1$/,@{$allcourses}) {
1.1075.2.119 raeburn 11728: push(@{$allcourses},$1);
1.645 raeburn 11729: $$LC_code{$1} = $2;
11730: }
11731: }
11732: }
11733: }
1.1075.2.157 raeburn 11734:
1.645 raeburn 11735: if (@currsections > 0) {
1.1075.2.157 raeburn 11736: foreach my $sec (@currsections) {
11737: if ($sec =~ m/^(\w+):(\w*)$/ ) {
11738: my $instsec = $1;
1.645 raeburn 11739: my $lc_sec = $2;
1.1075.2.157 raeburn 11740: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
11741: push(@{$unclutteredsec{$crskey}},$instsec);
11742: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
11743: }
11744: }
11745: }
11746: }
11747:
11748: if (@{$unclutteredsec{$crskey}} > 0) {
11749: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
11750: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
11751: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
11752: my $sec = $coursecode.$formattedsec{$crskey}[$i];
11753: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1075.2.119 raeburn 11754: push(@{$allcourses},$sec);
1.1075.2.157 raeburn 11755: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 11756: }
11757: }
11758: }
11759: }
11760: return;
11761: }
11762:
1.971 raeburn 11763: sub get_standard_codeitems {
11764: return ('Year','Semester','Department','Number','Section');
11765: }
11766:
1.112 bowersj2 11767: =pod
11768:
1.780 raeburn 11769: =head1 Slot Helpers
11770:
11771: =over 4
11772:
11773: =item * sorted_slots()
11774:
1.1040 raeburn 11775: Sorts an array of slot names in order of an optional sort key,
11776: default sort is by slot start time (earliest first).
1.780 raeburn 11777:
11778: Inputs:
11779:
11780: =over 4
11781:
11782: slotsarr - Reference to array of unsorted slot names.
11783:
11784: slots - Reference to hash of hash, where outer hash keys are slot names.
11785:
1.1040 raeburn 11786: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
11787:
1.549 albertel 11788: =back
11789:
1.780 raeburn 11790: Returns:
11791:
11792: =over 4
11793:
1.1040 raeburn 11794: sorted - An array of slot names sorted by a specified sort key
11795: (default sort key is start time of the slot).
1.780 raeburn 11796:
11797: =back
11798:
11799: =cut
11800:
11801:
11802: sub sorted_slots {
1.1040 raeburn 11803: my ($slotsarr,$slots,$sortkey) = @_;
11804: if ($sortkey eq '') {
11805: $sortkey = 'starttime';
11806: }
1.780 raeburn 11807: my @sorted;
11808: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
11809: @sorted =
11810: sort {
11811: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 11812: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 11813: }
11814: if (ref($slots->{$a})) { return -1;}
11815: if (ref($slots->{$b})) { return 1;}
11816: return 0;
11817: } @{$slotsarr};
11818: }
11819: return @sorted;
11820: }
11821:
1.1040 raeburn 11822: =pod
11823:
11824: =item * get_future_slots()
11825:
11826: Inputs:
11827:
11828: =over 4
11829:
11830: cnum - course number
11831:
11832: cdom - course domain
11833:
11834: now - current UNIX time
11835:
11836: symb - optional symb
11837:
11838: =back
11839:
11840: Returns:
11841:
11842: =over 4
11843:
11844: sorted_reservable - ref to array of student_schedulable slots currently
11845: reservable, ordered by end date of reservation period.
11846:
11847: reservable_now - ref to hash of student_schedulable slots currently
11848: reservable.
11849:
11850: Keys in inner hash are:
11851: (a) symb: either blank or symb to which slot use is restricted.
1.1075.2.104 raeburn 11852: (b) endreserve: end date of reservation period.
11853: (c) uniqueperiod: start,end dates when slot is to be uniquely
11854: selected.
1.1040 raeburn 11855:
11856: sorted_future - ref to array of student_schedulable slots reservable in
11857: the future, ordered by start date of reservation period.
11858:
11859: future_reservable - ref to hash of student_schedulable slots reservable
11860: in the future.
11861:
11862: Keys in inner hash are:
11863: (a) symb: either blank or symb to which slot use is restricted.
11864: (b) startreserve: start date of reservation period.
1.1075.2.104 raeburn 11865: (c) uniqueperiod: start,end dates when slot is to be uniquely
11866: selected.
1.1040 raeburn 11867:
11868: =back
11869:
11870: =cut
11871:
11872: sub get_future_slots {
11873: my ($cnum,$cdom,$now,$symb) = @_;
11874: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
11875: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
11876: foreach my $slot (keys(%slots)) {
11877: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
11878: if ($symb) {
11879: next if (($slots{$slot}->{'symb'} ne '') &&
11880: ($slots{$slot}->{'symb'} ne $symb));
11881: }
11882: if (($slots{$slot}->{'starttime'} > $now) &&
11883: ($slots{$slot}->{'endtime'} > $now)) {
11884: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
11885: my $userallowed = 0;
11886: if ($slots{$slot}->{'allowedsections'}) {
11887: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
11888: if (!defined($env{'request.role.sec'})
11889: && grep(/^No section assigned$/,@allowed_sec)) {
11890: $userallowed=1;
11891: } else {
11892: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
11893: $userallowed=1;
11894: }
11895: }
11896: unless ($userallowed) {
11897: if (defined($env{'request.course.groups'})) {
11898: my @groups = split(/:/,$env{'request.course.groups'});
11899: foreach my $group (@groups) {
11900: if (grep(/^\Q$group\E$/,@allowed_sec)) {
11901: $userallowed=1;
11902: last;
11903: }
11904: }
11905: }
11906: }
11907: }
11908: if ($slots{$slot}->{'allowedusers'}) {
11909: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
11910: my $user = $env{'user.name'}.':'.$env{'user.domain'};
11911: if (grep(/^\Q$user\E$/,@allowed_users)) {
11912: $userallowed = 1;
11913: }
11914: }
11915: next unless($userallowed);
11916: }
11917: my $startreserve = $slots{$slot}->{'startreserve'};
11918: my $endreserve = $slots{$slot}->{'endreserve'};
11919: my $symb = $slots{$slot}->{'symb'};
1.1075.2.104 raeburn 11920: my $uniqueperiod;
11921: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
11922: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
11923: }
1.1040 raeburn 11924: if (($startreserve < $now) &&
11925: (!$endreserve || $endreserve > $now)) {
11926: my $lastres = $endreserve;
11927: if (!$lastres) {
11928: $lastres = $slots{$slot}->{'starttime'};
11929: }
11930: $reservable_now{$slot} = {
11931: symb => $symb,
1.1075.2.104 raeburn 11932: endreserve => $lastres,
11933: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11934: };
11935: } elsif (($startreserve > $now) &&
11936: (!$endreserve || $endreserve > $startreserve)) {
11937: $future_reservable{$slot} = {
11938: symb => $symb,
1.1075.2.104 raeburn 11939: startreserve => $startreserve,
11940: uniqueperiod => $uniqueperiod,
1.1040 raeburn 11941: };
11942: }
11943: }
11944: }
11945: my @unsorted_reservable = keys(%reservable_now);
11946: if (@unsorted_reservable > 0) {
11947: @sorted_reservable =
11948: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
11949: }
11950: my @unsorted_future = keys(%future_reservable);
11951: if (@unsorted_future > 0) {
11952: @sorted_future =
11953: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
11954: }
11955: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
11956: }
1.780 raeburn 11957:
11958: =pod
11959:
1.1057 foxr 11960: =back
11961:
1.549 albertel 11962: =head1 HTTP Helpers
11963:
11964: =over 4
11965:
1.648 raeburn 11966: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 11967:
1.258 albertel 11968: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 11969: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 11970: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 11971:
11972: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
11973: $possible_names is an ref to an array of form element names. As an example:
11974: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 11975: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 11976:
11977: =cut
1.1 albertel 11978:
1.6 albertel 11979: sub get_unprocessed_cgi {
1.25 albertel 11980: my ($query,$possible_names)= @_;
1.26 matthew 11981: # $Apache::lonxml::debug=1;
1.356 albertel 11982: foreach my $pair (split(/&/,$query)) {
11983: my ($name, $value) = split(/=/,$pair);
1.369 www 11984: $name = &unescape($name);
1.25 albertel 11985: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
11986: $value =~ tr/+/ /;
11987: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 11988: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 11989: }
1.16 harris41 11990: }
1.6 albertel 11991: }
11992:
1.112 bowersj2 11993: =pod
11994:
1.648 raeburn 11995: =item * &cacheheader()
1.112 bowersj2 11996:
11997: returns cache-controlling header code
11998:
11999: =cut
12000:
1.7 albertel 12001: sub cacheheader {
1.258 albertel 12002: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 12003: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
12004: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 12005: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
12006: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 12007: return $output;
1.7 albertel 12008: }
12009:
1.112 bowersj2 12010: =pod
12011:
1.648 raeburn 12012: =item * &no_cache($r)
1.112 bowersj2 12013:
12014: specifies header code to not have cache
12015:
12016: =cut
12017:
1.9 albertel 12018: sub no_cache {
1.216 albertel 12019: my ($r) = @_;
12020: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 12021: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 12022: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
12023: $r->no_cache(1);
12024: $r->header_out("Expires" => $date);
12025: $r->header_out("Pragma" => "no-cache");
1.123 www 12026: }
12027:
12028: sub content_type {
1.181 albertel 12029: my ($r,$type,$charset) = @_;
1.299 foxr 12030: if ($r) {
12031: # Note that printout.pl calls this with undef for $r.
12032: &no_cache($r);
12033: }
1.258 albertel 12034: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 12035: unless ($charset) {
12036: $charset=&Apache::lonlocal::current_encoding;
12037: }
12038: if ($charset) { $type.='; charset='.$charset; }
12039: if ($r) {
12040: $r->content_type($type);
12041: } else {
12042: print("Content-type: $type\n\n");
12043: }
1.9 albertel 12044: }
1.25 albertel 12045:
1.112 bowersj2 12046: =pod
12047:
1.648 raeburn 12048: =item * &add_to_env($name,$value)
1.112 bowersj2 12049:
1.258 albertel 12050: adds $name to the %env hash with value
1.112 bowersj2 12051: $value, if $name already exists, the entry is converted to an array
12052: reference and $value is added to the array.
12053:
12054: =cut
12055:
1.25 albertel 12056: sub add_to_env {
12057: my ($name,$value)=@_;
1.258 albertel 12058: if (defined($env{$name})) {
12059: if (ref($env{$name})) {
1.25 albertel 12060: #already have multiple values
1.258 albertel 12061: push(@{ $env{$name} },$value);
1.25 albertel 12062: } else {
12063: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 12064: my $first=$env{$name};
12065: undef($env{$name});
12066: push(@{ $env{$name} },$first,$value);
1.25 albertel 12067: }
12068: } else {
1.258 albertel 12069: $env{$name}=$value;
1.25 albertel 12070: }
1.31 albertel 12071: }
1.149 albertel 12072:
12073: =pod
12074:
1.648 raeburn 12075: =item * &get_env_multiple($name)
1.149 albertel 12076:
1.258 albertel 12077: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 12078: values may be defined and end up as an array ref.
12079:
12080: returns an array of values
12081:
12082: =cut
12083:
12084: sub get_env_multiple {
12085: my ($name) = @_;
12086: my @values;
1.258 albertel 12087: if (defined($env{$name})) {
1.149 albertel 12088: # exists is it an array
1.258 albertel 12089: if (ref($env{$name})) {
12090: @values=@{ $env{$name} };
1.149 albertel 12091: } else {
1.258 albertel 12092: $values[0]=$env{$name};
1.149 albertel 12093: }
12094: }
12095: return(@values);
12096: }
12097:
1.660 raeburn 12098: sub ask_for_embedded_content {
12099: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 12100: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 12101: %currsubfile,%unused,$rem);
1.1071 raeburn 12102: my $counter = 0;
12103: my $numnew = 0;
1.987 raeburn 12104: my $numremref = 0;
12105: my $numinvalid = 0;
12106: my $numpathchg = 0;
12107: my $numexisting = 0;
1.1071 raeburn 12108: my $numunused = 0;
12109: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 12110: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 12111: my $heading = &mt('Upload embedded files');
12112: my $buttontext = &mt('Upload');
12113:
1.1075.2.11 raeburn 12114: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 12115: if ($actionurl eq '/adm/dependencies') {
12116: $navmap = Apache::lonnavmaps::navmap->new();
12117: }
12118: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
12119: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 12120: }
1.1075.2.35 raeburn 12121: if (($actionurl eq '/adm/portfolio') ||
12122: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 12123: my $current_path='/';
12124: if ($env{'form.currentpath'}) {
12125: $current_path = $env{'form.currentpath'};
12126: }
12127: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 12128: $udom = $cdom;
12129: $uname = $cnum;
1.984 raeburn 12130: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
12131: } else {
12132: $udom = $env{'user.domain'};
12133: $uname = $env{'user.name'};
12134: $url = '/userfiles/portfolio';
12135: }
1.987 raeburn 12136: $toplevel = $url.'/';
1.984 raeburn 12137: $url .= $current_path;
12138: $getpropath = 1;
1.987 raeburn 12139: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12140: ($actionurl eq '/adm/imsimport')) {
1.1022 www 12141: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 12142: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 12143: $toplevel = $url;
1.984 raeburn 12144: if ($rest ne '') {
1.987 raeburn 12145: $url .= $rest;
12146: }
12147: } elsif ($actionurl eq '/adm/coursedocs') {
12148: if (ref($args) eq 'HASH') {
1.1071 raeburn 12149: $url = $args->{'docs_url'};
12150: $toplevel = $url;
1.1075.2.11 raeburn 12151: if ($args->{'context'} eq 'paste') {
12152: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
12153: ($path) =
12154: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12155: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12156: $fileloc =~ s{^/}{};
12157: }
1.1071 raeburn 12158: }
12159: } elsif ($actionurl eq '/adm/dependencies') {
12160: if ($env{'request.course.id'} ne '') {
12161: if (ref($args) eq 'HASH') {
12162: $url = $args->{'docs_url'};
12163: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 12164: $toplevel = $url;
12165: unless ($toplevel =~ m{^/}) {
12166: $toplevel = "/$url";
12167: }
1.1075.2.11 raeburn 12168: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 12169: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
12170: $path = $1;
12171: } else {
12172: ($path) =
12173: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
12174: }
1.1075.2.79 raeburn 12175: if ($toplevel=~/^\/*(uploaded|editupload)/) {
12176: $fileloc = $toplevel;
12177: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
12178: my ($udom,$uname,$fname) =
12179: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
12180: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
12181: } else {
12182: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
12183: }
1.1071 raeburn 12184: $fileloc =~ s{^/}{};
12185: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
12186: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
12187: }
1.987 raeburn 12188: }
1.1075.2.35 raeburn 12189: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12190: $udom = $cdom;
12191: $uname = $cnum;
12192: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
12193: $toplevel = $url;
12194: $path = $url;
12195: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
12196: $fileloc =~ s{^/}{};
12197: }
12198: foreach my $file (keys(%{$allfiles})) {
12199: my $embed_file;
12200: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
12201: $embed_file = $1;
12202: } else {
12203: $embed_file = $file;
12204: }
1.1075.2.55 raeburn 12205: my ($absolutepath,$cleaned_file);
12206: if ($embed_file =~ m{^\w+://}) {
12207: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 12208: $newfiles{$cleaned_file} = 1;
12209: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12210: } else {
1.1075.2.55 raeburn 12211: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 12212: if ($embed_file =~ m{^/}) {
12213: $absolutepath = $embed_file;
12214: }
1.1075.2.47 raeburn 12215: if ($cleaned_file =~ m{/}) {
12216: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 12217: $path = &check_for_traversal($path,$url,$toplevel);
12218: my $item = $fname;
12219: if ($path ne '') {
12220: $item = $path.'/'.$fname;
12221: $subdependencies{$path}{$fname} = 1;
12222: } else {
12223: $dependencies{$item} = 1;
12224: }
12225: if ($absolutepath) {
12226: $mapping{$item} = $absolutepath;
12227: } else {
12228: $mapping{$item} = $embed_file;
12229: }
12230: } else {
12231: $dependencies{$embed_file} = 1;
12232: if ($absolutepath) {
1.1075.2.47 raeburn 12233: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 12234: } else {
1.1075.2.47 raeburn 12235: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 12236: }
12237: }
1.984 raeburn 12238: }
12239: }
1.1071 raeburn 12240: my $dirptr = 16384;
1.984 raeburn 12241: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 12242: $currsubfile{$path} = {};
1.1075.2.35 raeburn 12243: if (($actionurl eq '/adm/portfolio') ||
12244: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12245: my ($sublistref,$listerror) =
12246: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
12247: if (ref($sublistref) eq 'ARRAY') {
12248: foreach my $line (@{$sublistref}) {
12249: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 12250: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 12251: }
1.984 raeburn 12252: }
1.987 raeburn 12253: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12254: if (opendir(my $dir,$url.'/'.$path)) {
12255: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 12256: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
12257: }
1.1075.2.11 raeburn 12258: } elsif (($actionurl eq '/adm/dependencies') ||
12259: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 12260: ($args->{'context'} eq 'paste')) ||
12261: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12262: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 12263: my $dir;
12264: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
12265: $dir = $fileloc;
12266: } else {
12267: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12268: }
1.1071 raeburn 12269: if ($dir ne '') {
12270: my ($sublistref,$listerror) =
12271: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
12272: if (ref($sublistref) eq 'ARRAY') {
12273: foreach my $line (@{$sublistref}) {
12274: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
12275: undef,$mtime)=split(/\&/,$line,12);
12276: unless (($testdir&$dirptr) ||
12277: ($file_name =~ /^\.\.?$/)) {
12278: $currsubfile{$path}{$file_name} = [$size,$mtime];
12279: }
12280: }
12281: }
12282: }
1.984 raeburn 12283: }
12284: }
12285: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 12286: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 12287: my $item = $path.'/'.$file;
12288: unless ($mapping{$item} eq $item) {
12289: $pathchanges{$item} = 1;
12290: }
12291: $existing{$item} = 1;
12292: $numexisting ++;
12293: } else {
12294: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 12295: }
12296: }
1.1071 raeburn 12297: if ($actionurl eq '/adm/dependencies') {
12298: foreach my $path (keys(%currsubfile)) {
12299: if (ref($currsubfile{$path}) eq 'HASH') {
12300: foreach my $file (keys(%{$currsubfile{$path}})) {
12301: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 12302: next if (($rem ne '') &&
12303: (($env{"httpref.$rem"."$path/$file"} ne '') ||
12304: (ref($navmap) &&
12305: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
12306: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12307: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 12308: $unused{$path.'/'.$file} = 1;
12309: }
12310: }
12311: }
12312: }
12313: }
1.984 raeburn 12314: }
1.987 raeburn 12315: my %currfile;
1.1075.2.35 raeburn 12316: if (($actionurl eq '/adm/portfolio') ||
12317: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 12318: my ($dirlistref,$listerror) =
12319: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
12320: if (ref($dirlistref) eq 'ARRAY') {
12321: foreach my $line (@{$dirlistref}) {
12322: my ($file_name,$rest) = split(/\&/,$line,2);
12323: $currfile{$file_name} = 1;
12324: }
1.984 raeburn 12325: }
1.987 raeburn 12326: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 12327: if (opendir(my $dir,$url)) {
1.987 raeburn 12328: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 12329: map {$currfile{$_} = 1;} @dir_list;
12330: }
1.1075.2.11 raeburn 12331: } elsif (($actionurl eq '/adm/dependencies') ||
12332: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 12333: ($args->{'context'} eq 'paste')) ||
12334: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 12335: if ($env{'request.course.id'} ne '') {
12336: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
12337: if ($dir ne '') {
12338: my ($dirlistref,$listerror) =
12339: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
12340: if (ref($dirlistref) eq 'ARRAY') {
12341: foreach my $line (@{$dirlistref}) {
12342: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
12343: $size,undef,$mtime)=split(/\&/,$line,12);
12344: unless (($testdir&$dirptr) ||
12345: ($file_name =~ /^\.\.?$/)) {
12346: $currfile{$file_name} = [$size,$mtime];
12347: }
12348: }
12349: }
12350: }
12351: }
1.984 raeburn 12352: }
12353: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 12354: if (exists($currfile{$file})) {
1.987 raeburn 12355: unless ($mapping{$file} eq $file) {
12356: $pathchanges{$file} = 1;
12357: }
12358: $existing{$file} = 1;
12359: $numexisting ++;
12360: } else {
1.984 raeburn 12361: $newfiles{$file} = 1;
12362: }
12363: }
1.1071 raeburn 12364: foreach my $file (keys(%currfile)) {
12365: unless (($file eq $filename) ||
12366: ($file eq $filename.'.bak') ||
12367: ($dependencies{$file})) {
1.1075.2.11 raeburn 12368: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 12369: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
12370: next if (($rem ne '') &&
12371: (($env{"httpref.$rem".$file} ne '') ||
12372: (ref($navmap) &&
12373: (($navmap->getResourceByUrl($rem.$file) ne '') ||
12374: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
12375: ($navmap->getResourceByUrl($rem.$1)))))));
12376: }
1.1075.2.11 raeburn 12377: }
1.1071 raeburn 12378: $unused{$file} = 1;
12379: }
12380: }
1.1075.2.11 raeburn 12381: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
12382: ($args->{'context'} eq 'paste')) {
12383: $counter = scalar(keys(%existing));
12384: $numpathchg = scalar(keys(%pathchanges));
12385: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 12386: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
12387: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
12388: $counter = scalar(keys(%existing));
12389: $numpathchg = scalar(keys(%pathchanges));
12390: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 12391: }
1.984 raeburn 12392: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 12393: if ($actionurl eq '/adm/dependencies') {
12394: next if ($embed_file =~ m{^\w+://});
12395: }
1.660 raeburn 12396: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 12397: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 12398: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 12399: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 12400: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
12401: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 12402: }
1.1075.2.35 raeburn 12403: $upload_output .= '</td>';
1.1071 raeburn 12404: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 12405: $upload_output.='<td align="right">'.
12406: '<span class="LC_info LC_fontsize_medium">'.
12407: &mt("URL points to web address").'</span>';
1.987 raeburn 12408: $numremref++;
1.660 raeburn 12409: } elsif ($args->{'error_on_invalid_names'}
12410: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 12411: $upload_output.='<td align="right"><span class="LC_warning">'.
12412: &mt('Invalid characters').'</span>';
1.987 raeburn 12413: $numinvalid++;
1.660 raeburn 12414: } else {
1.1075.2.35 raeburn 12415: $upload_output .= '<td>'.
12416: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 12417: $embed_file,\%mapping,
1.1071 raeburn 12418: $allfiles,$codebase,'upload');
12419: $counter ++;
12420: $numnew ++;
1.987 raeburn 12421: }
12422: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
12423: }
12424: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 12425: if ($actionurl eq '/adm/dependencies') {
12426: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
12427: $modify_output .= &start_data_table_row().
12428: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
12429: '<img src="'.&icon($embed_file).'" border="0" />'.
12430: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
12431: '<td>'.$size.'</td>'.
12432: '<td>'.$mtime.'</td>'.
12433: '<td><label><input type="checkbox" name="mod_upload_dep" '.
12434: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
12435: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
12436: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
12437: &embedded_file_element('upload_embedded',$counter,
12438: $embed_file,\%mapping,
12439: $allfiles,$codebase,'modify').
12440: '</div></td>'.
12441: &end_data_table_row()."\n";
12442: $counter ++;
12443: } else {
12444: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 12445: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
12446: '<span class="LC_filename">'.$embed_file.'</span></td>'.
12447: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 12448: &Apache::loncommon::end_data_table_row()."\n";
12449: }
12450: }
12451: my $delidx = $counter;
12452: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
12453: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
12454: $delete_output .= &start_data_table_row().
12455: '<td><img src="'.&icon($oldfile).'" />'.
12456: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
12457: '<td>'.$size.'</td>'.
12458: '<td>'.$mtime.'</td>'.
12459: '<td><label><input type="checkbox" name="del_upload_dep" '.
12460: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
12461: &embedded_file_element('upload_embedded',$delidx,
12462: $oldfile,\%mapping,$allfiles,
12463: $codebase,'delete').'</td>'.
12464: &end_data_table_row()."\n";
12465: $numunused ++;
12466: $delidx ++;
1.987 raeburn 12467: }
12468: if ($upload_output) {
12469: $upload_output = &start_data_table().
12470: $upload_output.
12471: &end_data_table()."\n";
12472: }
1.1071 raeburn 12473: if ($modify_output) {
12474: $modify_output = &start_data_table().
12475: &start_data_table_header_row().
12476: '<th>'.&mt('File').'</th>'.
12477: '<th>'.&mt('Size (KB)').'</th>'.
12478: '<th>'.&mt('Modified').'</th>'.
12479: '<th>'.&mt('Upload replacement?').'</th>'.
12480: &end_data_table_header_row().
12481: $modify_output.
12482: &end_data_table()."\n";
12483: }
12484: if ($delete_output) {
12485: $delete_output = &start_data_table().
12486: &start_data_table_header_row().
12487: '<th>'.&mt('File').'</th>'.
12488: '<th>'.&mt('Size (KB)').'</th>'.
12489: '<th>'.&mt('Modified').'</th>'.
12490: '<th>'.&mt('Delete?').'</th>'.
12491: &end_data_table_header_row().
12492: $delete_output.
12493: &end_data_table()."\n";
12494: }
1.987 raeburn 12495: my $applies = 0;
12496: if ($numremref) {
12497: $applies ++;
12498: }
12499: if ($numinvalid) {
12500: $applies ++;
12501: }
12502: if ($numexisting) {
12503: $applies ++;
12504: }
1.1071 raeburn 12505: if ($counter || $numunused) {
1.987 raeburn 12506: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
12507: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 12508: $state.'<h3>'.$heading.'</h3>';
12509: if ($actionurl eq '/adm/dependencies') {
12510: if ($numnew) {
12511: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
12512: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
12513: $upload_output.'<br />'."\n";
12514: }
12515: if ($numexisting) {
12516: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
12517: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
12518: $modify_output.'<br />'."\n";
12519: $buttontext = &mt('Save changes');
12520: }
12521: if ($numunused) {
12522: $output .= '<h4>'.&mt('Unused files').'</h4>'.
12523: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
12524: $delete_output.'<br />'."\n";
12525: $buttontext = &mt('Save changes');
12526: }
12527: } else {
12528: $output .= $upload_output.'<br />'."\n";
12529: }
12530: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
12531: $counter.'" />'."\n";
12532: if ($actionurl eq '/adm/dependencies') {
12533: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
12534: $numnew.'" />'."\n";
12535: } elsif ($actionurl eq '') {
1.987 raeburn 12536: $output .= '<input type="hidden" name="phase" value="three" />';
12537: }
12538: } elsif ($applies) {
12539: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
12540: if ($applies > 1) {
12541: $output .=
1.1075.2.35 raeburn 12542: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 12543: if ($numremref) {
12544: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
12545: }
12546: if ($numinvalid) {
12547: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
12548: }
12549: if ($numexisting) {
12550: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
12551: }
12552: $output .= '</ul><br />';
12553: } elsif ($numremref) {
12554: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
12555: } elsif ($numinvalid) {
12556: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
12557: } elsif ($numexisting) {
12558: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
12559: }
12560: $output .= $upload_output.'<br />';
12561: }
12562: my ($pathchange_output,$chgcount);
1.1071 raeburn 12563: $chgcount = $counter;
1.987 raeburn 12564: if (keys(%pathchanges) > 0) {
12565: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 12566: if ($counter) {
1.987 raeburn 12567: $output .= &embedded_file_element('pathchange',$chgcount,
12568: $embed_file,\%mapping,
1.1071 raeburn 12569: $allfiles,$codebase,'change');
1.987 raeburn 12570: } else {
12571: $pathchange_output .=
12572: &start_data_table_row().
12573: '<td><input type ="checkbox" name="namechange" value="'.
12574: $chgcount.'" checked="checked" /></td>'.
12575: '<td>'.$mapping{$embed_file}.'</td>'.
12576: '<td>'.$embed_file.
12577: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 12578: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 12579: '</td>'.&end_data_table_row();
1.660 raeburn 12580: }
1.987 raeburn 12581: $numpathchg ++;
12582: $chgcount ++;
1.660 raeburn 12583: }
12584: }
1.1075.2.35 raeburn 12585: if (($counter) || ($numunused)) {
1.987 raeburn 12586: if ($numpathchg) {
12587: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
12588: $numpathchg.'" />'."\n";
12589: }
12590: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
12591: ($actionurl eq '/adm/imsimport')) {
12592: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
12593: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
12594: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 12595: } elsif ($actionurl eq '/adm/dependencies') {
12596: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 12597: }
1.1075.2.35 raeburn 12598: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 12599: } elsif ($numpathchg) {
12600: my %pathchange = ();
12601: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
12602: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12603: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 12604: }
1.987 raeburn 12605: }
1.1071 raeburn 12606: return ($output,$counter,$numpathchg);
1.987 raeburn 12607: }
12608:
1.1075.2.47 raeburn 12609: =pod
12610:
12611: =item * clean_path($name)
12612:
12613: Performs clean-up of directories, subdirectories and filename in an
12614: embedded object, referenced in an HTML file which is being uploaded
12615: to a course or portfolio, where
12616: "Upload embedded images/multimedia files if HTML file" checkbox was
12617: checked.
12618:
12619: Clean-up is similar to replacements in lonnet::clean_filename()
12620: except each / between sub-directory and next level is preserved.
12621:
12622: =cut
12623:
12624: sub clean_path {
12625: my ($embed_file) = @_;
12626: $embed_file =~s{^/+}{};
12627: my @contents;
12628: if ($embed_file =~ m{/}) {
12629: @contents = split(/\//,$embed_file);
12630: } else {
12631: @contents = ($embed_file);
12632: }
12633: my $lastidx = scalar(@contents)-1;
12634: for (my $i=0; $i<=$lastidx; $i++) {
12635: $contents[$i]=~s{\\}{/}g;
12636: $contents[$i]=~s/\s+/\_/g;
12637: $contents[$i]=~s{[^/\w\.\-]}{}g;
12638: if ($i == $lastidx) {
12639: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
12640: }
12641: }
12642: if ($lastidx > 0) {
12643: return join('/',@contents);
12644: } else {
12645: return $contents[0];
12646: }
12647: }
12648:
1.987 raeburn 12649: sub embedded_file_element {
1.1071 raeburn 12650: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 12651: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
12652: (ref($codebase) eq 'HASH'));
12653: my $output;
1.1071 raeburn 12654: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 12655: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
12656: }
12657: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
12658: &escape($embed_file).'" />';
12659: unless (($context eq 'upload_embedded') &&
12660: ($mapping->{$embed_file} eq $embed_file)) {
12661: $output .='
12662: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
12663: }
12664: my $attrib;
12665: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
12666: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
12667: }
12668: $output .=
12669: "\n\t\t".
12670: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
12671: $attrib.'" />';
12672: if (exists($codebase->{$mapping->{$embed_file}})) {
12673: $output .=
12674: "\n\t\t".
12675: '<input name="codebase_'.$num.'" type="hidden" value="'.
12676: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 12677: }
1.987 raeburn 12678: return $output;
1.660 raeburn 12679: }
12680:
1.1071 raeburn 12681: sub get_dependency_details {
12682: my ($currfile,$currsubfile,$embed_file) = @_;
12683: my ($size,$mtime,$showsize,$showmtime);
12684: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
12685: if ($embed_file =~ m{/}) {
12686: my ($path,$fname) = split(/\//,$embed_file);
12687: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
12688: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
12689: }
12690: } else {
12691: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
12692: ($size,$mtime) = @{$currfile->{$embed_file}};
12693: }
12694: }
12695: $showsize = $size/1024.0;
12696: $showsize = sprintf("%.1f",$showsize);
12697: if ($mtime > 0) {
12698: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
12699: }
12700: }
12701: return ($showsize,$showmtime);
12702: }
12703:
12704: sub ask_embedded_js {
12705: return <<"END";
12706: <script type="text/javascript"">
12707: // <![CDATA[
12708: function toggleBrowse(counter) {
12709: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
12710: var fileid = document.getElementById('embedded_item_'+counter);
12711: var uploaddivid = document.getElementById('moduploaddep_'+counter);
12712: if (chkboxid.checked == true) {
12713: uploaddivid.style.display='block';
12714: } else {
12715: uploaddivid.style.display='none';
12716: fileid.value = '';
12717: }
12718: }
12719: // ]]>
12720: </script>
12721:
12722: END
12723: }
12724:
1.661 raeburn 12725: sub upload_embedded {
12726: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 12727: $current_disk_usage,$hiddenstate,$actionurl) = @_;
12728: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 12729: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
12730: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
12731: my $orig_uploaded_filename =
12732: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 12733: foreach my $type ('orig','ref','attrib','codebase') {
12734: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
12735: $env{'form.embedded_'.$type.'_'.$i} =
12736: &unescape($env{'form.embedded_'.$type.'_'.$i});
12737: }
12738: }
1.661 raeburn 12739: my ($path,$fname) =
12740: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
12741: # no path, whole string is fname
12742: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
12743: $fname = &Apache::lonnet::clean_filename($fname);
12744: # See if there is anything left
12745: next if ($fname eq '');
12746:
12747: # Check if file already exists as a file or directory.
12748: my ($state,$msg);
12749: if ($context eq 'portfolio') {
12750: my $port_path = $dirpath;
12751: if ($group ne '') {
12752: $port_path = "groups/$group/$port_path";
12753: }
1.987 raeburn 12754: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
12755: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 12756: $dir_root,$port_path,$disk_quota,
12757: $current_disk_usage,$uname,$udom);
12758: if ($state eq 'will_exceed_quota'
1.984 raeburn 12759: || $state eq 'file_locked') {
1.661 raeburn 12760: $output .= $msg;
12761: next;
12762: }
12763: } elsif (($context eq 'author') || ($context eq 'testbank')) {
12764: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
12765: if ($state eq 'exists') {
12766: $output .= $msg;
12767: next;
12768: }
12769: }
12770: # Check if extension is valid
12771: if (($fname =~ /\.(\w+)$/) &&
12772: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 12773: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
12774: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 12775: next;
12776: } elsif (($fname =~ /\.(\w+)$/) &&
12777: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 12778: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 12779: next;
12780: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 12781: $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 12782: next;
12783: }
12784: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 12785: my $subdir = $path;
12786: $subdir =~ s{/+$}{};
1.661 raeburn 12787: if ($context eq 'portfolio') {
1.984 raeburn 12788: my $result;
12789: if ($state eq 'existingfile') {
12790: $result=
12791: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 12792: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 12793: } else {
1.984 raeburn 12794: $result=
12795: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 12796: $dirpath.
1.1075.2.35 raeburn 12797: $env{'form.currentpath'}.$subdir);
1.984 raeburn 12798: if ($result !~ m|^/uploaded/|) {
12799: $output .= '<span class="LC_error">'
12800: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12801: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12802: .'</span><br />';
12803: next;
12804: } else {
1.987 raeburn 12805: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12806: $path.$fname.'</span>').'<br />';
1.984 raeburn 12807: }
1.661 raeburn 12808: }
1.1075.2.35 raeburn 12809: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
12810: my $extendedsubdir = $dirpath.'/'.$subdir;
12811: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 12812: my $result =
1.1075.2.35 raeburn 12813: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 12814: if ($result !~ m|^/uploaded/|) {
12815: $output .= '<span class="LC_error">'
12816: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
12817: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
12818: .'</span><br />';
12819: next;
12820: } else {
12821: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12822: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 12823: if ($context eq 'syllabus') {
12824: &Apache::lonnet::make_public_indefinitely($result);
12825: }
1.987 raeburn 12826: }
1.661 raeburn 12827: } else {
12828: # Save the file
12829: my $target = $env{'form.embedded_item_'.$i};
12830: my $fullpath = $dir_root.$dirpath.'/'.$path;
12831: my $dest = $fullpath.$fname;
12832: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 12833: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 12834: my $count;
12835: my $filepath = $dir_root;
1.1027 raeburn 12836: foreach my $subdir (@parts) {
12837: $filepath .= "/$subdir";
12838: if (!-e $filepath) {
1.661 raeburn 12839: mkdir($filepath,0770);
12840: }
12841: }
12842: my $fh;
12843: if (!open($fh,'>'.$dest)) {
12844: &Apache::lonnet::logthis('Failed to create '.$dest);
12845: $output .= '<span class="LC_error">'.
1.1071 raeburn 12846: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
12847: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12848: '</span><br />';
12849: } else {
12850: if (!print $fh $env{'form.embedded_item_'.$i}) {
12851: &Apache::lonnet::logthis('Failed to write to '.$dest);
12852: $output .= '<span class="LC_error">'.
1.1071 raeburn 12853: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
12854: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 12855: '</span><br />';
12856: } else {
1.987 raeburn 12857: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
12858: $url.'</span>').'<br />';
12859: unless ($context eq 'testbank') {
12860: $footer .= &mt('View embedded file: [_1]',
12861: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
12862: }
12863: }
12864: close($fh);
12865: }
12866: }
12867: if ($env{'form.embedded_ref_'.$i}) {
12868: $pathchange{$i} = 1;
12869: }
12870: }
12871: if ($output) {
12872: $output = '<p>'.$output.'</p>';
12873: }
12874: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
12875: $returnflag = 'ok';
1.1071 raeburn 12876: my $numpathchgs = scalar(keys(%pathchange));
12877: if ($numpathchgs > 0) {
1.987 raeburn 12878: if ($context eq 'portfolio') {
12879: $output .= '<p>'.&mt('or').'</p>';
12880: } elsif ($context eq 'testbank') {
1.1071 raeburn 12881: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
12882: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 12883: $returnflag = 'modify_orightml';
12884: }
12885: }
1.1071 raeburn 12886: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 12887: }
12888:
12889: sub modify_html_form {
12890: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
12891: my $end = 0;
12892: my $modifyform;
12893: if ($context eq 'upload_embedded') {
12894: return unless (ref($pathchange) eq 'HASH');
12895: if ($env{'form.number_embedded_items'}) {
12896: $end += $env{'form.number_embedded_items'};
12897: }
12898: if ($env{'form.number_pathchange_items'}) {
12899: $end += $env{'form.number_pathchange_items'};
12900: }
12901: if ($end) {
12902: for (my $i=0; $i<$end; $i++) {
12903: if ($i < $env{'form.number_embedded_items'}) {
12904: next unless($pathchange->{$i});
12905: }
12906: $modifyform .=
12907: &start_data_table_row().
12908: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
12909: 'checked="checked" /></td>'.
12910: '<td>'.$env{'form.embedded_ref_'.$i}.
12911: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
12912: &escape($env{'form.embedded_ref_'.$i}).'" />'.
12913: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
12914: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
12915: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
12916: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
12917: '<td>'.$env{'form.embedded_orig_'.$i}.
12918: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
12919: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
12920: &end_data_table_row();
1.1071 raeburn 12921: }
1.987 raeburn 12922: }
12923: } else {
12924: $modifyform = $pathchgtable;
12925: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
12926: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
12927: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
12928: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
12929: }
12930: }
12931: if ($modifyform) {
1.1071 raeburn 12932: if ($actionurl eq '/adm/dependencies') {
12933: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
12934: }
1.987 raeburn 12935: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
12936: '<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".
12937: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
12938: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
12939: '</ol></p>'."\n".'<p>'.
12940: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
12941: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
12942: &start_data_table()."\n".
12943: &start_data_table_header_row().
12944: '<th>'.&mt('Change?').'</th>'.
12945: '<th>'.&mt('Current reference').'</th>'.
12946: '<th>'.&mt('Required reference').'</th>'.
12947: &end_data_table_header_row()."\n".
12948: $modifyform.
12949: &end_data_table().'<br />'."\n".$hiddenstate.
12950: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
12951: '</form>'."\n";
12952: }
12953: return;
12954: }
12955:
12956: sub modify_html_refs {
1.1075.2.35 raeburn 12957: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 12958: my $container;
12959: if ($context eq 'portfolio') {
12960: $container = $env{'form.container'};
12961: } elsif ($context eq 'coursedoc') {
12962: $container = $env{'form.primaryurl'};
1.1071 raeburn 12963: } elsif ($context eq 'manage_dependencies') {
12964: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
12965: $container = "/$container";
1.1075.2.35 raeburn 12966: } elsif ($context eq 'syllabus') {
12967: $container = $url;
1.987 raeburn 12968: } else {
1.1027 raeburn 12969: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 12970: }
12971: my (%allfiles,%codebase,$output,$content);
12972: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 12973: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 12974: if (wantarray) {
12975: return ('',0,0);
12976: } else {
12977: return;
12978: }
12979: }
12980: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 12981: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 12982: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
12983: if (wantarray) {
12984: return ('',0,0);
12985: } else {
12986: return;
12987: }
12988: }
1.987 raeburn 12989: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 12990: if ($content eq '-1') {
12991: if (wantarray) {
12992: return ('',0,0);
12993: } else {
12994: return;
12995: }
12996: }
1.987 raeburn 12997: } else {
1.1071 raeburn 12998: unless ($container =~ /^\Q$dir_root\E/) {
12999: if (wantarray) {
13000: return ('',0,0);
13001: } else {
13002: return;
13003: }
13004: }
1.1075.2.128 raeburn 13005: if (open(my $fh,'<',$container)) {
1.987 raeburn 13006: $content = join('', <$fh>);
13007: close($fh);
13008: } else {
1.1071 raeburn 13009: if (wantarray) {
13010: return ('',0,0);
13011: } else {
13012: return;
13013: }
1.987 raeburn 13014: }
13015: }
13016: my ($count,$codebasecount) = (0,0);
13017: my $mm = new File::MMagic;
13018: my $mime_type = $mm->checktype_contents($content);
13019: if ($mime_type eq 'text/html') {
13020: my $parse_result =
13021: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
13022: \%codebase,\$content);
13023: if ($parse_result eq 'ok') {
13024: foreach my $i (@changes) {
13025: my $orig = &unescape($env{'form.embedded_orig_'.$i});
13026: my $ref = &unescape($env{'form.embedded_ref_'.$i});
13027: if ($allfiles{$ref}) {
13028: my $newname = $orig;
13029: my ($attrib_regexp,$codebase);
1.1006 raeburn 13030: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 13031: if ($attrib_regexp =~ /:/) {
13032: $attrib_regexp =~ s/\:/|/g;
13033: }
13034: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13035: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13036: $count += $numchg;
1.1075.2.35 raeburn 13037: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 13038: delete($allfiles{$ref});
1.987 raeburn 13039: }
13040: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 13041: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 13042: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
13043: $codebasecount ++;
13044: }
13045: }
13046: }
1.1075.2.35 raeburn 13047: my $skiprewrites;
1.987 raeburn 13048: if ($count || $codebasecount) {
13049: my $saveresult;
1.1071 raeburn 13050: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 13051: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 13052: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13053: if ($url eq $container) {
13054: my ($fname) = ($container =~ m{/([^/]+)$});
13055: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13056: $count,'<span class="LC_filename">'.
1.1071 raeburn 13057: $fname.'</span>').'</p>';
1.987 raeburn 13058: } else {
13059: $output = '<p class="LC_error">'.
13060: &mt('Error: update failed for: [_1].',
13061: '<span class="LC_filename">'.
13062: $container.'</span>').'</p>';
13063: }
1.1075.2.35 raeburn 13064: if ($context eq 'syllabus') {
13065: unless ($saveresult eq 'ok') {
13066: $skiprewrites = 1;
13067: }
13068: }
1.987 raeburn 13069: } else {
1.1075.2.128 raeburn 13070: if (open(my $fh,'>',$container)) {
1.987 raeburn 13071: print $fh $content;
13072: close($fh);
13073: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
13074: $count,'<span class="LC_filename">'.
13075: $container.'</span>').'</p>';
1.661 raeburn 13076: } else {
1.987 raeburn 13077: $output = '<p class="LC_error">'.
13078: &mt('Error: could not update [_1].',
13079: '<span class="LC_filename">'.
13080: $container.'</span>').'</p>';
1.661 raeburn 13081: }
13082: }
13083: }
1.1075.2.35 raeburn 13084: if (($context eq 'syllabus') && (!$skiprewrites)) {
13085: my ($actionurl,$state);
13086: $actionurl = "/public/$udom/$uname/syllabus";
13087: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
13088: &ask_for_embedded_content($actionurl,$state,\%allfiles,
13089: \%codebase,
13090: {'context' => 'rewrites',
13091: 'ignore_remote_references' => 1,});
13092: if (ref($mapping) eq 'HASH') {
13093: my $rewrites = 0;
13094: foreach my $key (keys(%{$mapping})) {
13095: next if ($key =~ m{^https?://});
13096: my $ref = $mapping->{$key};
13097: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
13098: my $attrib;
13099: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
13100: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
13101: }
13102: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
13103: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
13104: $rewrites += $numchg;
13105: }
13106: }
13107: if ($rewrites) {
13108: my $saveresult;
13109: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
13110: if ($url eq $container) {
13111: my ($fname) = ($container =~ m{/([^/]+)$});
13112: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
13113: $count,'<span class="LC_filename">'.
13114: $fname.'</span>').'</p>';
13115: } else {
13116: $output .= '<p class="LC_error">'.
13117: &mt('Error: could not update links in [_1].',
13118: '<span class="LC_filename">'.
13119: $container.'</span>').'</p>';
13120:
13121: }
13122: }
13123: }
13124: }
1.987 raeburn 13125: } else {
13126: &logthis('Failed to parse '.$container.
13127: ' to modify references: '.$parse_result);
1.661 raeburn 13128: }
13129: }
1.1071 raeburn 13130: if (wantarray) {
13131: return ($output,$count,$codebasecount);
13132: } else {
13133: return $output;
13134: }
1.661 raeburn 13135: }
13136:
13137: sub check_for_existing {
13138: my ($path,$fname,$element) = @_;
13139: my ($state,$msg);
13140: if (-d $path.'/'.$fname) {
13141: $state = 'exists';
13142: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13143: } elsif (-e $path.'/'.$fname) {
13144: $state = 'exists';
13145: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
13146: }
13147: if ($state eq 'exists') {
13148: $msg = '<span class="LC_error">'.$msg.'</span><br />';
13149: }
13150: return ($state,$msg);
13151: }
13152:
13153: sub check_for_upload {
13154: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
13155: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 13156: my $filesize = length($env{'form.'.$element});
13157: if (!$filesize) {
13158: my $msg = '<span class="LC_error">'.
13159: &mt('Unable to upload [_1]. (size = [_2] bytes)',
13160: '<span class="LC_filename">'.$fname.'</span>',
13161: $filesize).'<br />'.
1.1007 raeburn 13162: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 13163: '</span>';
13164: return ('zero_bytes',$msg);
13165: }
13166: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 13167: my $getpropath = 1;
1.1021 raeburn 13168: my ($dirlistref,$listerror) =
13169: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 13170: my $found_file = 0;
13171: my $locked_file = 0;
1.991 raeburn 13172: my @lockers;
13173: my $navmap;
13174: if ($env{'request.course.id'}) {
13175: $navmap = Apache::lonnavmaps::navmap->new();
13176: }
1.1021 raeburn 13177: if (ref($dirlistref) eq 'ARRAY') {
13178: foreach my $line (@{$dirlistref}) {
13179: my ($file_name,$rest)=split(/\&/,$line,2);
13180: if ($file_name eq $fname){
13181: $file_name = $path.$file_name;
13182: if ($group ne '') {
13183: $file_name = $group.$file_name;
13184: }
13185: $found_file = 1;
13186: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
13187: foreach my $lock (@lockers) {
13188: if (ref($lock) eq 'ARRAY') {
13189: my ($symb,$crsid) = @{$lock};
13190: if ($crsid eq $env{'request.course.id'}) {
13191: if (ref($navmap)) {
13192: my $res = $navmap->getBySymb($symb);
13193: foreach my $part (@{$res->parts()}) {
13194: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
13195: unless (($slot_status == $res->RESERVED) ||
13196: ($slot_status == $res->RESERVED_LOCATION)) {
13197: $locked_file = 1;
13198: }
1.991 raeburn 13199: }
1.1021 raeburn 13200: } else {
13201: $locked_file = 1;
1.991 raeburn 13202: }
13203: } else {
13204: $locked_file = 1;
13205: }
13206: }
1.1021 raeburn 13207: }
13208: } else {
13209: my @info = split(/\&/,$rest);
13210: my $currsize = $info[6]/1000;
13211: if ($currsize < $filesize) {
13212: my $extra = $filesize - $currsize;
13213: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 13214: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 13215: &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.1075.2.69 raeburn 13216: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
13217: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
13218: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 13219: return ('will_exceed_quota',$msg);
13220: }
1.984 raeburn 13221: }
13222: }
1.661 raeburn 13223: }
13224: }
13225: }
13226: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 13227: my $msg = '<p class="LC_warning">'.
13228: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
13229: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 13230: return ('will_exceed_quota',$msg);
13231: } elsif ($found_file) {
13232: if ($locked_file) {
1.1075.2.69 raeburn 13233: my $msg = '<p class="LC_warning">';
1.661 raeburn 13234: $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.1075.2.69 raeburn 13235: $msg .= '</p>';
1.661 raeburn 13236: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
13237: return ('file_locked',$msg);
13238: } else {
1.1075.2.69 raeburn 13239: my $msg = '<p class="LC_error">';
1.984 raeburn 13240: $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1075.2.69 raeburn 13241: $msg .= '</p>';
1.984 raeburn 13242: return ('existingfile',$msg);
1.661 raeburn 13243: }
13244: }
13245: }
13246:
1.987 raeburn 13247: sub check_for_traversal {
13248: my ($path,$url,$toplevel) = @_;
13249: my @parts=split(/\//,$path);
13250: my $cleanpath;
13251: my $fullpath = $url;
13252: for (my $i=0;$i<@parts;$i++) {
13253: next if ($parts[$i] eq '.');
13254: if ($parts[$i] eq '..') {
13255: $fullpath =~ s{([^/]+/)$}{};
13256: } else {
13257: $fullpath .= $parts[$i].'/';
13258: }
13259: }
13260: if ($fullpath =~ /^\Q$url\E(.*)$/) {
13261: $cleanpath = $1;
13262: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
13263: my $curr_toprel = $1;
13264: my @parts = split(/\//,$curr_toprel);
13265: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
13266: my @urlparts = split(/\//,$url_toprel);
13267: my $doubledots;
13268: my $startdiff = -1;
13269: for (my $i=0; $i<@urlparts; $i++) {
13270: if ($startdiff == -1) {
13271: unless ($urlparts[$i] eq $parts[$i]) {
13272: $startdiff = $i;
13273: $doubledots .= '../';
13274: }
13275: } else {
13276: $doubledots .= '../';
13277: }
13278: }
13279: if ($startdiff > -1) {
13280: $cleanpath = $doubledots;
13281: for (my $i=$startdiff; $i<@parts; $i++) {
13282: $cleanpath .= $parts[$i].'/';
13283: }
13284: }
13285: }
13286: $cleanpath =~ s{(/)$}{};
13287: return $cleanpath;
13288: }
1.31 albertel 13289:
1.1053 raeburn 13290: sub is_archive_file {
13291: my ($mimetype) = @_;
13292: if (($mimetype eq 'application/octet-stream') ||
13293: ($mimetype eq 'application/x-stuffit') ||
13294: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
13295: return 1;
13296: }
13297: return;
13298: }
13299:
13300: sub decompress_form {
1.1065 raeburn 13301: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 13302: my %lt = &Apache::lonlocal::texthash (
13303: this => 'This file is an archive file.',
1.1067 raeburn 13304: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 13305: itsc => 'Its contents are as follows:',
1.1053 raeburn 13306: youm => 'You may wish to extract its contents.',
13307: extr => 'Extract contents',
1.1067 raeburn 13308: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
13309: proa => 'Process automatically?',
1.1053 raeburn 13310: yes => 'Yes',
13311: no => 'No',
1.1067 raeburn 13312: fold => 'Title for folder containing movie',
13313: movi => 'Title for page containing embedded movie',
1.1053 raeburn 13314: );
1.1065 raeburn 13315: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 13316: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 13317: my $info = &list_archive_contents($fileloc,\@paths);
13318: if (@paths) {
13319: foreach my $path (@paths) {
13320: $path =~ s{^/}{};
1.1067 raeburn 13321: if ($path =~ m{^([^/]+)/$}) {
13322: $topdir = $1;
13323: }
1.1065 raeburn 13324: if ($path =~ m{^([^/]+)/}) {
13325: $toplevel{$1} = $path;
13326: } else {
13327: $toplevel{$path} = $path;
13328: }
13329: }
13330: }
1.1067 raeburn 13331: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 13332: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 13333: "$topdir/media/",
13334: "$topdir/media/$topdir.mp4",
13335: "$topdir/media/FirstFrame.png",
13336: "$topdir/media/player.swf",
13337: "$topdir/media/swfobject.js",
13338: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 13339: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 13340: "$topdir/$topdir.mp4",
13341: "$topdir/$topdir\_config.xml",
13342: "$topdir/$topdir\_controller.swf",
13343: "$topdir/$topdir\_embed.css",
13344: "$topdir/$topdir\_First_Frame.png",
13345: "$topdir/$topdir\_player.html",
13346: "$topdir/$topdir\_Thumbnails.png",
13347: "$topdir/playerProductInstall.swf",
13348: "$topdir/scripts/",
13349: "$topdir/scripts/config_xml.js",
13350: "$topdir/scripts/handlebars.js",
13351: "$topdir/scripts/jquery-1.7.1.min.js",
13352: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
13353: "$topdir/scripts/modernizr.js",
13354: "$topdir/scripts/player-min.js",
13355: "$topdir/scripts/swfobject.js",
13356: "$topdir/skins/",
13357: "$topdir/skins/configuration_express.xml",
13358: "$topdir/skins/express_show/",
13359: "$topdir/skins/express_show/player-min.css",
13360: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 13361: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
13362: "$topdir/$topdir.mp4",
13363: "$topdir/$topdir\_config.xml",
13364: "$topdir/$topdir\_controller.swf",
13365: "$topdir/$topdir\_embed.css",
13366: "$topdir/$topdir\_First_Frame.png",
13367: "$topdir/$topdir\_player.html",
13368: "$topdir/$topdir\_Thumbnails.png",
13369: "$topdir/playerProductInstall.swf",
13370: "$topdir/scripts/",
13371: "$topdir/scripts/config_xml.js",
13372: "$topdir/scripts/techsmith-smart-player.min.js",
13373: "$topdir/skins/",
13374: "$topdir/skins/configuration_express.xml",
13375: "$topdir/skins/express_show/",
13376: "$topdir/skins/express_show/spritesheet.min.css",
13377: "$topdir/skins/express_show/spritesheet.png",
13378: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 13379: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 13380: if (@diffs == 0) {
1.1075.2.59 raeburn 13381: $is_camtasia = 6;
13382: } else {
1.1075.2.81 raeburn 13383: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 13384: if (@diffs == 0) {
13385: $is_camtasia = 8;
1.1075.2.81 raeburn 13386: } else {
13387: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
13388: if (@diffs == 0) {
13389: $is_camtasia = 8;
13390: }
1.1075.2.59 raeburn 13391: }
1.1067 raeburn 13392: }
13393: }
13394: my $output;
13395: if ($is_camtasia) {
13396: $output = <<"ENDCAM";
13397: <script type="text/javascript" language="Javascript">
13398: // <![CDATA[
13399:
13400: function camtasiaToggle() {
13401: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
13402: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 13403: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 13404: document.getElementById('camtasia_titles').style.display='block';
13405: } else {
13406: document.getElementById('camtasia_titles').style.display='none';
13407: }
13408: }
13409: }
13410: return;
13411: }
13412:
13413: // ]]>
13414: </script>
13415: <p>$lt{'camt'}</p>
13416: ENDCAM
1.1065 raeburn 13417: } else {
1.1067 raeburn 13418: $output = '<p>'.$lt{'this'};
13419: if ($info eq '') {
13420: $output .= ' '.$lt{'youm'}.'</p>'."\n";
13421: } else {
13422: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
13423: '<div><pre>'.$info.'</pre></div>';
13424: }
1.1065 raeburn 13425: }
1.1067 raeburn 13426: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 13427: my $duplicates;
13428: my $num = 0;
13429: if (ref($dirlist) eq 'ARRAY') {
13430: foreach my $item (@{$dirlist}) {
13431: if (ref($item) eq 'ARRAY') {
13432: if (exists($toplevel{$item->[0]})) {
13433: $duplicates .=
13434: &start_data_table_row().
13435: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
13436: 'value="0" checked="checked" />'.&mt('No').'</label>'.
13437: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
13438: 'value="1" />'.&mt('Yes').'</label>'.
13439: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
13440: '<td>'.$item->[0].'</td>';
13441: if ($item->[2]) {
13442: $duplicates .= '<td>'.&mt('Directory').'</td>';
13443: } else {
13444: $duplicates .= '<td>'.&mt('File').'</td>';
13445: }
13446: $duplicates .= '<td>'.$item->[3].'</td>'.
13447: '<td>'.
13448: &Apache::lonlocal::locallocaltime($item->[4]).
13449: '</td>'.
13450: &end_data_table_row();
13451: $num ++;
13452: }
13453: }
13454: }
13455: }
13456: my $itemcount;
13457: if (@paths > 0) {
13458: $itemcount = scalar(@paths);
13459: } else {
13460: $itemcount = 1;
13461: }
1.1067 raeburn 13462: if ($is_camtasia) {
13463: $output .= $lt{'auto'}.'<br />'.
13464: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 13465: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 13466: $lt{'yes'}.'</label> <label>'.
13467: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
13468: $lt{'no'}.'</label></span><br />'.
13469: '<div id="camtasia_titles" style="display:block">'.
13470: &Apache::lonhtmlcommon::start_pick_box().
13471: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
13472: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
13473: &Apache::lonhtmlcommon::row_closure().
13474: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
13475: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
13476: &Apache::lonhtmlcommon::row_closure(1).
13477: &Apache::lonhtmlcommon::end_pick_box().
13478: '</div>';
13479: }
1.1065 raeburn 13480: $output .=
13481: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 13482: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
13483: "\n";
1.1065 raeburn 13484: if ($duplicates ne '') {
13485: $output .= '<p><span class="LC_warning">'.
13486: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
13487: &start_data_table().
13488: &start_data_table_header_row().
13489: '<th>'.&mt('Overwrite?').'</th>'.
13490: '<th>'.&mt('Name').'</th>'.
13491: '<th>'.&mt('Type').'</th>'.
13492: '<th>'.&mt('Size').'</th>'.
13493: '<th>'.&mt('Last modified').'</th>'.
13494: &end_data_table_header_row().
13495: $duplicates.
13496: &end_data_table().
13497: '</p>';
13498: }
1.1067 raeburn 13499: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 13500: if (ref($hiddenelements) eq 'HASH') {
13501: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
13502: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
13503: }
13504: }
13505: $output .= <<"END";
1.1067 raeburn 13506: <br />
1.1053 raeburn 13507: <input type="submit" name="decompress" value="$lt{'extr'}" />
13508: </form>
13509: $noextract
13510: END
13511: return $output;
13512: }
13513:
1.1065 raeburn 13514: sub decompression_utility {
13515: my ($program) = @_;
13516: my @utilities = ('tar','gunzip','bunzip2','unzip');
13517: my $location;
13518: if (grep(/^\Q$program\E$/,@utilities)) {
13519: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
13520: '/usr/sbin/') {
13521: if (-x $dir.$program) {
13522: $location = $dir.$program;
13523: last;
13524: }
13525: }
13526: }
13527: return $location;
13528: }
13529:
13530: sub list_archive_contents {
13531: my ($file,$pathsref) = @_;
13532: my (@cmd,$output);
13533: my $needsregexp;
13534: if ($file =~ /\.zip$/) {
13535: @cmd = (&decompression_utility('unzip'),"-l");
13536: $needsregexp = 1;
13537: } elsif (($file =~ m/\.tar\.gz$/) ||
13538: ($file =~ /\.tgz$/)) {
13539: @cmd = (&decompression_utility('tar'),"-ztf");
13540: } elsif ($file =~ /\.tar\.bz2$/) {
13541: @cmd = (&decompression_utility('tar'),"-jtf");
13542: } elsif ($file =~ m|\.tar$|) {
13543: @cmd = (&decompression_utility('tar'),"-tf");
13544: }
13545: if (@cmd) {
13546: undef($!);
13547: undef($@);
13548: if (open(my $fh,"-|", @cmd, $file)) {
13549: while (my $line = <$fh>) {
13550: $output .= $line;
13551: chomp($line);
13552: my $item;
13553: if ($needsregexp) {
13554: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
13555: } else {
13556: $item = $line;
13557: }
13558: if ($item ne '') {
13559: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
13560: push(@{$pathsref},$item);
13561: }
13562: }
13563: }
13564: close($fh);
13565: }
13566: }
13567: return $output;
13568: }
13569:
1.1053 raeburn 13570: sub decompress_uploaded_file {
13571: my ($file,$dir) = @_;
13572: &Apache::lonnet::appenv({'cgi.file' => $file});
13573: &Apache::lonnet::appenv({'cgi.dir' => $dir});
13574: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
13575: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
13576: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
13577: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
13578: my $decompressed = $env{'cgi.decompressed'};
13579: &Apache::lonnet::delenv('cgi.file');
13580: &Apache::lonnet::delenv('cgi.dir');
13581: &Apache::lonnet::delenv('cgi.decompressed');
13582: return ($decompressed,$result);
13583: }
13584:
1.1055 raeburn 13585: sub process_decompression {
13586: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1075.2.128 raeburn 13587: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
13588: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13589: &mt('Unexpected file path.').'</p>'."\n";
13590: }
13591: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
13592: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13593: &mt('Unexpected course context.').'</p>'."\n";
13594: }
13595: unless ($file eq &Apache::lonnet::clean_filename($file)) {
13596: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13597: &mt('Filename contained unexpected characters.').'</p>'."\n";
13598: }
1.1055 raeburn 13599: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 13600: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 13601: $error = &mt('Filename not a supported archive file type.').
13602: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 13603: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
13604: } else {
13605: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13606: if ($docuhome eq 'no_host') {
13607: $error = &mt('Could not determine home server for course.');
13608: } else {
13609: my @ids=&Apache::lonnet::current_machine_ids();
13610: my $currdir = "$dir_root/$destination";
13611: if (grep(/^\Q$docuhome\E$/,@ids)) {
13612: $dir = &LONCAPA::propath($docudom,$docuname).
13613: "$dir_root/$destination";
13614: } else {
13615: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
13616: "$dir_root/$docudom/$docuname/$destination";
13617: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
13618: $error = &mt('Archive file not found.');
13619: }
13620: }
1.1065 raeburn 13621: my (@to_overwrite,@to_skip);
13622: if ($env{'form.archive_overwrite_total'} > 0) {
13623: my $total = $env{'form.archive_overwrite_total'};
13624: for (my $i=0; $i<$total; $i++) {
13625: if ($env{'form.archive_overwrite_'.$i} == 1) {
13626: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
13627: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
13628: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
13629: }
13630: }
13631: }
13632: my $numskip = scalar(@to_skip);
1.1075.2.128 raeburn 13633: my $numoverwrite = scalar(@to_overwrite);
13634: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 13635: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
13636: } elsif ($dir eq '') {
1.1055 raeburn 13637: $error = &mt('Directory containing archive file unavailable.');
13638: } elsif (!$error) {
1.1065 raeburn 13639: my ($decompressed,$display);
1.1075.2.128 raeburn 13640: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 13641: my $tempdir = time.'_'.$$.int(rand(10000));
13642: mkdir("$dir/$tempdir",0755);
1.1075.2.128 raeburn 13643: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
13644: ($decompressed,$display) =
13645: &decompress_uploaded_file($file,"$dir/$tempdir");
13646: foreach my $item (@to_skip) {
13647: if (($item ne '') && ($item !~ /\.\./)) {
13648: if (-f "$dir/$tempdir/$item") {
13649: unlink("$dir/$tempdir/$item");
13650: } elsif (-d "$dir/$tempdir/$item") {
13651: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
13652: }
13653: }
13654: }
13655: foreach my $item (@to_overwrite) {
13656: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
13657: if (($item ne '') && ($item !~ /\.\./)) {
13658: if (-f "$dir/$item") {
13659: unlink("$dir/$item");
13660: } elsif (-d "$dir/$item") {
13661: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
13662: }
13663: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
13664: }
1.1065 raeburn 13665: }
13666: }
1.1075.2.128 raeburn 13667: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
13668: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
13669: }
1.1065 raeburn 13670: }
13671: } else {
13672: ($decompressed,$display) =
13673: &decompress_uploaded_file($file,$dir);
13674: }
1.1055 raeburn 13675: if ($decompressed eq 'ok') {
1.1065 raeburn 13676: $output = '<p class="LC_info">'.
13677: &mt('Files extracted successfully from archive.').
13678: '</p>'."\n";
1.1055 raeburn 13679: my ($warning,$result,@contents);
13680: my ($newdirlistref,$newlisterror) =
13681: &Apache::lonnet::dirlist($currdir,$docudom,
13682: $docuname,1);
13683: my (%is_dir,%changes,@newitems);
13684: my $dirptr = 16384;
1.1065 raeburn 13685: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 13686: foreach my $dir_line (@{$newdirlistref}) {
13687: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1075.2.128 raeburn 13688: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 13689: push(@newitems,$item);
13690: if ($dirptr&$testdir) {
13691: $is_dir{$item} = 1;
13692: }
13693: $changes{$item} = 1;
13694: }
13695: }
13696: }
13697: if (keys(%changes) > 0) {
13698: foreach my $item (sort(@newitems)) {
13699: if ($changes{$item}) {
13700: push(@contents,$item);
13701: }
13702: }
13703: }
13704: if (@contents > 0) {
1.1067 raeburn 13705: my $wantform;
13706: unless ($env{'form.autoextract_camtasia'}) {
13707: $wantform = 1;
13708: }
1.1056 raeburn 13709: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 13710: my ($count,$datatable) = &get_extracted($docudom,$docuname,
13711: $currdir,\%is_dir,
13712: \%children,\%parent,
1.1056 raeburn 13713: \@contents,\%dirorder,
13714: \%titles,$wantform);
1.1055 raeburn 13715: if ($datatable ne '') {
13716: $output .= &archive_options_form('decompressed',$datatable,
13717: $count,$hiddenelem);
1.1065 raeburn 13718: my $startcount = 6;
1.1055 raeburn 13719: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 13720: \%titles,\%children);
1.1055 raeburn 13721: }
1.1067 raeburn 13722: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 13723: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 13724: my %displayed;
13725: my $total = 1;
13726: $env{'form.archive_directory'} = [];
13727: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
13728: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
13729: $path =~ s{/$}{};
13730: my $item;
13731: if ($path ne '') {
13732: $item = "$path/$titles{$i}";
13733: } else {
13734: $item = $titles{$i};
13735: }
13736: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
13737: if ($item eq $contents[0]) {
13738: push(@{$env{'form.archive_directory'}},$i);
13739: $env{'form.archive_'.$i} = 'display';
13740: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
13741: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 13742: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
13743: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 13744: $env{'form.archive_'.$i} = 'display';
13745: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
13746: $displayed{'web'} = $i;
13747: } else {
1.1075.2.59 raeburn 13748: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
13749: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
13750: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 13751: push(@{$env{'form.archive_directory'}},$i);
13752: }
13753: $env{'form.archive_'.$i} = 'dependency';
13754: }
13755: $total ++;
13756: }
13757: for (my $i=1; $i<$total; $i++) {
13758: next if ($i == $displayed{'web'});
13759: next if ($i == $displayed{'folder'});
13760: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
13761: }
13762: $env{'form.phase'} = 'decompress_cleanup';
13763: $env{'form.archivedelete'} = 1;
13764: $env{'form.archive_count'} = $total-1;
13765: $output .=
13766: &process_extracted_files('coursedocs',$docudom,
13767: $docuname,$destination,
13768: $dir_root,$hiddenelem);
13769: }
1.1055 raeburn 13770: } else {
13771: $warning = &mt('No new items extracted from archive file.');
13772: }
13773: } else {
13774: $output = $display;
13775: $error = &mt('An error occurred during extraction from the archive file.');
13776: }
13777: }
13778: }
13779: }
13780: if ($error) {
13781: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13782: $error.'</p>'."\n";
13783: }
13784: if ($warning) {
13785: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13786: }
13787: return $output;
13788: }
13789:
13790: sub get_extracted {
1.1056 raeburn 13791: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
13792: $titles,$wantform) = @_;
1.1055 raeburn 13793: my $count = 0;
13794: my $depth = 0;
13795: my $datatable;
1.1056 raeburn 13796: my @hierarchy;
1.1055 raeburn 13797: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 13798: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
13799: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 13800: foreach my $item (@{$contents}) {
13801: $count ++;
1.1056 raeburn 13802: @{$dirorder->{$count}} = @hierarchy;
13803: $titles->{$count} = $item;
1.1055 raeburn 13804: &archive_hierarchy($depth,$count,$parent,$children);
13805: if ($wantform) {
13806: $datatable .= &archive_row($is_dir->{$item},$item,
13807: $currdir,$depth,$count);
13808: }
13809: if ($is_dir->{$item}) {
13810: $depth ++;
1.1056 raeburn 13811: push(@hierarchy,$count);
13812: $parent->{$depth} = $count;
1.1055 raeburn 13813: $datatable .=
13814: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 13815: \$depth,\$count,\@hierarchy,$dirorder,
13816: $children,$parent,$titles,$wantform);
1.1055 raeburn 13817: $depth --;
1.1056 raeburn 13818: pop(@hierarchy);
1.1055 raeburn 13819: }
13820: }
13821: return ($count,$datatable);
13822: }
13823:
13824: sub recurse_extracted_archive {
1.1056 raeburn 13825: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
13826: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 13827: my $result='';
1.1056 raeburn 13828: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
13829: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
13830: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 13831: return $result;
13832: }
13833: my $dirptr = 16384;
13834: my ($newdirlistref,$newlisterror) =
13835: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
13836: if (ref($newdirlistref) eq 'ARRAY') {
13837: foreach my $dir_line (@{$newdirlistref}) {
13838: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
13839: unless ($item =~ /^\.+$/) {
13840: $$count ++;
1.1056 raeburn 13841: @{$dirorder->{$$count}} = @{$hierarchy};
13842: $titles->{$$count} = $item;
1.1055 raeburn 13843: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 13844:
1.1055 raeburn 13845: my $is_dir;
13846: if ($dirptr&$testdir) {
13847: $is_dir = 1;
13848: }
13849: if ($wantform) {
13850: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
13851: }
13852: if ($is_dir) {
13853: $$depth ++;
1.1056 raeburn 13854: push(@{$hierarchy},$$count);
13855: $parent->{$$depth} = $$count;
1.1055 raeburn 13856: $result .=
13857: &recurse_extracted_archive("$currdir/$item",$docudom,
13858: $docuname,$depth,$count,
1.1056 raeburn 13859: $hierarchy,$dirorder,$children,
13860: $parent,$titles,$wantform);
1.1055 raeburn 13861: $$depth --;
1.1056 raeburn 13862: pop(@{$hierarchy});
1.1055 raeburn 13863: }
13864: }
13865: }
13866: }
13867: return $result;
13868: }
13869:
13870: sub archive_hierarchy {
13871: my ($depth,$count,$parent,$children) =@_;
13872: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
13873: if (exists($parent->{$depth})) {
13874: $children->{$parent->{$depth}} .= $count.':';
13875: }
13876: }
13877: return;
13878: }
13879:
13880: sub archive_row {
13881: my ($is_dir,$item,$currdir,$depth,$count) = @_;
13882: my ($name) = ($item =~ m{([^/]+)$});
13883: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 13884: 'display' => 'Add as file',
1.1055 raeburn 13885: 'dependency' => 'Include as dependency',
13886: 'discard' => 'Discard',
13887: );
13888: if ($is_dir) {
1.1059 raeburn 13889: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 13890: }
1.1056 raeburn 13891: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
13892: my $offset = 0;
1.1055 raeburn 13893: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 13894: $offset ++;
1.1065 raeburn 13895: if ($action ne 'display') {
13896: $offset ++;
13897: }
1.1055 raeburn 13898: $output .= '<td><span class="LC_nobreak">'.
13899: '<label><input type="radio" name="archive_'.$count.
13900: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
13901: my $text = $choices{$action};
13902: if ($is_dir) {
13903: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
13904: if ($action eq 'display') {
1.1059 raeburn 13905: $text = &mt('Add as folder');
1.1055 raeburn 13906: }
1.1056 raeburn 13907: } else {
13908: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
13909:
13910: }
13911: $output .= ' /> '.$choices{$action}.'</label></span>';
13912: if ($action eq 'dependency') {
13913: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
13914: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
13915: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
13916: '<option value=""></option>'."\n".
13917: '</select>'."\n".
13918: '</div>';
1.1059 raeburn 13919: } elsif ($action eq 'display') {
13920: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
13921: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
13922: '</div>';
1.1055 raeburn 13923: }
1.1056 raeburn 13924: $output .= '</td>';
1.1055 raeburn 13925: }
13926: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
13927: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
13928: for (my $i=0; $i<$depth; $i++) {
13929: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
13930: }
13931: if ($is_dir) {
13932: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
13933: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
13934: } else {
13935: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
13936: }
13937: $output .= ' '.$name.'</td>'."\n".
13938: &end_data_table_row();
13939: return $output;
13940: }
13941:
13942: sub archive_options_form {
1.1065 raeburn 13943: my ($form,$display,$count,$hiddenelem) = @_;
13944: my %lt = &Apache::lonlocal::texthash(
13945: perm => 'Permanently remove archive file?',
13946: hows => 'How should each extracted item be incorporated in the course?',
13947: cont => 'Content actions for all',
13948: addf => 'Add as folder/file',
13949: incd => 'Include as dependency for a displayed file',
13950: disc => 'Discard',
13951: no => 'No',
13952: yes => 'Yes',
13953: save => 'Save',
13954: );
13955: my $output = <<"END";
13956: <form name="$form" method="post" action="">
13957: <p><span class="LC_nobreak">$lt{'perm'}
13958: <label>
13959: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
13960: </label>
13961:
13962: <label>
13963: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
13964: </span>
13965: </p>
13966: <input type="hidden" name="phase" value="decompress_cleanup" />
13967: <br />$lt{'hows'}
13968: <div class="LC_columnSection">
13969: <fieldset>
13970: <legend>$lt{'cont'}</legend>
13971: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
13972: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
13973: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
13974: </fieldset>
13975: </div>
13976: END
13977: return $output.
1.1055 raeburn 13978: &start_data_table()."\n".
1.1065 raeburn 13979: $display."\n".
1.1055 raeburn 13980: &end_data_table()."\n".
13981: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
13982: $hiddenelem.
1.1065 raeburn 13983: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 13984: '</form>';
13985: }
13986:
13987: sub archive_javascript {
1.1056 raeburn 13988: my ($startcount,$numitems,$titles,$children) = @_;
13989: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 13990: my $maintitle = $env{'form.comment'};
1.1055 raeburn 13991: my $scripttag = <<START;
13992: <script type="text/javascript">
13993: // <![CDATA[
13994:
13995: function checkAll(form,prefix) {
13996: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
13997: for (var i=0; i < form.elements.length; i++) {
13998: var id = form.elements[i].id;
13999: if ((id != '') && (id != undefined)) {
14000: if (idstr.test(id)) {
14001: if (form.elements[i].type == 'radio') {
14002: form.elements[i].checked = true;
1.1056 raeburn 14003: var nostart = i-$startcount;
1.1059 raeburn 14004: var offset = nostart%7;
14005: var count = (nostart-offset)/7;
1.1056 raeburn 14006: dependencyCheck(form,count,offset);
1.1055 raeburn 14007: }
14008: }
14009: }
14010: }
14011: }
14012:
14013: function propagateCheck(form,count) {
14014: if (count > 0) {
1.1059 raeburn 14015: var startelement = $startcount + ((count-1) * 7);
14016: for (var j=1; j<6; j++) {
14017: if ((j != 2) && (j != 4)) {
1.1056 raeburn 14018: var item = startelement + j;
14019: if (form.elements[item].type == 'radio') {
14020: if (form.elements[item].checked) {
14021: containerCheck(form,count,j);
14022: break;
14023: }
1.1055 raeburn 14024: }
14025: }
14026: }
14027: }
14028: }
14029:
14030: numitems = $numitems
1.1056 raeburn 14031: var titles = new Array(numitems);
14032: var parents = new Array(numitems);
1.1055 raeburn 14033: for (var i=0; i<numitems; i++) {
1.1056 raeburn 14034: parents[i] = new Array;
1.1055 raeburn 14035: }
1.1059 raeburn 14036: var maintitle = '$maintitle';
1.1055 raeburn 14037:
14038: START
14039:
1.1056 raeburn 14040: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
14041: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 14042: for (my $i=0; $i<@contents; $i ++) {
14043: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
14044: }
14045: }
14046:
1.1056 raeburn 14047: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
14048: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
14049: }
14050:
1.1055 raeburn 14051: $scripttag .= <<END;
14052:
14053: function containerCheck(form,count,offset) {
14054: if (count > 0) {
1.1056 raeburn 14055: dependencyCheck(form,count,offset);
1.1059 raeburn 14056: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 14057: form.elements[item].checked = true;
14058: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
14059: if (parents[count].length > 0) {
14060: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 14061: containerCheck(form,parents[count][j],offset);
14062: }
14063: }
14064: }
14065: }
14066: }
14067:
14068: function dependencyCheck(form,count,offset) {
14069: if (count > 0) {
1.1059 raeburn 14070: var chosen = (offset+$startcount)+7*(count-1);
14071: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 14072: var currtype = form.elements[depitem].type;
14073: if (form.elements[chosen].value == 'dependency') {
14074: document.getElementById('arc_depon_'+count).style.display='block';
14075: form.elements[depitem].options.length = 0;
14076: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 14077: for (var i=1; i<=numitems; i++) {
14078: if (i == count) {
14079: continue;
14080: }
1.1059 raeburn 14081: var startelement = $startcount + (i-1) * 7;
14082: for (var j=1; j<6; j++) {
14083: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 14084: var item = startelement + j;
14085: if (form.elements[item].type == 'radio') {
14086: if (form.elements[item].checked) {
14087: if (form.elements[item].value == 'display') {
14088: var n = form.elements[depitem].options.length;
14089: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
14090: }
14091: }
14092: }
14093: }
14094: }
14095: }
14096: } else {
14097: document.getElementById('arc_depon_'+count).style.display='none';
14098: form.elements[depitem].options.length = 0;
14099: form.elements[depitem].options[0] = new Option('Select','',true,true);
14100: }
1.1059 raeburn 14101: titleCheck(form,count,offset);
1.1056 raeburn 14102: }
14103: }
14104:
14105: function propagateSelect(form,count,offset) {
14106: if (count > 0) {
1.1065 raeburn 14107: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 14108: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
14109: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14110: if (parents[count].length > 0) {
14111: for (var j=0; j<parents[count].length; j++) {
14112: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 14113: }
14114: }
14115: }
14116: }
14117: }
1.1056 raeburn 14118:
14119: function containerSelect(form,count,offset,picked) {
14120: if (count > 0) {
1.1065 raeburn 14121: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 14122: if (form.elements[item].type == 'radio') {
14123: if (form.elements[item].value == 'dependency') {
14124: if (form.elements[item+1].type == 'select-one') {
14125: for (var i=0; i<form.elements[item+1].options.length; i++) {
14126: if (form.elements[item+1].options[i].value == picked) {
14127: form.elements[item+1].selectedIndex = i;
14128: break;
14129: }
14130: }
14131: }
14132: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
14133: if (parents[count].length > 0) {
14134: for (var j=0; j<parents[count].length; j++) {
14135: containerSelect(form,parents[count][j],offset,picked);
14136: }
14137: }
14138: }
14139: }
14140: }
14141: }
14142: }
14143:
1.1059 raeburn 14144: function titleCheck(form,count,offset) {
14145: if (count > 0) {
14146: var chosen = (offset+$startcount)+7*(count-1);
14147: var depitem = $startcount + ((count-1) * 7) + 2;
14148: var currtype = form.elements[depitem].type;
14149: if (form.elements[chosen].value == 'display') {
14150: document.getElementById('arc_title_'+count).style.display='block';
14151: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
14152: document.getElementById('archive_title_'+count).value=maintitle;
14153: }
14154: } else {
14155: document.getElementById('arc_title_'+count).style.display='none';
14156: if (currtype == 'text') {
14157: document.getElementById('archive_title_'+count).value='';
14158: }
14159: }
14160: }
14161: return;
14162: }
14163:
1.1055 raeburn 14164: // ]]>
14165: </script>
14166: END
14167: return $scripttag;
14168: }
14169:
14170: sub process_extracted_files {
1.1067 raeburn 14171: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 14172: my $numitems = $env{'form.archive_count'};
1.1075.2.128 raeburn 14173: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 14174: my @ids=&Apache::lonnet::current_machine_ids();
14175: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 14176: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 14177: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
14178: if (grep(/^\Q$docuhome\E$/,@ids)) {
14179: $prefix = &LONCAPA::propath($docudom,$docuname);
14180: $pathtocheck = "$dir_root/$destination";
14181: $dir = $dir_root;
14182: $ishome = 1;
14183: } else {
14184: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
14185: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1075.2.128 raeburn 14186: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 14187: }
14188: my $currdir = "$dir_root/$destination";
14189: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
14190: if ($env{'form.folderpath'}) {
14191: my @items = split('&',$env{'form.folderpath'});
14192: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 14193: if ($env{'form.folderpath'} =~ /\:1$/) {
14194: $containers{'0'}='page';
14195: } else {
14196: $containers{'0'}='sequence';
14197: }
1.1055 raeburn 14198: }
14199: my @archdirs = &get_env_multiple('form.archive_directory');
14200: if ($numitems) {
14201: for (my $i=1; $i<=$numitems; $i++) {
14202: my $path = $env{'form.archive_content_'.$i};
14203: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
14204: my $item = $1;
14205: $toplevelitems{$item} = $i;
14206: if (grep(/^\Q$i\E$/,@archdirs)) {
14207: $is_dir{$item} = 1;
14208: }
14209: }
14210: }
14211: }
1.1067 raeburn 14212: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 14213: if (keys(%toplevelitems) > 0) {
14214: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 14215: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
14216: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 14217: }
1.1066 raeburn 14218: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 14219: if ($numitems) {
14220: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 14221: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 14222: my $path = $env{'form.archive_content_'.$i};
14223: if ($path =~ /^\Q$pathtocheck\E/) {
14224: if ($env{'form.archive_'.$i} eq 'discard') {
14225: if ($prefix ne '' && $path ne '') {
14226: if (-e $prefix.$path) {
1.1066 raeburn 14227: if ((@archdirs > 0) &&
14228: (grep(/^\Q$i\E$/,@archdirs))) {
14229: $todeletedir{$prefix.$path} = 1;
14230: } else {
14231: $todelete{$prefix.$path} = 1;
14232: }
1.1055 raeburn 14233: }
14234: }
14235: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 14236: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 14237: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 14238: $docstitle = $env{'form.archive_title_'.$i};
14239: if ($docstitle eq '') {
14240: $docstitle = $title;
14241: }
1.1055 raeburn 14242: $outer = 0;
1.1056 raeburn 14243: if (ref($dirorder{$i}) eq 'ARRAY') {
14244: if (@{$dirorder{$i}} > 0) {
14245: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 14246: if ($env{'form.archive_'.$item} eq 'display') {
14247: $outer = $item;
14248: last;
14249: }
14250: }
14251: }
14252: }
14253: my ($errtext,$fatal) =
14254: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
14255: '/'.$folders{$outer}.'.'.
14256: $containers{$outer});
14257: next if ($fatal);
14258: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
14259: if ($context eq 'coursedocs') {
1.1056 raeburn 14260: $mapinner{$i} = time;
1.1055 raeburn 14261: $folders{$i} = 'default_'.$mapinner{$i};
14262: $containers{$i} = 'sequence';
14263: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14264: $folders{$i}.'.'.$containers{$i};
14265: my $newidx = &LONCAPA::map::getresidx();
14266: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 14267: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 14268: push(@LONCAPA::map::order,$newidx);
14269: my ($outtext,$errtext) =
14270: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14271: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 14272: '.'.$containers{$outer},1,1);
1.1056 raeburn 14273: $newseqid{$i} = $newidx;
1.1067 raeburn 14274: unless ($errtext) {
1.1075.2.128 raeburn 14275: $result .= '<li>'.&mt('Folder: [_1] added to course',
14276: &HTML::Entities::encode($docstitle,'<>&"'))..
14277: '</li>'."\n";
1.1067 raeburn 14278: }
1.1055 raeburn 14279: }
14280: } else {
14281: if ($context eq 'coursedocs') {
14282: my $newidx=&LONCAPA::map::getresidx();
14283: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
14284: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
14285: $title;
1.1075.2.161. .13(raeb 14286:-23): if (($outer !~ /\D/) &&
14287:-23): (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
14288:-23): ($newidx !~ /\D/)) {
1.1075.2.128 raeburn 14289: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
14290: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
1.1067 raeburn 14291: }
1.1075.2.128 raeburn 14292: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14293: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
14294: }
14295: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
14296: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
14297: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
14298: unless ($ishome) {
14299: my $fetch = "$newdest{$i}/$title";
14300: $fetch =~ s/^\Q$prefix$dir\E//;
14301: $prompttofetch{$fetch} = 1;
14302: }
14303: }
14304: }
14305: $LONCAPA::map::resources[$newidx]=
14306: $docstitle.':'.$url.':false:normal:res';
14307: push(@LONCAPA::map::order, $newidx);
14308: my ($outtext,$errtext)=
14309: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
14310: $docuname.'/'.$folders{$outer}.
14311: '.'.$containers{$outer},1,1);
14312: unless ($errtext) {
14313: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
14314: $result .= '<li>'.&mt('File: [_1] added to course',
14315: &HTML::Entities::encode($docstitle,'<>&"')).
14316: '</li>'."\n";
14317: }
1.1067 raeburn 14318: }
1.1075.2.128 raeburn 14319: } else {
14320: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14321: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1067 raeburn 14322: }
1.1055 raeburn 14323: }
14324: }
1.1075.2.11 raeburn 14325: }
14326: } else {
1.1075.2.128 raeburn 14327: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14328: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1075.2.11 raeburn 14329: }
14330: }
14331: for (my $i=1; $i<=$numitems; $i++) {
14332: next unless ($env{'form.archive_'.$i} eq 'dependency');
14333: my $path = $env{'form.archive_content_'.$i};
14334: if ($path =~ /^\Q$pathtocheck\E/) {
14335: my ($title) = ($path =~ m{/([^/]+)$});
14336: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
14337: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
14338: if (ref($dirorder{$i}) eq 'ARRAY') {
14339: my ($itemidx,$fullpath,$relpath);
14340: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
14341: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 14342: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 14343: if ($dirorder{$i}->[$j] eq $container) {
14344: $itemidx = $j;
1.1056 raeburn 14345: }
14346: }
1.1075.2.11 raeburn 14347: }
14348: if ($itemidx eq '') {
14349: $itemidx = 0;
14350: }
14351: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
14352: if ($mapinner{$referrer{$i}}) {
14353: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
14354: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14355: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14356: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14357: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14358: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14359: if (!-e $fullpath) {
14360: mkdir($fullpath,0755);
1.1056 raeburn 14361: }
14362: }
1.1075.2.11 raeburn 14363: } else {
14364: last;
1.1056 raeburn 14365: }
1.1075.2.11 raeburn 14366: }
14367: }
14368: } elsif ($newdest{$referrer{$i}}) {
14369: $fullpath = $newdest{$referrer{$i}};
14370: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
14371: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
14372: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
14373: last;
14374: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
14375: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
14376: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
14377: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
14378: if (!-e $fullpath) {
14379: mkdir($fullpath,0755);
1.1056 raeburn 14380: }
14381: }
1.1075.2.11 raeburn 14382: } else {
14383: last;
1.1056 raeburn 14384: }
1.1075.2.11 raeburn 14385: }
14386: }
14387: if ($fullpath ne '') {
14388: if (-e "$prefix$path") {
1.1075.2.128 raeburn 14389: unless (rename("$prefix$path","$fullpath/$title")) {
14390: $warning .= &mt('Failed to rename dependency').'<br />';
14391: }
1.1075.2.11 raeburn 14392: }
14393: if (-e "$fullpath/$title") {
14394: my $showpath;
14395: if ($relpath ne '') {
14396: $showpath = "$relpath/$title";
14397: } else {
14398: $showpath = "/$title";
1.1056 raeburn 14399: }
1.1075.2.128 raeburn 14400: $result .= '<li>'.&mt('[_1] included as a dependency',
14401: &HTML::Entities::encode($showpath,'<>&"')).
14402: '</li>'."\n";
14403: unless ($ishome) {
14404: my $fetch = "$fullpath/$title";
14405: $fetch =~ s/^\Q$prefix$dir\E//;
14406: $prompttofetch{$fetch} = 1;
14407: }
1.1055 raeburn 14408: }
14409: }
14410: }
1.1075.2.11 raeburn 14411: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
14412: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1075.2.128 raeburn 14413: &HTML::Entities::encode($path,'<>&"'),
14414: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
14415: '<br />';
1.1055 raeburn 14416: }
14417: } else {
1.1075.2.128 raeburn 14418: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
14419: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 14420: }
14421: }
14422: if (keys(%todelete)) {
14423: foreach my $key (keys(%todelete)) {
14424: unlink($key);
1.1066 raeburn 14425: }
14426: }
14427: if (keys(%todeletedir)) {
14428: foreach my $key (keys(%todeletedir)) {
14429: rmdir($key);
14430: }
14431: }
14432: foreach my $dir (sort(keys(%is_dir))) {
14433: if (($pathtocheck ne '') && ($dir ne '')) {
14434: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 14435: }
14436: }
1.1067 raeburn 14437: if ($result ne '') {
14438: $output .= '<ul>'."\n".
14439: $result."\n".
14440: '</ul>';
14441: }
14442: unless ($ishome) {
14443: my $replicationfail;
14444: foreach my $item (keys(%prompttofetch)) {
14445: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
14446: unless ($fetchresult eq 'ok') {
14447: $replicationfail .= '<li>'.$item.'</li>'."\n";
14448: }
14449: }
14450: if ($replicationfail) {
14451: $output .= '<p class="LC_error">'.
14452: &mt('Course home server failed to retrieve:').'<ul>'.
14453: $replicationfail.
14454: '</ul></p>';
14455: }
14456: }
1.1055 raeburn 14457: } else {
14458: $warning = &mt('No items found in archive.');
14459: }
14460: if ($error) {
14461: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
14462: $error.'</p>'."\n";
14463: }
14464: if ($warning) {
14465: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
14466: }
14467: return $output;
14468: }
14469:
1.1066 raeburn 14470: sub cleanup_empty_dirs {
14471: my ($path) = @_;
14472: if (($path ne '') && (-d $path)) {
14473: if (opendir(my $dirh,$path)) {
14474: my @dircontents = grep(!/^\./,readdir($dirh));
14475: my $numitems = 0;
14476: foreach my $item (@dircontents) {
14477: if (-d "$path/$item") {
1.1075.2.28 raeburn 14478: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 14479: if (-e "$path/$item") {
14480: $numitems ++;
14481: }
14482: } else {
14483: $numitems ++;
14484: }
14485: }
14486: if ($numitems == 0) {
14487: rmdir($path);
14488: }
14489: closedir($dirh);
14490: }
14491: }
14492: return;
14493: }
14494:
1.41 ng 14495: =pod
1.45 matthew 14496:
1.1075.2.56 raeburn 14497: =item * &get_folder_hierarchy()
1.1068 raeburn 14498:
14499: Provides hierarchy of names of folders/sub-folders containing the current
14500: item,
14501:
14502: Inputs: 3
14503: - $navmap - navmaps object
14504:
14505: - $map - url for map (either the trigger itself, or map containing
14506: the resource, which is the trigger).
14507:
14508: - $showitem - 1 => show title for map itself; 0 => do not show.
14509:
14510: Outputs: 1 @pathitems - array of folder/subfolder names.
14511:
14512: =cut
14513:
14514: sub get_folder_hierarchy {
14515: my ($navmap,$map,$showitem) = @_;
14516: my @pathitems;
14517: if (ref($navmap)) {
14518: my $mapres = $navmap->getResourceByUrl($map);
14519: if (ref($mapres)) {
14520: my $pcslist = $mapres->map_hierarchy();
14521: if ($pcslist ne '') {
14522: my @pcs = split(/,/,$pcslist);
14523: foreach my $pc (@pcs) {
14524: if ($pc == 1) {
1.1075.2.38 raeburn 14525: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 14526: } else {
14527: my $res = $navmap->getByMapPc($pc);
14528: if (ref($res)) {
14529: my $title = $res->compTitle();
14530: $title =~ s/\W+/_/g;
14531: if ($title ne '') {
14532: push(@pathitems,$title);
14533: }
14534: }
14535: }
14536: }
14537: }
1.1071 raeburn 14538: if ($showitem) {
14539: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 14540: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 14541: } else {
14542: my $maptitle = $mapres->compTitle();
14543: $maptitle =~ s/\W+/_/g;
14544: if ($maptitle ne '') {
14545: push(@pathitems,$maptitle);
14546: }
1.1068 raeburn 14547: }
14548: }
14549: }
14550: }
14551: return @pathitems;
14552: }
14553:
14554: =pod
14555:
1.1015 raeburn 14556: =item * &get_turnedin_filepath()
14557:
14558: Determines path in a user's portfolio file for storage of files uploaded
14559: to a specific essayresponse or dropbox item.
14560:
14561: Inputs: 3 required + 1 optional.
14562: $symb is symb for resource, $uname and $udom are for current user (required).
14563: $caller is optional (can be "submission", if routine is called when storing
14564: an upoaded file when "Submit Answer" button was pressed).
14565:
14566: Returns array containing $path and $multiresp.
14567: $path is path in portfolio. $multiresp is 1 if this resource contains more
14568: than one file upload item. Callers of routine should append partid as a
14569: subdirectory to $path in cases where $multiresp is 1.
14570:
14571: Called by: homework/essayresponse.pm and homework/structuretags.pm
14572:
14573: =cut
14574:
14575: sub get_turnedin_filepath {
14576: my ($symb,$uname,$udom,$caller) = @_;
14577: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
14578: my $turnindir;
14579: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
14580: $turnindir = $userhash{'turnindir'};
14581: my ($path,$multiresp);
14582: if ($turnindir eq '') {
14583: if ($caller eq 'submission') {
14584: $turnindir = &mt('turned in');
14585: $turnindir =~ s/\W+/_/g;
14586: my %newhash = (
14587: 'turnindir' => $turnindir,
14588: );
14589: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
14590: }
14591: }
14592: if ($turnindir ne '') {
14593: $path = '/'.$turnindir.'/';
14594: my ($multipart,$turnin,@pathitems);
14595: my $navmap = Apache::lonnavmaps::navmap->new();
14596: if (defined($navmap)) {
14597: my $mapres = $navmap->getResourceByUrl($map);
14598: if (ref($mapres)) {
14599: my $pcslist = $mapres->map_hierarchy();
14600: if ($pcslist ne '') {
14601: foreach my $pc (split(/,/,$pcslist)) {
14602: my $res = $navmap->getByMapPc($pc);
14603: if (ref($res)) {
14604: my $title = $res->compTitle();
14605: $title =~ s/\W+/_/g;
14606: if ($title ne '') {
1.1075.2.48 raeburn 14607: if (($pc > 1) && (length($title) > 12)) {
14608: $title = substr($title,0,12);
14609: }
1.1015 raeburn 14610: push(@pathitems,$title);
14611: }
14612: }
14613: }
14614: }
14615: my $maptitle = $mapres->compTitle();
14616: $maptitle =~ s/\W+/_/g;
14617: if ($maptitle ne '') {
1.1075.2.48 raeburn 14618: if (length($maptitle) > 12) {
14619: $maptitle = substr($maptitle,0,12);
14620: }
1.1015 raeburn 14621: push(@pathitems,$maptitle);
14622: }
14623: unless ($env{'request.state'} eq 'construct') {
14624: my $res = $navmap->getBySymb($symb);
14625: if (ref($res)) {
14626: my $partlist = $res->parts();
14627: my $totaluploads = 0;
14628: if (ref($partlist) eq 'ARRAY') {
14629: foreach my $part (@{$partlist}) {
14630: my @types = $res->responseType($part);
14631: my @ids = $res->responseIds($part);
14632: for (my $i=0; $i < scalar(@ids); $i++) {
14633: if ($types[$i] eq 'essay') {
14634: my $partid = $part.'_'.$ids[$i];
14635: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
14636: $totaluploads ++;
14637: }
14638: }
14639: }
14640: }
14641: if ($totaluploads > 1) {
14642: $multiresp = 1;
14643: }
14644: }
14645: }
14646: }
14647: } else {
14648: return;
14649: }
14650: } else {
14651: return;
14652: }
14653: my $restitle=&Apache::lonnet::gettitle($symb);
14654: $restitle =~ s/\W+/_/g;
14655: if ($restitle eq '') {
14656: $restitle = ($resurl =~ m{/[^/]+$});
14657: if ($restitle eq '') {
14658: $restitle = time;
14659: }
14660: }
1.1075.2.48 raeburn 14661: if (length($restitle) > 12) {
14662: $restitle = substr($restitle,0,12);
14663: }
1.1015 raeburn 14664: push(@pathitems,$restitle);
14665: $path .= join('/',@pathitems);
14666: }
14667: return ($path,$multiresp);
14668: }
14669:
14670: =pod
14671:
1.464 albertel 14672: =back
1.41 ng 14673:
1.112 bowersj2 14674: =head1 CSV Upload/Handling functions
1.38 albertel 14675:
1.41 ng 14676: =over 4
14677:
1.648 raeburn 14678: =item * &upfile_store($r)
1.41 ng 14679:
14680: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 14681: needs $env{'form.upfile'}
1.41 ng 14682: returns $datatoken to be put into hidden field
14683:
14684: =cut
1.31 albertel 14685:
14686: sub upfile_store {
14687: my $r=shift;
1.258 albertel 14688: $env{'form.upfile'}=~s/\r/\n/gs;
14689: $env{'form.upfile'}=~s/\f/\n/gs;
14690: $env{'form.upfile'}=~s/\n+/\n/gs;
14691: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 14692:
1.1075.2.128 raeburn 14693: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
14694: '_enroll_'.$env{'request.course.id'}.'_'.
14695: time.'_'.$$);
14696: return if ($datatoken eq '');
14697:
1.31 albertel 14698: {
1.158 raeburn 14699: my $datafile = $r->dir_config('lonDaemons').
14700: '/tmp/'.$datatoken.'.tmp';
1.1075.2.128 raeburn 14701: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 14702: print $fh $env{'form.upfile'};
1.158 raeburn 14703: close($fh);
14704: }
1.31 albertel 14705: }
14706: return $datatoken;
14707: }
14708:
1.56 matthew 14709: =pod
14710:
1.1075.2.128 raeburn 14711: =item * &load_tmp_file($r,$datatoken)
1.41 ng 14712:
14713: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1075.2.128 raeburn 14714: $datatoken is the name to assign to the temporary file.
1.258 albertel 14715: sets $env{'form.upfile'} to the contents of the file
1.41 ng 14716:
14717: =cut
1.31 albertel 14718:
14719: sub load_tmp_file {
1.1075.2.128 raeburn 14720: my ($r,$datatoken) = @_;
14721: return if ($datatoken eq '');
1.31 albertel 14722: my @studentdata=();
14723: {
1.158 raeburn 14724: my $studentfile = $r->dir_config('lonDaemons').
1.1075.2.128 raeburn 14725: '/tmp/'.$datatoken.'.tmp';
14726: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 14727: @studentdata=<$fh>;
14728: close($fh);
14729: }
1.31 albertel 14730: }
1.258 albertel 14731: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 14732: }
14733:
1.1075.2.128 raeburn 14734: sub valid_datatoken {
14735: my ($datatoken) = @_;
1.1075.2.131 raeburn 14736: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1075.2.128 raeburn 14737: return $datatoken;
14738: }
14739: return;
14740: }
14741:
1.56 matthew 14742: =pod
14743:
1.648 raeburn 14744: =item * &upfile_record_sep()
1.41 ng 14745:
14746: Separate uploaded file into records
14747: returns array of records,
1.258 albertel 14748: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 14749:
14750: =cut
1.31 albertel 14751:
14752: sub upfile_record_sep {
1.258 albertel 14753: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 14754: } else {
1.248 albertel 14755: my @records;
1.258 albertel 14756: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 14757: if ($line=~/^\s*$/) { next; }
14758: push(@records,$line);
14759: }
14760: return @records;
1.31 albertel 14761: }
14762: }
14763:
1.56 matthew 14764: =pod
14765:
1.648 raeburn 14766: =item * &record_sep($record)
1.41 ng 14767:
1.258 albertel 14768: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 14769:
14770: =cut
14771:
1.263 www 14772: sub takeleft {
14773: my $index=shift;
14774: return substr('0000'.$index,-4,4);
14775: }
14776:
1.31 albertel 14777: sub record_sep {
14778: my $record=shift;
14779: my %components=();
1.258 albertel 14780: if ($env{'form.upfiletype'} eq 'xml') {
14781: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 14782: my $i=0;
1.356 albertel 14783: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 14784: $field=~s/^(\"|\')//;
14785: $field=~s/(\"|\')$//;
1.263 www 14786: $components{&takeleft($i)}=$field;
1.31 albertel 14787: $i++;
14788: }
1.258 albertel 14789: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 14790: my $i=0;
1.356 albertel 14791: foreach my $field (split(/\t/,$record)) {
1.31 albertel 14792: $field=~s/^(\"|\')//;
14793: $field=~s/(\"|\')$//;
1.263 www 14794: $components{&takeleft($i)}=$field;
1.31 albertel 14795: $i++;
14796: }
14797: } else {
1.561 www 14798: my $separator=',';
1.480 banghart 14799: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 14800: $separator=';';
1.480 banghart 14801: }
1.31 albertel 14802: my $i=0;
1.561 www 14803: # the character we are looking for to indicate the end of a quote or a record
14804: my $looking_for=$separator;
14805: # do not add the characters to the fields
14806: my $ignore=0;
14807: # we just encountered a separator (or the beginning of the record)
14808: my $just_found_separator=1;
14809: # store the field we are working on here
14810: my $field='';
14811: # work our way through all characters in record
14812: foreach my $character ($record=~/(.)/g) {
14813: if ($character eq $looking_for) {
14814: if ($character ne $separator) {
14815: # Found the end of a quote, again looking for separator
14816: $looking_for=$separator;
14817: $ignore=1;
14818: } else {
14819: # Found a separator, store away what we got
14820: $components{&takeleft($i)}=$field;
14821: $i++;
14822: $just_found_separator=1;
14823: $ignore=0;
14824: $field='';
14825: }
14826: next;
14827: }
14828: # single or double quotation marks after a separator indicate beginning of a quote
14829: # we are now looking for the end of the quote and need to ignore separators
14830: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
14831: $looking_for=$character;
14832: next;
14833: }
14834: # ignore would be true after we reached the end of a quote
14835: if ($ignore) { next; }
14836: if (($just_found_separator) && ($character=~/\s/)) { next; }
14837: $field.=$character;
14838: $just_found_separator=0;
1.31 albertel 14839: }
1.561 www 14840: # catch the very last entry, since we never encountered the separator
14841: $components{&takeleft($i)}=$field;
1.31 albertel 14842: }
14843: return %components;
14844: }
14845:
1.144 matthew 14846: ######################################################
14847: ######################################################
14848:
1.56 matthew 14849: =pod
14850:
1.648 raeburn 14851: =item * &upfile_select_html()
1.41 ng 14852:
1.144 matthew 14853: Return HTML code to select a file from the users machine and specify
14854: the file type.
1.41 ng 14855:
14856: =cut
14857:
1.144 matthew 14858: ######################################################
14859: ######################################################
1.31 albertel 14860: sub upfile_select_html {
1.144 matthew 14861: my %Types = (
14862: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 14863: semisv => &mt('Semicolon separated values'),
1.144 matthew 14864: space => &mt('Space separated'),
14865: tab => &mt('Tabulator separated'),
14866: # xml => &mt('HTML/XML'),
14867: );
14868: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 14869: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 14870: foreach my $type (sort(keys(%Types))) {
14871: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
14872: }
14873: $Str .= "</select>\n";
14874: return $Str;
1.31 albertel 14875: }
14876:
1.301 albertel 14877: sub get_samples {
14878: my ($records,$toget) = @_;
14879: my @samples=({});
14880: my $got=0;
14881: foreach my $rec (@$records) {
14882: my %temp = &record_sep($rec);
14883: if (! grep(/\S/, values(%temp))) { next; }
14884: if (%temp) {
14885: $samples[$got]=\%temp;
14886: $got++;
14887: if ($got == $toget) { last; }
14888: }
14889: }
14890: return \@samples;
14891: }
14892:
1.144 matthew 14893: ######################################################
14894: ######################################################
14895:
1.56 matthew 14896: =pod
14897:
1.648 raeburn 14898: =item * &csv_print_samples($r,$records)
1.41 ng 14899:
14900: Prints a table of sample values from each column uploaded $r is an
14901: Apache Request ref, $records is an arrayref from
14902: &Apache::loncommon::upfile_record_sep
14903:
14904: =cut
14905:
1.144 matthew 14906: ######################################################
14907: ######################################################
1.31 albertel 14908: sub csv_print_samples {
14909: my ($r,$records) = @_;
1.662 bisitz 14910: my $samples = &get_samples($records,5);
1.301 albertel 14911:
1.594 raeburn 14912: $r->print(&mt('Samples').'<br />'.&start_data_table().
14913: &start_data_table_header_row());
1.356 albertel 14914: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 14915: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 14916: $r->print(&end_data_table_header_row());
1.301 albertel 14917: foreach my $hash (@$samples) {
1.594 raeburn 14918: $r->print(&start_data_table_row());
1.356 albertel 14919: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 14920: $r->print('<td>');
1.356 albertel 14921: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 14922: $r->print('</td>');
14923: }
1.594 raeburn 14924: $r->print(&end_data_table_row());
1.31 albertel 14925: }
1.594 raeburn 14926: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 14927: }
14928:
1.144 matthew 14929: ######################################################
14930: ######################################################
14931:
1.56 matthew 14932: =pod
14933:
1.648 raeburn 14934: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 14935:
14936: Prints a table to create associations between values and table columns.
1.144 matthew 14937:
1.41 ng 14938: $r is an Apache Request ref,
14939: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 14940: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 14941:
14942: =cut
14943:
1.144 matthew 14944: ######################################################
14945: ######################################################
1.31 albertel 14946: sub csv_print_select_table {
14947: my ($r,$records,$d) = @_;
1.301 albertel 14948: my $i=0;
14949: my $samples = &get_samples($records,1);
1.144 matthew 14950: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 14951: &start_data_table().&start_data_table_header_row().
1.144 matthew 14952: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 14953: '<th>'.&mt('Column').'</th>'.
14954: &end_data_table_header_row()."\n");
1.356 albertel 14955: foreach my $array_ref (@$d) {
14956: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 14957: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 14958:
1.875 bisitz 14959: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 14960: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 14961: $r->print('<option value="none"></option>');
1.356 albertel 14962: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
14963: $r->print('<option value="'.$sample.'"'.
14964: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 14965: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 14966: }
1.594 raeburn 14967: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 14968: $i++;
14969: }
1.594 raeburn 14970: $r->print(&end_data_table());
1.31 albertel 14971: $i--;
14972: return $i;
14973: }
1.56 matthew 14974:
1.144 matthew 14975: ######################################################
14976: ######################################################
14977:
1.56 matthew 14978: =pod
1.31 albertel 14979:
1.648 raeburn 14980: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 14981:
14982: Prints a table of sample values from the upload and can make associate samples to internal names.
14983:
14984: $r is an Apache Request ref,
14985: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
14986: $d is an array of 2 element arrays (internal name, displayed name)
14987:
14988: =cut
14989:
1.144 matthew 14990: ######################################################
14991: ######################################################
1.31 albertel 14992: sub csv_samples_select_table {
14993: my ($r,$records,$d) = @_;
14994: my $i=0;
1.144 matthew 14995: #
1.662 bisitz 14996: my $max_samples = 5;
14997: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 14998: $r->print(&start_data_table().
14999: &start_data_table_header_row().'<th>'.
15000: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
15001: &end_data_table_header_row());
1.301 albertel 15002:
15003: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 15004: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 15005: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 15006: foreach my $option (@$d) {
15007: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 15008: $r->print('<option value="'.$value.'"'.
1.253 albertel 15009: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 15010: $display.'</option>');
1.31 albertel 15011: }
15012: $r->print('</select></td><td>');
1.662 bisitz 15013: foreach my $line (0..($max_samples-1)) {
1.301 albertel 15014: if (defined($samples->[$line]{$key})) {
15015: $r->print($samples->[$line]{$key}."<br />\n");
15016: }
15017: }
1.594 raeburn 15018: $r->print('</td>'.&end_data_table_row());
1.31 albertel 15019: $i++;
15020: }
1.594 raeburn 15021: $r->print(&end_data_table());
1.31 albertel 15022: $i--;
15023: return($i);
1.115 matthew 15024: }
15025:
1.144 matthew 15026: ######################################################
15027: ######################################################
15028:
1.115 matthew 15029: =pod
15030:
1.648 raeburn 15031: =item * &clean_excel_name($name)
1.115 matthew 15032:
15033: Returns a replacement for $name which does not contain any illegal characters.
15034:
15035: =cut
15036:
1.144 matthew 15037: ######################################################
15038: ######################################################
1.115 matthew 15039: sub clean_excel_name {
15040: my ($name) = @_;
15041: $name =~ s/[:\*\?\/\\]//g;
15042: if (length($name) > 31) {
15043: $name = substr($name,0,31);
15044: }
15045: return $name;
1.25 albertel 15046: }
1.84 albertel 15047:
1.85 albertel 15048: =pod
15049:
1.648 raeburn 15050: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 15051:
15052: Returns either 1 or undef
15053:
15054: 1 if the part is to be hidden, undef if it is to be shown
15055:
15056: Arguments are:
15057:
15058: $id the id of the part to be checked
15059: $symb, optional the symb of the resource to check
15060: $udom, optional the domain of the user to check for
15061: $uname, optional the username of the user to check for
15062:
15063: =cut
1.84 albertel 15064:
15065: sub check_if_partid_hidden {
15066: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 15067: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 15068: $symb,$udom,$uname);
1.141 albertel 15069: my $truth=1;
15070: #if the string starts with !, then the list is the list to show not hide
15071: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 15072: my @hiddenlist=split(/,/,$hiddenparts);
15073: foreach my $checkid (@hiddenlist) {
1.141 albertel 15074: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 15075: }
1.141 albertel 15076: return !$truth;
1.84 albertel 15077: }
1.127 matthew 15078:
1.138 matthew 15079:
15080: ############################################################
15081: ############################################################
15082:
15083: =pod
15084:
1.157 matthew 15085: =back
15086:
1.138 matthew 15087: =head1 cgi-bin script and graphing routines
15088:
1.157 matthew 15089: =over 4
15090:
1.648 raeburn 15091: =item * &get_cgi_id()
1.138 matthew 15092:
15093: Inputs: none
15094:
15095: Returns an id which can be used to pass environment variables
15096: to various cgi-bin scripts. These environment variables will
15097: be removed from the users environment after a given time by
15098: the routine &Apache::lonnet::transfer_profile_to_env.
15099:
15100: =cut
15101:
15102: ############################################################
15103: ############################################################
1.152 albertel 15104: my $uniq=0;
1.136 matthew 15105: sub get_cgi_id {
1.154 albertel 15106: $uniq=($uniq+1)%100000;
1.280 albertel 15107: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 15108: }
15109:
1.127 matthew 15110: ############################################################
15111: ############################################################
15112:
15113: =pod
15114:
1.648 raeburn 15115: =item * &DrawBarGraph()
1.127 matthew 15116:
1.138 matthew 15117: Facilitates the plotting of data in a (stacked) bar graph.
15118: Puts plot definition data into the users environment in order for
15119: graph.png to plot it. Returns an <img> tag for the plot.
15120: The bars on the plot are labeled '1','2',...,'n'.
15121:
15122: Inputs:
15123:
15124: =over 4
15125:
15126: =item $Title: string, the title of the plot
15127:
15128: =item $xlabel: string, text describing the X-axis of the plot
15129:
15130: =item $ylabel: string, text describing the Y-axis of the plot
15131:
15132: =item $Max: scalar, the maximum Y value to use in the plot
15133: If $Max is < any data point, the graph will not be rendered.
15134:
1.140 matthew 15135: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 15136: they are plotted. If undefined, default values will be used.
15137:
1.178 matthew 15138: =item $labels: array ref holding the labels to use on the x-axis for the bars.
15139:
1.138 matthew 15140: =item @Values: An array of array references. Each array reference holds data
15141: to be plotted in a stacked bar chart.
15142:
1.239 matthew 15143: =item If the final element of @Values is a hash reference the key/value
15144: pairs will be added to the graph definition.
15145:
1.138 matthew 15146: =back
15147:
15148: Returns:
15149:
15150: An <img> tag which references graph.png and the appropriate identifying
15151: information for the plot.
15152:
1.127 matthew 15153: =cut
15154:
15155: ############################################################
15156: ############################################################
1.134 matthew 15157: sub DrawBarGraph {
1.178 matthew 15158: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 15159: #
15160: if (! defined($colors)) {
15161: $colors = ['#33ff00',
15162: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
15163: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
15164: ];
15165: }
1.228 matthew 15166: my $extra_settings = {};
15167: if (ref($Values[-1]) eq 'HASH') {
15168: $extra_settings = pop(@Values);
15169: }
1.127 matthew 15170: #
1.136 matthew 15171: my $identifier = &get_cgi_id();
15172: my $id = 'cgi.'.$identifier;
1.129 matthew 15173: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 15174: return '';
15175: }
1.225 matthew 15176: #
15177: my @Labels;
15178: if (defined($labels)) {
15179: @Labels = @$labels;
15180: } else {
15181: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1075.2.119 raeburn 15182: push(@Labels,$i+1);
1.225 matthew 15183: }
15184: }
15185: #
1.129 matthew 15186: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 15187: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 15188: my %ValuesHash;
15189: my $NumSets=1;
15190: foreach my $array (@Values) {
15191: next if (! ref($array));
1.136 matthew 15192: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 15193: join(',',@$array);
1.129 matthew 15194: }
1.127 matthew 15195: #
1.136 matthew 15196: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 15197: if ($NumBars < 3) {
15198: $width = 120+$NumBars*32;
1.220 matthew 15199: $xskip = 1;
1.225 matthew 15200: $bar_width = 30;
15201: } elsif ($NumBars < 5) {
15202: $width = 120+$NumBars*20;
15203: $xskip = 1;
15204: $bar_width = 20;
1.220 matthew 15205: } elsif ($NumBars < 10) {
1.136 matthew 15206: $width = 120+$NumBars*15;
15207: $xskip = 1;
15208: $bar_width = 15;
15209: } elsif ($NumBars <= 25) {
15210: $width = 120+$NumBars*11;
15211: $xskip = 5;
15212: $bar_width = 8;
15213: } elsif ($NumBars <= 50) {
15214: $width = 120+$NumBars*8;
15215: $xskip = 5;
15216: $bar_width = 4;
15217: } else {
15218: $width = 120+$NumBars*8;
15219: $xskip = 5;
15220: $bar_width = 4;
15221: }
15222: #
1.137 matthew 15223: $Max = 1 if ($Max < 1);
15224: if ( int($Max) < $Max ) {
15225: $Max++;
15226: $Max = int($Max);
15227: }
1.127 matthew 15228: $Title = '' if (! defined($Title));
15229: $xlabel = '' if (! defined($xlabel));
15230: $ylabel = '' if (! defined($ylabel));
1.369 www 15231: $ValuesHash{$id.'.title'} = &escape($Title);
15232: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
15233: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 15234: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 15235: $ValuesHash{$id.'.NumBars'} = $NumBars;
15236: $ValuesHash{$id.'.NumSets'} = $NumSets;
15237: $ValuesHash{$id.'.PlotType'} = 'bar';
15238: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15239: $ValuesHash{$id.'.height'} = $height;
15240: $ValuesHash{$id.'.width'} = $width;
15241: $ValuesHash{$id.'.xskip'} = $xskip;
15242: $ValuesHash{$id.'.bar_width'} = $bar_width;
15243: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 15244: #
1.228 matthew 15245: # Deal with other parameters
15246: while (my ($key,$value) = each(%$extra_settings)) {
15247: $ValuesHash{$id.'.'.$key} = $value;
15248: }
15249: #
1.646 raeburn 15250: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 15251: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15252: }
15253:
15254: ############################################################
15255: ############################################################
15256:
15257: =pod
15258:
1.648 raeburn 15259: =item * &DrawXYGraph()
1.137 matthew 15260:
1.138 matthew 15261: Facilitates the plotting of data in an XY graph.
15262: Puts plot definition data into the users environment in order for
15263: graph.png to plot it. Returns an <img> tag for the plot.
15264:
15265: Inputs:
15266:
15267: =over 4
15268:
15269: =item $Title: string, the title of the plot
15270:
15271: =item $xlabel: string, text describing the X-axis of the plot
15272:
15273: =item $ylabel: string, text describing the Y-axis of the plot
15274:
15275: =item $Max: scalar, the maximum Y value to use in the plot
15276: If $Max is < any data point, the graph will not be rendered.
15277:
15278: =item $colors: Array ref containing the hex color codes for the data to be
15279: plotted in. If undefined, default values will be used.
15280:
15281: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15282:
15283: =item $Ydata: Array ref containing Array refs.
1.185 www 15284: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 15285:
15286: =item %Values: hash indicating or overriding any default values which are
15287: passed to graph.png.
15288: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15289:
15290: =back
15291:
15292: Returns:
15293:
15294: An <img> tag which references graph.png and the appropriate identifying
15295: information for the plot.
15296:
1.137 matthew 15297: =cut
15298:
15299: ############################################################
15300: ############################################################
15301: sub DrawXYGraph {
15302: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
15303: #
15304: # Create the identifier for the graph
15305: my $identifier = &get_cgi_id();
15306: my $id = 'cgi.'.$identifier;
15307: #
15308: $Title = '' if (! defined($Title));
15309: $xlabel = '' if (! defined($xlabel));
15310: $ylabel = '' if (! defined($ylabel));
15311: my %ValuesHash =
15312: (
1.369 www 15313: $id.'.title' => &escape($Title),
15314: $id.'.xlabel' => &escape($xlabel),
15315: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 15316: $id.'.y_max_value'=> $Max,
15317: $id.'.labels' => join(',',@$Xlabels),
15318: $id.'.PlotType' => 'XY',
15319: );
15320: #
15321: if (defined($colors) && ref($colors) eq 'ARRAY') {
15322: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15323: }
15324: #
15325: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
15326: return '';
15327: }
15328: my $NumSets=1;
1.138 matthew 15329: foreach my $array (@{$Ydata}){
1.137 matthew 15330: next if (! ref($array));
15331: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
15332: }
1.138 matthew 15333: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 15334: #
15335: # Deal with other parameters
15336: while (my ($key,$value) = each(%Values)) {
15337: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 15338: }
15339: #
1.646 raeburn 15340: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 15341: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
15342: }
15343:
15344: ############################################################
15345: ############################################################
15346:
15347: =pod
15348:
1.648 raeburn 15349: =item * &DrawXYYGraph()
1.138 matthew 15350:
15351: Facilitates the plotting of data in an XY graph with two Y axes.
15352: Puts plot definition data into the users environment in order for
15353: graph.png to plot it. Returns an <img> tag for the plot.
15354:
15355: Inputs:
15356:
15357: =over 4
15358:
15359: =item $Title: string, the title of the plot
15360:
15361: =item $xlabel: string, text describing the X-axis of the plot
15362:
15363: =item $ylabel: string, text describing the Y-axis of the plot
15364:
15365: =item $colors: Array ref containing the hex color codes for the data to be
15366: plotted in. If undefined, default values will be used.
15367:
15368: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
15369:
15370: =item $Ydata1: The first data set
15371:
15372: =item $Min1: The minimum value of the left Y-axis
15373:
15374: =item $Max1: The maximum value of the left Y-axis
15375:
15376: =item $Ydata2: The second data set
15377:
15378: =item $Min2: The minimum value of the right Y-axis
15379:
15380: =item $Max2: The maximum value of the left Y-axis
15381:
15382: =item %Values: hash indicating or overriding any default values which are
15383: passed to graph.png.
15384: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
15385:
15386: =back
15387:
15388: Returns:
15389:
15390: An <img> tag which references graph.png and the appropriate identifying
15391: information for the plot.
1.136 matthew 15392:
15393: =cut
15394:
15395: ############################################################
15396: ############################################################
1.137 matthew 15397: sub DrawXYYGraph {
15398: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
15399: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 15400: #
15401: # Create the identifier for the graph
15402: my $identifier = &get_cgi_id();
15403: my $id = 'cgi.'.$identifier;
15404: #
15405: $Title = '' if (! defined($Title));
15406: $xlabel = '' if (! defined($xlabel));
15407: $ylabel = '' if (! defined($ylabel));
15408: my %ValuesHash =
15409: (
1.369 www 15410: $id.'.title' => &escape($Title),
15411: $id.'.xlabel' => &escape($xlabel),
15412: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 15413: $id.'.labels' => join(',',@$Xlabels),
15414: $id.'.PlotType' => 'XY',
15415: $id.'.NumSets' => 2,
1.137 matthew 15416: $id.'.two_axes' => 1,
15417: $id.'.y1_max_value' => $Max1,
15418: $id.'.y1_min_value' => $Min1,
15419: $id.'.y2_max_value' => $Max2,
15420: $id.'.y2_min_value' => $Min2,
1.136 matthew 15421: );
15422: #
1.137 matthew 15423: if (defined($colors) && ref($colors) eq 'ARRAY') {
15424: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
15425: }
15426: #
15427: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
15428: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 15429: return '';
15430: }
15431: my $NumSets=1;
1.137 matthew 15432: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 15433: next if (! ref($array));
15434: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 15435: }
15436: #
15437: # Deal with other parameters
15438: while (my ($key,$value) = each(%Values)) {
15439: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 15440: }
15441: #
1.646 raeburn 15442: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 15443: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 15444: }
15445:
15446: ############################################################
15447: ############################################################
15448:
15449: =pod
15450:
1.157 matthew 15451: =back
15452:
1.139 matthew 15453: =head1 Statistics helper routines?
15454:
15455: Bad place for them but what the hell.
15456:
1.157 matthew 15457: =over 4
15458:
1.648 raeburn 15459: =item * &chartlink()
1.139 matthew 15460:
15461: Returns a link to the chart for a specific student.
15462:
15463: Inputs:
15464:
15465: =over 4
15466:
15467: =item $linktext: The text of the link
15468:
15469: =item $sname: The students username
15470:
15471: =item $sdomain: The students domain
15472:
15473: =back
15474:
1.157 matthew 15475: =back
15476:
1.139 matthew 15477: =cut
15478:
15479: ############################################################
15480: ############################################################
15481: sub chartlink {
15482: my ($linktext, $sname, $sdomain) = @_;
15483: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 15484: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 15485: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 15486: '">'.$linktext.'</a>';
1.153 matthew 15487: }
15488:
15489: #######################################################
15490: #######################################################
15491:
15492: =pod
15493:
15494: =head1 Course Environment Routines
1.157 matthew 15495:
15496: =over 4
1.153 matthew 15497:
1.648 raeburn 15498: =item * &restore_course_settings()
1.153 matthew 15499:
1.648 raeburn 15500: =item * &store_course_settings()
1.153 matthew 15501:
15502: Restores/Store indicated form parameters from the course environment.
15503: Will not overwrite existing values of the form parameters.
15504:
15505: Inputs:
15506: a scalar describing the data (e.g. 'chart', 'problem_analysis')
15507:
15508: a hash ref describing the data to be stored. For example:
15509:
15510: %Save_Parameters = ('Status' => 'scalar',
15511: 'chartoutputmode' => 'scalar',
15512: 'chartoutputdata' => 'scalar',
15513: 'Section' => 'array',
1.373 raeburn 15514: 'Group' => 'array',
1.153 matthew 15515: 'StudentData' => 'array',
15516: 'Maps' => 'array');
15517:
15518: Returns: both routines return nothing
15519:
1.631 raeburn 15520: =back
15521:
1.153 matthew 15522: =cut
15523:
15524: #######################################################
15525: #######################################################
15526: sub store_course_settings {
1.496 albertel 15527: return &store_settings($env{'request.course.id'},@_);
15528: }
15529:
15530: sub store_settings {
1.153 matthew 15531: # save to the environment
15532: # appenv the same items, just to be safe
1.300 albertel 15533: my $udom = $env{'user.domain'};
15534: my $uname = $env{'user.name'};
1.496 albertel 15535: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15536: my %SaveHash;
15537: my %AppHash;
15538: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 15539: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 15540: my $envname = 'environment.'.$basename;
1.258 albertel 15541: if (exists($env{'form.'.$setting})) {
1.153 matthew 15542: # Save this value away
15543: if ($type eq 'scalar' &&
1.258 albertel 15544: (! exists($env{$envname}) ||
15545: $env{$envname} ne $env{'form.'.$setting})) {
15546: $SaveHash{$basename} = $env{'form.'.$setting};
15547: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 15548: } elsif ($type eq 'array') {
15549: my $stored_form;
1.258 albertel 15550: if (ref($env{'form.'.$setting})) {
1.153 matthew 15551: $stored_form = join(',',
15552: map {
1.369 www 15553: &escape($_);
1.258 albertel 15554: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 15555: } else {
15556: $stored_form =
1.369 www 15557: &escape($env{'form.'.$setting});
1.153 matthew 15558: }
15559: # Determine if the array contents are the same.
1.258 albertel 15560: if ($stored_form ne $env{$envname}) {
1.153 matthew 15561: $SaveHash{$basename} = $stored_form;
15562: $AppHash{$envname} = $stored_form;
15563: }
15564: }
15565: }
15566: }
15567: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 15568: $udom,$uname);
1.153 matthew 15569: if ($put_result !~ /^(ok|delayed)/) {
15570: &Apache::lonnet::logthis('unable to save form parameters, '.
15571: 'got error:'.$put_result);
15572: }
15573: # Make sure these settings stick around in this session, too
1.646 raeburn 15574: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 15575: return;
15576: }
15577:
15578: sub restore_course_settings {
1.499 albertel 15579: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 15580: }
15581:
15582: sub restore_settings {
15583: my ($context,$prefix,$Settings) = @_;
1.153 matthew 15584: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 15585: next if (exists($env{'form.'.$setting}));
1.496 albertel 15586: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 15587: '.'.$setting;
1.258 albertel 15588: if (exists($env{$envname})) {
1.153 matthew 15589: if ($type eq 'scalar') {
1.258 albertel 15590: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 15591: } elsif ($type eq 'array') {
1.258 albertel 15592: $env{'form.'.$setting} = [
1.153 matthew 15593: map {
1.369 www 15594: &unescape($_);
1.258 albertel 15595: } split(',',$env{$envname})
1.153 matthew 15596: ];
15597: }
15598: }
15599: }
1.127 matthew 15600: }
15601:
1.618 raeburn 15602: #######################################################
15603: #######################################################
15604:
15605: =pod
15606:
15607: =head1 Domain E-mail Routines
15608:
15609: =over 4
15610:
1.648 raeburn 15611: =item * &build_recipient_list()
1.618 raeburn 15612:
1.1075.2.44 raeburn 15613: Build recipient lists for following types of e-mail:
1.766 raeburn 15614: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 15615: (d) Help requests, (e) Course requests needing approval, (f) loncapa
15616: module change checking, student/employee ID conflict checks, as
15617: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
15618: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 15619:
15620: Inputs:
1.1075.2.44 raeburn 15621: defmail (scalar - email address of default recipient),
15622: mailing type (scalar: errormail, packagesmail, helpdeskmail,
15623: requestsmail, updatesmail, or idconflictsmail).
15624:
1.619 raeburn 15625: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 15626:
15627: origmail (scalar - email address of recipient from loncapa.conf,
15628: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 15629:
1.1075.2.139 raeburn 15630: $requname username of requester (if mailing type is helpdeskmail)
15631:
15632: $requdom domain of requester (if mailing type is helpdeskmail)
15633:
15634: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
15635:
1.655 raeburn 15636: Returns: comma separated list of addresses to which to send e-mail.
15637:
15638: =back
1.618 raeburn 15639:
15640: =cut
15641:
15642: ############################################################
15643: ############################################################
15644: sub build_recipient_list {
1.1075.2.139 raeburn 15645: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 15646: my @recipients;
1.1075.2.122 raeburn 15647: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 15648: my %domconfig =
1.1075.2.122 raeburn 15649: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 15650: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 15651: if (exists($domconfig{'contacts'}{$mailing})) {
15652: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
15653: my @contacts = ('adminemail','supportemail');
15654: foreach my $item (@contacts) {
15655: if ($domconfig{'contacts'}{$mailing}{$item}) {
15656: my $addr = $domconfig{'contacts'}{$item};
15657: if (!grep(/^\Q$addr\E$/,@recipients)) {
15658: push(@recipients,$addr);
15659: }
1.619 raeburn 15660: }
1.1075.2.122 raeburn 15661: }
15662: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
15663: if ($mailing eq 'helpdeskmail') {
15664: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
15665: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
15666: my @ok_bccs;
15667: foreach my $bcc (@bccs) {
15668: $bcc =~ s/^\s+//g;
15669: $bcc =~ s/\s+$//g;
15670: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15671: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15672: push(@ok_bccs,$bcc);
15673: }
15674: }
15675: }
15676: if (@ok_bccs > 0) {
15677: $allbcc = join(', ',@ok_bccs);
15678: }
15679: }
15680: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 15681: }
15682: }
1.766 raeburn 15683: } elsif ($origmail ne '') {
1.1075.2.122 raeburn 15684: $lastresort = $origmail;
1.618 raeburn 15685: }
1.1075.2.139 raeburn 15686: if ($mailing eq 'helpdeskmail') {
15687: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
15688: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
15689: my ($inststatus,$inststatus_checked);
15690: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
15691: ($env{'user.domain'} ne 'public')) {
15692: $inststatus_checked = 1;
15693: $inststatus = $env{'environment.inststatus'};
15694: }
15695: unless ($inststatus_checked) {
15696: if (($requname ne '') && ($requdom ne '')) {
15697: if (($requname =~ /^$match_username$/) &&
15698: ($requdom =~ /^$match_domain$/) &&
15699: (&Apache::lonnet::domain($requdom))) {
15700: my $requhome = &Apache::lonnet::homeserver($requname,
15701: $requdom);
15702: unless ($requhome eq 'no_host') {
15703: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
15704: $inststatus = $userenv{'inststatus'};
15705: $inststatus_checked = 1;
15706: }
15707: }
15708: }
15709: }
15710: unless ($inststatus_checked) {
15711: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
15712: my %srch = (srchby => 'email',
15713: srchdomain => $defdom,
15714: srchterm => $reqemail,
15715: srchtype => 'exact');
15716: my %srch_results = &Apache::lonnet::usersearch(\%srch);
15717: foreach my $uname (keys(%srch_results)) {
15718: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15719: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15720: $inststatus_checked = 1;
15721: last;
15722: }
15723: }
15724: unless ($inststatus_checked) {
15725: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
15726: if ($dirsrchres eq 'ok') {
15727: foreach my $uname (keys(%srch_results)) {
15728: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
15729: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
15730: $inststatus_checked = 1;
15731: last;
15732: }
15733: }
15734: }
15735: }
15736: }
15737: }
15738: if ($inststatus ne '') {
15739: foreach my $status (split(/\:/,$inststatus)) {
15740: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
15741: my @contacts = ('adminemail','supportemail');
15742: foreach my $item (@contacts) {
15743: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
15744: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
15745: if (!grep(/^\Q$addr\E$/,@recipients)) {
15746: push(@recipients,$addr);
15747: }
15748: }
15749: }
15750: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
15751: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
15752: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
15753: my @ok_bccs;
15754: foreach my $bcc (@bccs) {
15755: $bcc =~ s/^\s+//g;
15756: $bcc =~ s/\s+$//g;
15757: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15758: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15759: push(@ok_bccs,$bcc);
15760: }
15761: }
15762: }
15763: if (@ok_bccs > 0) {
15764: $allbcc = join(', ',@ok_bccs);
15765: }
15766: }
15767: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
15768: last;
15769: }
15770: }
15771: }
15772: }
15773: }
1.619 raeburn 15774: } elsif ($origmail ne '') {
1.1075.2.122 raeburn 15775: $lastresort = $origmail;
15776: }
1.1075.2.128 raeburn 15777: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1075.2.122 raeburn 15778: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
15779: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
15780: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
15781: my %what = (
15782: perlvar => 1,
15783: );
15784: my $primary = &Apache::lonnet::domain($defdom,'primary');
15785: if ($primary) {
15786: my $gotaddr;
15787: my ($result,$returnhash) =
15788: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
15789: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
15790: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
15791: $lastresort = $returnhash->{'lonSupportEMail'};
15792: $gotaddr = 1;
15793: }
15794: }
15795: unless ($gotaddr) {
15796: my $uintdom = &Apache::lonnet::internet_dom($primary);
15797: my $intdom = &Apache::lonnet::internet_dom($lonhost);
15798: unless ($uintdom eq $intdom) {
15799: my %domconfig =
15800: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
15801: if (ref($domconfig{'contacts'}) eq 'HASH') {
15802: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
15803: my @contacts = ('adminemail','supportemail');
15804: foreach my $item (@contacts) {
15805: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
15806: my $addr = $domconfig{'contacts'}{$item};
15807: if (!grep(/^\Q$addr\E$/,@recipients)) {
15808: push(@recipients,$addr);
15809: }
15810: }
15811: }
15812: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
15813: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
15814: }
15815: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
15816: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
15817: my @ok_bccs;
15818: foreach my $bcc (@bccs) {
15819: $bcc =~ s/^\s+//g;
15820: $bcc =~ s/\s+$//g;
15821: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
15822: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
15823: push(@ok_bccs,$bcc);
15824: }
15825: }
15826: }
15827: if (@ok_bccs > 0) {
15828: $allbcc = join(', ',@ok_bccs);
15829: }
15830: }
15831: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
15832: }
15833: }
15834: }
15835: }
15836: }
15837: }
1.618 raeburn 15838: }
1.688 raeburn 15839: if (defined($defmail)) {
15840: if ($defmail ne '') {
15841: push(@recipients,$defmail);
15842: }
1.618 raeburn 15843: }
15844: if ($otheremails) {
1.619 raeburn 15845: my @others;
15846: if ($otheremails =~ /,/) {
15847: @others = split(/,/,$otheremails);
1.618 raeburn 15848: } else {
1.619 raeburn 15849: push(@others,$otheremails);
15850: }
15851: foreach my $addr (@others) {
15852: if (!grep(/^\Q$addr\E$/,@recipients)) {
15853: push(@recipients,$addr);
15854: }
1.618 raeburn 15855: }
15856: }
1.1075.2.128 raeburn 15857: if ($mailing eq 'helpdeskmail') {
1.1075.2.122 raeburn 15858: if ((!@recipients) && ($lastresort ne '')) {
15859: push(@recipients,$lastresort);
15860: }
15861: } elsif ($lastresort ne '') {
15862: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
15863: push(@recipients,$lastresort);
15864: }
15865: }
15866: my $recipientlist = join(',',@recipients);
15867: if (wantarray) {
15868: return ($recipientlist,$allbcc,$addtext);
15869: } else {
15870: return $recipientlist;
15871: }
1.618 raeburn 15872: }
15873:
1.127 matthew 15874: ############################################################
15875: ############################################################
1.154 albertel 15876:
1.655 raeburn 15877: =pod
15878:
15879: =head1 Course Catalog Routines
15880:
15881: =over 4
15882:
15883: =item * &gather_categories()
15884:
15885: Converts category definitions - keys of categories hash stored in
15886: coursecategories in configuration.db on the primary library server in a
15887: domain - to an array. Also generates javascript and idx hash used to
15888: generate Domain Coordinator interface for editing Course Categories.
15889:
15890: Inputs:
1.663 raeburn 15891:
1.655 raeburn 15892: categories (reference to hash of category definitions).
1.663 raeburn 15893:
1.655 raeburn 15894: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15895: categories and subcategories).
1.663 raeburn 15896:
1.655 raeburn 15897: idx (reference to hash of counters used in Domain Coordinator interface for
15898: editing Course Categories).
1.663 raeburn 15899:
1.655 raeburn 15900: jsarray (reference to array of categories used to create Javascript arrays for
15901: Domain Coordinator interface for editing Course Categories).
15902:
15903: Returns: nothing
15904:
15905: Side effects: populates cats, idx and jsarray.
15906:
15907: =cut
15908:
15909: sub gather_categories {
15910: my ($categories,$cats,$idx,$jsarray) = @_;
15911: my %counters;
15912: my $num = 0;
15913: foreach my $item (keys(%{$categories})) {
15914: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
15915: if ($container eq '' && $depth == 0) {
15916: $cats->[$depth][$categories->{$item}] = $cat;
15917: } else {
15918: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
15919: }
15920: my ($escitem,$tail) = split(/:/,$item,2);
15921: if ($counters{$tail} eq '') {
15922: $counters{$tail} = $num;
15923: $num ++;
15924: }
15925: if (ref($idx) eq 'HASH') {
15926: $idx->{$item} = $counters{$tail};
15927: }
15928: if (ref($jsarray) eq 'ARRAY') {
15929: push(@{$jsarray->[$counters{$tail}]},$item);
15930: }
15931: }
15932: return;
15933: }
15934:
15935: =pod
15936:
15937: =item * &extract_categories()
15938:
15939: Used to generate breadcrumb trails for course categories.
15940:
15941: Inputs:
1.663 raeburn 15942:
1.655 raeburn 15943: categories (reference to hash of category definitions).
1.663 raeburn 15944:
1.655 raeburn 15945: cats (reference to array of arrays/hashes which encapsulates hierarchy of
15946: categories and subcategories).
1.663 raeburn 15947:
1.655 raeburn 15948: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 15949:
1.655 raeburn 15950: allitems (reference to hash - key is category key
15951: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 15952:
1.655 raeburn 15953: idx (reference to hash of counters used in Domain Coordinator interface for
15954: editing Course Categories).
1.663 raeburn 15955:
1.655 raeburn 15956: jsarray (reference to array of categories used to create Javascript arrays for
15957: Domain Coordinator interface for editing Course Categories).
15958:
1.665 raeburn 15959: subcats (reference to hash of arrays containing all subcategories within each
15960: category, -recursive)
15961:
1.1075.2.132 raeburn 15962: maxd (reference to hash used to hold max depth for all top-level categories).
15963:
1.655 raeburn 15964: Returns: nothing
15965:
15966: Side effects: populates trails and allitems hash references.
15967:
15968: =cut
15969:
15970: sub extract_categories {
1.1075.2.132 raeburn 15971: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 15972: if (ref($categories) eq 'HASH') {
15973: &gather_categories($categories,$cats,$idx,$jsarray);
15974: if (ref($cats->[0]) eq 'ARRAY') {
15975: for (my $i=0; $i<@{$cats->[0]}; $i++) {
15976: my $name = $cats->[0][$i];
15977: my $item = &escape($name).'::0';
15978: my $trailstr;
15979: if ($name eq 'instcode') {
15980: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 15981: } elsif ($name eq 'communities') {
15982: $trailstr = &mt('Communities');
1.655 raeburn 15983: } else {
15984: $trailstr = $name;
15985: }
15986: if ($allitems->{$item} eq '') {
15987: push(@{$trails},$trailstr);
15988: $allitems->{$item} = scalar(@{$trails})-1;
15989: }
15990: my @parents = ($name);
15991: if (ref($cats->[1]{$name}) eq 'ARRAY') {
15992: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
15993: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 15994: if (ref($subcats) eq 'HASH') {
15995: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
15996: }
1.1075.2.132 raeburn 15997: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 15998: }
15999: } else {
16000: if (ref($subcats) eq 'HASH') {
16001: $subcats->{$item} = [];
1.655 raeburn 16002: }
1.1075.2.132 raeburn 16003: if (ref($maxd) eq 'HASH') {
16004: $maxd->{$name} = 1;
16005: }
1.655 raeburn 16006: }
16007: }
16008: }
16009: }
16010: return;
16011: }
16012:
16013: =pod
16014:
1.1075.2.56 raeburn 16015: =item * &recurse_categories()
1.655 raeburn 16016:
16017: Recursively used to generate breadcrumb trails for course categories.
16018:
16019: Inputs:
1.663 raeburn 16020:
1.655 raeburn 16021: cats (reference to array of arrays/hashes which encapsulates hierarchy of
16022: categories and subcategories).
1.663 raeburn 16023:
1.655 raeburn 16024: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 16025:
16026: category (current course category, for which breadcrumb trail is being generated).
16027:
16028: trails (reference to array of breadcrumb trails for each category).
16029:
1.655 raeburn 16030: allitems (reference to hash - key is category key
16031: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 16032:
1.655 raeburn 16033: parents (array containing containers directories for current category,
16034: back to top level).
16035:
16036: Returns: nothing
16037:
16038: Side effects: populates trails and allitems hash references
16039:
16040: =cut
16041:
16042: sub recurse_categories {
1.1075.2.132 raeburn 16043: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 16044: my $shallower = $depth - 1;
16045: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
16046: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
16047: my $name = $cats->[$depth]{$category}[$k];
16048: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.161. .4(raebu 16049:22): my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16050: if ($allitems->{$item} eq '') {
16051: push(@{$trails},$trailstr);
16052: $allitems->{$item} = scalar(@{$trails})-1;
16053: }
16054: my $deeper = $depth+1;
16055: push(@{$parents},$category);
1.665 raeburn 16056: if (ref($subcats) eq 'HASH') {
16057: my $subcat = &escape($name).':'.$category.':'.$depth;
16058: for (my $j=@{$parents}; $j>=0; $j--) {
16059: my $higher;
16060: if ($j > 0) {
16061: $higher = &escape($parents->[$j]).':'.
16062: &escape($parents->[$j-1]).':'.$j;
16063: } else {
16064: $higher = &escape($parents->[$j]).'::'.$j;
16065: }
16066: push(@{$subcats->{$higher}},$subcat);
16067: }
16068: }
16069: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1075.2.132 raeburn 16070: $subcats,$maxd);
1.655 raeburn 16071: pop(@{$parents});
16072: }
16073: } else {
16074: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.132 raeburn 16075: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 16076: if ($allitems->{$item} eq '') {
16077: push(@{$trails},$trailstr);
16078: $allitems->{$item} = scalar(@{$trails})-1;
16079: }
1.1075.2.132 raeburn 16080: if (ref($maxd) eq 'HASH') {
16081: if ($depth > $maxd->{$parents->[0]}) {
16082: $maxd->{$parents->[0]} = $depth;
16083: }
16084: }
1.655 raeburn 16085: }
16086: return;
16087: }
16088:
1.663 raeburn 16089: =pod
16090:
1.1075.2.56 raeburn 16091: =item * &assign_categories_table()
1.663 raeburn 16092:
16093: Create a datatable for display of hierarchical categories in a domain,
16094: with checkboxes to allow a course to be categorized.
16095:
16096: Inputs:
16097:
16098: cathash - reference to hash of categories defined for the domain (from
16099: configuration.db)
16100:
16101: currcat - scalar with an & separated list of categories assigned to a course.
16102:
1.919 raeburn 16103: type - scalar contains course type (Course or Community).
16104:
1.1075.2.117 raeburn 16105: disabled - scalar (optional) contains disabled="disabled" if input elements are
16106: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16107:
1.663 raeburn 16108: Returns: $output (markup to be displayed)
16109:
16110: =cut
16111:
16112: sub assign_categories_table {
1.1075.2.117 raeburn 16113: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 16114: my $output;
16115: if (ref($cathash) eq 'HASH') {
1.1075.2.132 raeburn 16116: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
16117: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 16118: $maxdepth = scalar(@cats);
16119: if (@cats > 0) {
16120: my $itemcount = 0;
16121: if (ref($cats[0]) eq 'ARRAY') {
16122: my @currcategories;
16123: if ($currcat ne '') {
16124: @currcategories = split('&',$currcat);
16125: }
1.919 raeburn 16126: my $table;
1.663 raeburn 16127: for (my $i=0; $i<@{$cats[0]}; $i++) {
16128: my $parent = $cats[0][$i];
1.919 raeburn 16129: next if ($parent eq 'instcode');
16130: if ($type eq 'Community') {
16131: next unless ($parent eq 'communities');
16132: } else {
16133: next if ($parent eq 'communities');
16134: }
1.663 raeburn 16135: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
16136: my $item = &escape($parent).'::0';
16137: my $checked = '';
16138: if (@currcategories > 0) {
16139: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 16140: $checked = ' checked="checked"';
1.663 raeburn 16141: }
16142: }
1.919 raeburn 16143: my $parent_title = $parent;
16144: if ($parent eq 'communities') {
16145: $parent_title = &mt('Communities');
16146: }
16147: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
16148: '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117 raeburn 16149: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 16150: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 16151: my $depth = 1;
16152: push(@path,$parent);
1.1075.2.117 raeburn 16153: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 16154: pop(@path);
1.919 raeburn 16155: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 16156: $itemcount ++;
16157: }
1.919 raeburn 16158: if ($itemcount) {
16159: $output = &Apache::loncommon::start_data_table().
16160: $table.
16161: &Apache::loncommon::end_data_table();
16162: }
1.663 raeburn 16163: }
16164: }
16165: }
16166: return $output;
16167: }
16168:
16169: =pod
16170:
1.1075.2.56 raeburn 16171: =item * &assign_category_rows()
1.663 raeburn 16172:
16173: Create a datatable row for display of nested categories in a domain,
16174: with checkboxes to allow a course to be categorized,called recursively.
16175:
16176: Inputs:
16177:
16178: itemcount - track row number for alternating colors
16179:
16180: cats - reference to array of arrays/hashes which encapsulates hierarchy of
16181: categories and subcategories.
16182:
16183: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
16184:
16185: parent - parent of current category item
16186:
16187: path - Array containing all categories back up through the hierarchy from the
16188: current category to the top level.
16189:
16190: currcategories - reference to array of current categories assigned to the course
16191:
1.1075.2.117 raeburn 16192: disabled - scalar (optional) contains disabled="disabled" if input elements are
16193: to be readonly (e.g., Domain Helpdesk role viewing course settings).
16194:
1.663 raeburn 16195: Returns: $output (markup to be displayed).
16196:
16197: =cut
16198:
16199: sub assign_category_rows {
1.1075.2.117 raeburn 16200: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 16201: my ($text,$name,$item,$chgstr);
16202: if (ref($cats) eq 'ARRAY') {
16203: my $maxdepth = scalar(@{$cats});
16204: if (ref($cats->[$depth]) eq 'HASH') {
16205: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
16206: my $numchildren = @{$cats->[$depth]{$parent}};
16207: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 16208: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 16209: for (my $j=0; $j<$numchildren; $j++) {
16210: $name = $cats->[$depth]{$parent}[$j];
16211: $item = &escape($name).':'.&escape($parent).':'.$depth;
16212: my $deeper = $depth+1;
16213: my $checked = '';
16214: if (ref($currcategories) eq 'ARRAY') {
16215: if (@{$currcategories} > 0) {
16216: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 16217: $checked = ' checked="checked"';
1.663 raeburn 16218: }
16219: }
16220: }
1.664 raeburn 16221: $text .= '<tr><td><span class="LC_nobreak"><label>'.
16222: '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117 raeburn 16223: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 16224: '<input type="hidden" name="catname" value="'.$name.'" />'.
16225: '</td><td>';
1.663 raeburn 16226: if (ref($path) eq 'ARRAY') {
16227: push(@{$path},$name);
1.1075.2.117 raeburn 16228: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 16229: pop(@{$path});
16230: }
16231: $text .= '</td></tr>';
16232: }
16233: $text .= '</table></td>';
16234: }
16235: }
16236: }
16237: return $text;
16238: }
16239:
1.1075.2.69 raeburn 16240: =pod
16241:
16242: =back
16243:
16244: =cut
16245:
1.655 raeburn 16246: ############################################################
16247: ############################################################
16248:
16249:
1.443 albertel 16250: sub commit_customrole {
1.664 raeburn 16251: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 16252: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 16253: ($start?', '.&mt('starting').' '.localtime($start):'').
16254: ($end?', ending '.localtime($end):'').': <b>'.
16255: &Apache::lonnet::assigncustomrole(
1.664 raeburn 16256: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 16257: '</b><br />';
16258: return $output;
16259: }
16260:
16261: sub commit_standardrole {
1.1075.2.31 raeburn 16262: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 16263: my ($output,$logmsg,$linefeed);
16264: if ($context eq 'auto') {
16265: $linefeed = "\n";
16266: } else {
16267: $linefeed = "<br />\n";
16268: }
1.443 albertel 16269: if ($three eq 'st') {
1.541 raeburn 16270: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 16271: $one,$two,$sec,$context,$credits);
1.541 raeburn 16272: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 16273: ($result eq 'unknown_course') || ($result eq 'refused')) {
16274: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 16275: } else {
1.541 raeburn 16276: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 16277: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16278: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
16279: if ($context eq 'auto') {
16280: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
16281: } else {
16282: $output .= '<b>'.$result.'</b>'.$linefeed.
16283: &mt('Add to classlist').': <b>ok</b>';
16284: }
16285: $output .= $linefeed;
1.443 albertel 16286: }
16287: } else {
16288: $output = &mt('Assigning').' '.$three.' in '.$url.
16289: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 16290: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 16291: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 16292: if ($context eq 'auto') {
16293: $output .= $result.$linefeed;
16294: } else {
16295: $output .= '<b>'.$result.'</b>'.$linefeed;
16296: }
1.443 albertel 16297: }
16298: return $output;
16299: }
16300:
16301: sub commit_studentrole {
1.1075.2.31 raeburn 16302: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
16303: $credits) = @_;
1.626 raeburn 16304: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 16305: if ($context eq 'auto') {
16306: $linefeed = "\n";
16307: } else {
16308: $linefeed = '<br />'."\n";
16309: }
1.443 albertel 16310: if (defined($one) && defined($two)) {
16311: my $cid=$one.'_'.$two;
16312: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
16313: my $secchange = 0;
16314: my $expire_role_result;
16315: my $modify_section_result;
1.628 raeburn 16316: if ($oldsec ne '-1') {
16317: if ($oldsec ne $sec) {
1.443 albertel 16318: $secchange = 1;
1.628 raeburn 16319: my $now = time;
1.443 albertel 16320: my $uurl='/'.$cid;
16321: $uurl=~s/\_/\//g;
16322: if ($oldsec) {
16323: $uurl.='/'.$oldsec;
16324: }
1.626 raeburn 16325: $oldsecurl = $uurl;
1.628 raeburn 16326: $expire_role_result =
1.1075.2.161. .14(raeb 16327:-23): &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','','',$context);
1.628 raeburn 16328: if ($env{'request.course.sec'} ne '') {
16329: if ($expire_role_result eq 'refused') {
16330: my @roles = ('st');
16331: my @statuses = ('previous');
16332: my @roledoms = ($one);
16333: my $withsec = 1;
16334: my %roleshash =
16335: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
16336: \@statuses,\@roles,\@roledoms,$withsec);
16337: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
16338: my ($oldstart,$oldend) =
16339: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
16340: if ($oldend > 0 && $oldend <= $now) {
16341: $expire_role_result = 'ok';
16342: }
16343: }
16344: }
16345: }
1.443 albertel 16346: $result = $expire_role_result;
16347: }
16348: }
16349: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 16350: $modify_section_result =
16351: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
16352: undef,undef,undef,$sec,
16353: $end,$start,'','',$cid,
16354: '',$context,$credits);
1.443 albertel 16355: if ($modify_section_result =~ /^ok/) {
16356: if ($secchange == 1) {
1.628 raeburn 16357: if ($sec eq '') {
16358: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
16359: } else {
16360: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
16361: }
1.443 albertel 16362: } elsif ($oldsec eq '-1') {
1.628 raeburn 16363: if ($sec eq '') {
16364: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
16365: } else {
16366: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16367: }
1.443 albertel 16368: } else {
1.628 raeburn 16369: if ($sec eq '') {
16370: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
16371: } else {
16372: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
16373: }
1.443 albertel 16374: }
16375: } else {
1.628 raeburn 16376: if ($secchange) {
16377: $$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;
16378: } else {
16379: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
16380: }
1.443 albertel 16381: }
16382: $result = $modify_section_result;
16383: } elsif ($secchange == 1) {
1.628 raeburn 16384: if ($oldsec eq '') {
1.1075.2.20 raeburn 16385: $$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 16386: } else {
16387: $$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;
16388: }
1.626 raeburn 16389: if ($expire_role_result eq 'refused') {
16390: my $newsecurl = '/'.$cid;
16391: $newsecurl =~ s/\_/\//g;
16392: if ($sec ne '') {
16393: $newsecurl.='/'.$sec;
16394: }
16395: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
16396: if ($sec eq '') {
16397: $$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;
16398: } else {
16399: $$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;
16400: }
16401: }
16402: }
1.443 albertel 16403: }
16404: } else {
1.626 raeburn 16405: $$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 16406: $result = "error: incomplete course id\n";
16407: }
16408: return $result;
16409: }
16410:
1.1075.2.25 raeburn 16411: sub show_role_extent {
16412: my ($scope,$context,$role) = @_;
16413: $scope =~ s{^/}{};
16414: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
16415: push(@courseroles,'co');
16416: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
16417: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
16418: $scope =~ s{/}{_};
16419: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
16420: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
16421: my ($audom,$auname) = split(/\//,$scope);
16422: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
16423: &Apache::loncommon::plainname($auname,$audom).'</span>');
16424: } else {
16425: $scope =~ s{/$}{};
16426: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
16427: &Apache::lonnet::domain($scope,'description').'</span>');
16428: }
16429: }
16430:
1.443 albertel 16431: ############################################################
16432: ############################################################
16433:
1.566 albertel 16434: sub check_clone {
1.578 raeburn 16435: my ($args,$linefeed) = @_;
1.566 albertel 16436: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
16437: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
16438: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
1.1075.2.161. .1(raebu 16439:21): my $clonetitle;
16440:21): my @clonemsg;
1.566 albertel 16441: my $can_clone = 0;
1.944 raeburn 16442: my $lctype = lc($args->{'crstype'});
1.908 raeburn 16443: if ($lctype ne 'community') {
16444: $lctype = 'course';
16445: }
1.566 albertel 16446: if ($clonehome eq 'no_host') {
1.944 raeburn 16447: if ($args->{'crstype'} eq 'Community') {
1.1075.2.161. .1(raebu 16448:21): push(@clonemsg,({
16449:21): mt => 'No new community created.',
16450:21): args => [],
16451:21): },
16452:21): {
16453:21): mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
16454:21): args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
16455:21): }));
1.908 raeburn 16456: } else {
1.1075.2.161. .1(raebu 16457:21): push(@clonemsg,({
16458:21): mt => 'No new course created.',
16459:21): args => [],
16460:21): },
16461:21): {
16462:21): mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
16463:21): args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16464:21): }));
16465:21): }
1.566 albertel 16466: } else {
16467: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.1075.2.161. .1(raebu 16468:21): $clonetitle = $clonedesc{'description'};
1.944 raeburn 16469: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 16470: if ($clonedesc{'type'} ne 'Community') {
1.1075.2.161. .1(raebu 16471:21): push(@clonemsg,({
16472:21): mt => 'No new community created.',
16473:21): args => [],
16474:21): },
16475:21): {
16476:21): mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
16477:21): args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
16478:21): }));
16479:21): return ($can_clone,\@clonemsg,$cloneid,$clonehome);
1.908 raeburn 16480: }
16481: }
1.1075.2.119 raeburn 16482: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 16483: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 16484: $can_clone = 1;
16485: } else {
1.1075.2.95 raeburn 16486: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 16487: $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95 raeburn 16488: if ($clonehash{'cloners'} eq '') {
16489: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
16490: if ($domdefs{'canclone'}) {
16491: unless ($domdefs{'canclone'} eq 'none') {
16492: if ($domdefs{'canclone'} eq 'domain') {
16493: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
16494: $can_clone = 1;
16495: }
16496: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16497: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
16498: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
16499: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
16500: $can_clone = 1;
16501: }
16502: }
16503: }
1.908 raeburn 16504: }
1.1075.2.95 raeburn 16505: } else {
16506: my @cloners = split(/,/,$clonehash{'cloners'});
16507: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 16508: $can_clone = 1;
1.1075.2.95 raeburn 16509: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 16510: $can_clone = 1;
1.1075.2.96 raeburn 16511: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
16512: $can_clone = 1;
1.1075.2.95 raeburn 16513: }
16514: unless ($can_clone) {
1.1075.2.96 raeburn 16515: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
16516: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1075.2.95 raeburn 16517: my (%gotdomdefaults,%gotcodedefaults);
16518: foreach my $cloner (@cloners) {
16519: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
16520: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
16521: my (%codedefaults,@code_order);
16522: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
16523: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
16524: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
16525: }
16526: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
16527: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
16528: }
16529: } else {
16530: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
16531: \%codedefaults,
16532: \@code_order);
16533: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
16534: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
16535: }
16536: if (@code_order > 0) {
16537: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
16538: $cloner,$clonehash{'internal.coursecode'},
16539: $args->{'crscode'})) {
16540: $can_clone = 1;
16541: last;
16542: }
16543: }
16544: }
16545: }
16546: }
1.1075.2.96 raeburn 16547: }
16548: }
16549: unless ($can_clone) {
16550: my $ccrole = 'cc';
16551: if ($args->{'crstype'} eq 'Community') {
16552: $ccrole = 'co';
16553: }
16554: my %roleshash =
16555: &Apache::lonnet::get_my_roles($args->{'ccuname'},
16556: $args->{'ccdomain'},
16557: 'userroles',['active'],[$ccrole],
16558: [$args->{'clonedomain'}]);
16559: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
16560: $can_clone = 1;
16561: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
16562: $args->{'ccuname'},$args->{'ccdomain'})) {
16563: $can_clone = 1;
1.1075.2.95 raeburn 16564: }
16565: }
16566: unless ($can_clone) {
16567: if ($args->{'crstype'} eq 'Community') {
1.1075.2.161. .1(raebu 16568:21): push(@clonemsg,({
16569:21): mt => 'No new community created.',
16570:21): args => [],
16571:21): },
16572:21): {
16573:21): 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]).',
16574:21): args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16575:21): }));
1.1075.2.95 raeburn 16576: } else {
1.1075.2.161. .1(raebu 16577:21): push(@clonemsg,({
16578:21): mt => 'No new course created.',
16579:21): args => [],
16580:21): },
16581:21): {
16582:21): 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]).',
16583:21): args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
16584:21): }));
1.578 raeburn 16585: }
1.566 albertel 16586: }
1.578 raeburn 16587: }
1.566 albertel 16588: }
1.1075.2.161. .1(raebu 16589:21): return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16590: }
16591:
1.444 albertel 16592: sub construct_course {
1.1075.2.119 raeburn 16593: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
1.1075.2.161. .1(raebu 16594:21): $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
16595:21): my ($outcome,$msgref,$clonemsgref);
1.541 raeburn 16596: my $linefeed = '<br />'."\n";
16597: if ($context eq 'auto') {
16598: $linefeed = "\n";
16599: }
1.566 albertel 16600:
16601: #
16602: # Are we cloning?
16603: #
1.1075.2.161. .1(raebu 16604:21): my ($can_clone,$cloneid,$clonehome,$clonetitle);
1.566 albertel 16605: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.1075.2.161. .1(raebu 16606:21): ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
1.566 albertel 16607: if (!$can_clone) {
1.1075.2.161. .1(raebu 16608:21): return (0,$outcome,$clonemsgref);
1.566 albertel 16609: }
16610: }
16611:
1.444 albertel 16612: #
16613: # Open course
16614: #
16615: my $crstype = lc($args->{'crstype'});
16616: my %cenv=();
16617: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
16618: $args->{'cdescr'},
16619: $args->{'curl'},
16620: $args->{'course_home'},
16621: $args->{'nonstandard'},
16622: $args->{'crscode'},
16623: $args->{'ccuname'}.':'.
16624: $args->{'ccdomain'},
1.882 raeburn 16625: $args->{'crstype'},
1.1075.2.161. .1(raebu 16626:21): $cnum,$context,$category,
16627:21): $callercontext);
1.444 albertel 16628:
16629: # Note: The testing routines depend on this being output; see
16630: # Utils::Course. This needs to at least be output as a comment
16631: # if anyone ever decides to not show this, and Utils::Course::new
16632: # will need to be suitably modified.
1.1075.2.161. .1(raebu 16633:21): if (($callercontext eq 'auto') && ($user_lh ne '')) {
16634:21): $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
16635:21): } else {
16636:21): $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
16637:21): }
1.943 raeburn 16638: if ($$courseid =~ /^error:/) {
1.1075.2.161. .1(raebu 16639:21): return (0,$outcome,$clonemsgref);
1.943 raeburn 16640: }
16641:
1.444 albertel 16642: #
16643: # Check if created correctly
16644: #
1.479 albertel 16645: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 16646: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 16647: if ($crsuhome eq 'no_host') {
1.1075.2.161. .1(raebu 16648:21): if (($callercontext eq 'auto') && ($user_lh ne '')) {
16649:21): $outcome .= &mt_user($user_lh,
16650:21): 'Course creation failed, unrecognized course home server.');
16651:21): } else {
16652:21): $outcome .= &mt('Course creation failed, unrecognized course home server.');
16653:21): }
16654:21): $outcome .= $linefeed;
16655:21): return (0,$outcome,$clonemsgref);
1.943 raeburn 16656: }
1.541 raeburn 16657: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 16658:
1.444 albertel 16659: #
1.566 albertel 16660: # Do the cloning
1.1075.2.161. .1(raebu 16661:21): #
16662:21): my @clonemsg;
1.566 albertel 16663: if ($can_clone && $cloneid) {
1.1075.2.161. .1(raebu 16664:21): push(@clonemsg,
16665:21): {
16666:21): mt => 'Created [_1] by cloning from [_2]',
16667:21): args => [$crstype,$clonetitle],
16668:21): });
1.566 albertel 16669: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 16670: # Copy all files
1.1075.2.161. .1(raebu 16671:21): my @info =
16672:21): &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
16673:21): $args->{'dateshift'},$args->{'crscode'},
16674:21): $args->{'ccuname'}.':'.$args->{'ccdomain'},
16675:21): $args->{'tinyurls'});
16676:21): if (@info) {
16677:21): push(@clonemsg,@info);
16678:21): }
1.444 albertel 16679: # Restore URL
1.566 albertel 16680: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 16681: # Restore title
1.566 albertel 16682: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 16683: # Restore creation date, creator and creation context.
16684: $cenv{'internal.created'}=$oldcenv{'internal.created'};
16685: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
16686: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 16687: # Mark as cloned
1.566 albertel 16688: $cenv{'clonedfrom'}=$cloneid;
1.638 www 16689: # Need to clone grading mode
16690: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
16691: $cenv{'grading'}=$newenv{'grading'};
16692: # Do not clone these environment entries
16693: &Apache::lonnet::del('environment',
16694: ['default_enrollment_start_date',
16695: 'default_enrollment_end_date',
16696: 'question.email',
16697: 'policy.email',
16698: 'comment.email',
16699: 'pch.users.denied',
1.725 raeburn 16700: 'plc.users.denied',
16701: 'hidefromcat',
1.1075.2.36 raeburn 16702: 'checkforpriv',
1.1075.2.158 raeburn 16703: 'categories'],
1.638 www 16704: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 16705: if ($args->{'textbook'}) {
16706: $cenv{'internal.textbook'} = $args->{'textbook'};
16707: }
1.444 albertel 16708: }
1.566 albertel 16709:
1.444 albertel 16710: #
16711: # Set environment (will override cloned, if existing)
16712: #
16713: my @sections = ();
16714: my @xlists = ();
16715: if ($args->{'crstype'}) {
16716: $cenv{'type'}=$args->{'crstype'};
16717: }
1.1075.2.161. .17(raeb 16718:-23): if ($args->{'lti'}) {
16719:-23): $cenv{'internal.lti'}=$args->{'lti'};
16720:-23): }
1.444 albertel 16721: if ($args->{'crsid'}) {
16722: $cenv{'courseid'}=$args->{'crsid'};
16723: }
16724: if ($args->{'crscode'}) {
16725: $cenv{'internal.coursecode'}=$args->{'crscode'};
16726: }
16727: if ($args->{'crsquota'} ne '') {
16728: $cenv{'internal.coursequota'}=$args->{'crsquota'};
16729: } else {
16730: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
16731: }
16732: if ($args->{'ccuname'}) {
16733: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
16734: ':'.$args->{'ccdomain'};
16735: } else {
16736: $cenv{'internal.courseowner'} = $args->{'curruser'};
16737: }
1.1075.2.31 raeburn 16738: if ($args->{'defaultcredits'}) {
16739: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
16740: }
1.444 albertel 16741: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
1.1075.2.161. .20(raeb 16742:-23): my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
1.444 albertel 16743: if ($args->{'crssections'}) {
16744: $cenv{'internal.sectionnums'} = '';
16745: if ($args->{'crssections'} =~ m/,/) {
16746: @sections = split/,/,$args->{'crssections'};
16747: } else {
16748: $sections[0] = $args->{'crssections'};
16749: }
16750: if (@sections > 0) {
16751: foreach my $item (@sections) {
16752: my ($sec,$gp) = split/:/,$item;
16753: my $class = $args->{'crscode'}.$sec;
16754: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
16755: $cenv{'internal.sectionnums'} .= $item.',';
1.1075.2.161. .20(raeb 16756:-23): if ($addcheck eq 'ok') {
16757:-23): unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
16758:-23): push(@oklcsecs,$gp);
16759:-23): }
16760:-23): } else {
1.1075.2.119 raeburn 16761: push(@badclasses,$class);
1.444 albertel 16762: }
16763: }
16764: $cenv{'internal.sectionnums'} =~ s/,$//;
16765: }
16766: }
16767: # do not hide course coordinator from staff listing,
16768: # even if privileged
16769: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 16770: # add course coordinator's domain to domains to check for privileged users
16771: # if different to course domain
16772: if ($$crsudom ne $args->{'ccdomain'}) {
16773: $cenv{'checkforpriv'} = $args->{'ccdomain'};
16774: }
1.444 albertel 16775: # add crosslistings
16776: if ($args->{'crsxlist'}) {
16777: $cenv{'internal.crosslistings'}='';
16778: if ($args->{'crsxlist'} =~ m/,/) {
16779: @xlists = split/,/,$args->{'crsxlist'};
16780: } else {
16781: $xlists[0] = $args->{'crsxlist'};
16782: }
16783: if (@xlists > 0) {
16784: foreach my $item (@xlists) {
16785: my ($xl,$gp) = split/:/,$item;
16786: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
16787: $cenv{'internal.crosslistings'} .= $item.',';
1.1075.2.161. .20(raeb 16788:-23): if ($addcheck eq 'ok') {
16789:-23): unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
16790:-23): push(@oklcsecs,$gp);
16791:-23): }
16792:-23): } else {
1.1075.2.119 raeburn 16793: push(@badclasses,$xl);
1.444 albertel 16794: }
16795: }
16796: $cenv{'internal.crosslistings'} =~ s/,$//;
16797: }
16798: }
16799: if ($args->{'autoadds'}) {
16800: $cenv{'internal.autoadds'}=$args->{'autoadds'};
16801: }
16802: if ($args->{'autodrops'}) {
16803: $cenv{'internal.autodrops'}=$args->{'autodrops'};
16804: }
16805: # check for notification of enrollment changes
16806: my @notified = ();
16807: if ($args->{'notify_owner'}) {
16808: if ($args->{'ccuname'} ne '') {
16809: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
16810: }
16811: }
16812: if ($args->{'notify_dc'}) {
16813: if ($uname ne '') {
1.630 raeburn 16814: push(@notified,$uname.':'.$udom);
1.444 albertel 16815: }
16816: }
16817: if (@notified > 0) {
16818: my $notifylist;
16819: if (@notified > 1) {
16820: $notifylist = join(',',@notified);
16821: } else {
16822: $notifylist = $notified[0];
16823: }
16824: $cenv{'internal.notifylist'} = $notifylist;
16825: }
16826: if (@badclasses > 0) {
16827: my %lt=&Apache::lonlocal::texthash(
1.1075.2.119 raeburn 16828: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
16829: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
16830: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 16831: );
1.1075.2.119 raeburn 16832: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
16833: &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 16834: if ($context eq 'auto') {
16835: $outcome .= $badclass_msg.$linefeed;
1.1075.2.119 raeburn 16836: } else {
1.566 albertel 16837: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1075.2.119 raeburn 16838: }
16839: foreach my $item (@badclasses) {
1.541 raeburn 16840: if ($context eq 'auto') {
1.1075.2.119 raeburn 16841: $outcome .= " - $item\n";
1.541 raeburn 16842: } else {
1.1075.2.119 raeburn 16843: $outcome .= "<li>$item</li>\n";
1.541 raeburn 16844: }
1.1075.2.119 raeburn 16845: }
16846: if ($context eq 'auto') {
16847: $outcome .= $linefeed;
16848: } else {
16849: $outcome .= "</ul><br /><br /></div>\n";
16850: }
1.444 albertel 16851: }
16852: if ($args->{'no_end_date'}) {
16853: $args->{'endaccess'} = 0;
16854: }
1.1075.2.161. .20(raeb 16855:-23): # If an official course with institutional sections is created by cloning
16856:-23): # an existing course, section-specific hiding of course totals in student's
16857:-23): # view of grades as copied from cloned course, will be checked for valid
16858:-23): # sections.
16859:-23): if (($can_clone && $cloneid) &&
16860:-23): ($cenv{'internal.coursecode'} ne '') &&
16861:-23): ($cenv{'grading'} eq 'standard') &&
16862:-23): ($cenv{'hidetotals'} ne '') &&
16863:-23): ($cenv{'hidetotals'} ne 'all')) {
16864:-23): my @hidesecs;
16865:-23): my $deletehidetotals;
16866:-23): if (@oklcsecs) {
16867:-23): foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
16868:-23): if (grep(/^\Q$sec$/,@oklcsecs)) {
16869:-23): push(@hidesecs,$sec);
16870:-23): }
16871:-23): }
16872:-23): if (@hidesecs) {
16873:-23): $cenv{'hidetotals'} = join(',',@hidesecs);
16874:-23): } else {
16875:-23): $deletehidetotals = 1;
16876:-23): }
16877:-23): } else {
16878:-23): $deletehidetotals = 1;
16879:-23): }
16880:-23): if ($deletehidetotals) {
16881:-23): delete($cenv{'hidetotals'});
16882:-23): &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
16883:-23): }
16884:-23): }
1.444 albertel 16885: $cenv{'internal.autostart'}=$args->{'enrollstart'};
16886: $cenv{'internal.autoend'}=$args->{'enrollend'};
16887: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
16888: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
16889: if ($args->{'showphotos'}) {
16890: $cenv{'internal.showphotos'}=$args->{'showphotos'};
16891: }
16892: $cenv{'internal.authtype'} = $args->{'authtype'};
16893: $cenv{'internal.autharg'} = $args->{'autharg'};
16894: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
16895: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 16896: 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');
16897: if ($context eq 'auto') {
16898: $outcome .= $krb_msg;
16899: } else {
1.566 albertel 16900: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 16901: }
16902: $outcome .= $linefeed;
1.444 albertel 16903: }
16904: }
16905: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
16906: if ($args->{'setpolicy'}) {
16907: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16908: }
16909: if ($args->{'setcontent'}) {
16910: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16911: }
1.1075.2.110 raeburn 16912: if ($args->{'setcomment'}) {
16913: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
16914: }
1.444 albertel 16915: }
16916: if ($args->{'reshome'}) {
16917: $cenv{'reshome'}=$args->{'reshome'}.'/';
16918: $cenv{'reshome'}=~s/\/+$/\//;
16919: }
16920: #
16921: # course has keyed access
16922: #
16923: if ($args->{'setkeys'}) {
16924: $cenv{'keyaccess'}='yes';
16925: }
16926: # if specified, key authority is not course, but user
16927: # only active if keyaccess is yes
16928: if ($args->{'keyauth'}) {
1.487 albertel 16929: my ($user,$domain) = split(':',$args->{'keyauth'});
16930: $user = &LONCAPA::clean_username($user);
16931: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 16932: if ($user ne '' && $domain ne '') {
1.487 albertel 16933: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 16934: }
16935: }
16936:
1.1075.2.59 raeburn 16937: #
16938: # generate and store uniquecode (available to course requester), if course should have one.
16939: #
16940: if ($args->{'uniquecode'}) {
16941: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
16942: if ($code) {
16943: $cenv{'internal.uniquecode'} = $code;
16944: my %crsinfo =
16945: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
16946: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
16947: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
16948: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
16949: }
16950: if (ref($coderef)) {
16951: $$coderef = $code;
16952: }
16953: }
16954: }
16955:
1.444 albertel 16956: if ($args->{'disresdis'}) {
16957: $cenv{'pch.roles.denied'}='st';
16958: }
16959: if ($args->{'disablechat'}) {
16960: $cenv{'plc.roles.denied'}='st';
16961: }
16962:
16963: # Record we've not yet viewed the Course Initialization Helper for this
16964: # course
16965: $cenv{'course.helper.not.run'} = 1;
16966: #
16967: # Use new Randomseed
16968: #
16969: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
16970: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
16971: #
16972: # The encryption code and receipt prefix for this course
16973: #
16974: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
16975: $cenv{'internal.encpref'}=100+int(9*rand(99));
16976: #
16977: # By default, use standard grading
16978: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
16979:
1.541 raeburn 16980: $outcome .= $linefeed.&mt('Setting environment').': '.
16981: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16982: #
16983: # Open all assignments
16984: #
16985: if ($args->{'openall'}) {
1.1075.2.146 raeburn 16986: my $opendate = time;
16987: if ($args->{'openallfrom'} =~ /^\d+$/) {
16988: $opendate = $args->{'openallfrom'};
16989: }
1.444 albertel 16990: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1075.2.146 raeburn 16991: my %storecontent = ($storeunder => $opendate,
1.444 albertel 16992: $storeunder.'.type' => 'date_start');
1.1075.2.146 raeburn 16993: $outcome .= &mt('All assignments open starting [_1]',
16994: &Apache::lonlocal::locallocaltime($opendate)).': '.
16995: &Apache::lonnet::cput
16996: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 16997: }
16998: #
16999: # Set first page
17000: #
17001: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
17002: || ($cloneid)) {
17003: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 17004:
17005: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
17006: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
17007:
1.444 albertel 17008: $outcome .= ($fatal?$errtext:'read ok').' - ';
17009: my $title; my $url;
17010: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 17011: $title=&mt('Syllabus');
1.444 albertel 17012: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
17013: } else {
1.963 raeburn 17014: $title=&mt('Table of Contents');
1.444 albertel 17015: $url='/adm/navmaps';
17016: }
1.445 albertel 17017:
17018: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
17019: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
17020:
17021: if ($errtext) { $fatal=2; }
1.541 raeburn 17022: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 17023: }
1.566 albertel 17024:
1.1075.2.161. .1(raebu 17025:21): return (1,$outcome,\@clonemsg);
1.444 albertel 17026: }
17027:
1.1075.2.59 raeburn 17028: sub make_unique_code {
17029: my ($cdom,$cnum) = @_;
17030: # get lock on uniquecodes db
17031: my $lockhash = {
17032: $cnum."\0".'uniquecodes' => $env{'user.name'}.
17033: ':'.$env{'user.domain'},
17034: };
17035: my $tries = 0;
17036: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17037: my ($code,$error);
17038:
17039: while (($gotlock ne 'ok') && ($tries<3)) {
17040: $tries ++;
17041: sleep 1;
17042: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
17043: }
17044: if ($gotlock eq 'ok') {
17045: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
17046: my $gotcode;
17047: my $attempts = 0;
17048: while ((!$gotcode) && ($attempts < 100)) {
17049: $code = &generate_code();
17050: if (!exists($currcodes{$code})) {
17051: $gotcode = 1;
17052: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
17053: $error = 'nostore';
17054: }
17055: }
17056: $attempts ++;
17057: }
17058: my @del_lock = ($cnum."\0".'uniquecodes');
17059: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
17060: } else {
17061: $error = 'nolock';
17062: }
17063: return ($code,$error);
17064: }
17065:
17066: sub generate_code {
17067: my $code;
17068: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
17069: for (my $i=0; $i<6; $i++) {
17070: my $lettnum = int (rand 2);
17071: my $item = '';
17072: if ($lettnum) {
17073: $item = $letts[int( rand(18) )];
17074: } else {
17075: $item = 1+int( rand(8) );
17076: }
17077: $code .= $item;
17078: }
17079: return $code;
17080: }
17081:
1.444 albertel 17082: ############################################################
17083: ############################################################
17084:
1.953 droeschl 17085: #SD
17086: # only Community and Course, or anything else?
1.378 raeburn 17087: sub course_type {
17088: my ($cid) = @_;
17089: if (!defined($cid)) {
17090: $cid = $env{'request.course.id'};
17091: }
1.404 albertel 17092: if (defined($env{'course.'.$cid.'.type'})) {
17093: return $env{'course.'.$cid.'.type'};
1.378 raeburn 17094: } else {
17095: return 'Course';
1.377 raeburn 17096: }
17097: }
1.156 albertel 17098:
1.406 raeburn 17099: sub group_term {
17100: my $crstype = &course_type();
17101: my %names = (
17102: 'Course' => 'group',
1.865 raeburn 17103: 'Community' => 'group',
1.406 raeburn 17104: );
17105: return $names{$crstype};
17106: }
17107:
1.902 raeburn 17108: sub course_types {
1.1075.2.161. .17(raeb 17109:-23): my @types = ('official','unofficial','community','textbook','lti');
1.902 raeburn 17110: my %typename = (
17111: official => 'Official course',
17112: unofficial => 'Unofficial course',
17113: community => 'Community',
1.1075.2.59 raeburn 17114: textbook => 'Textbook course',
1.1075.2.161. .17(raeb 17115:-23): lti => 'LTI provider',
1.902 raeburn 17116: );
17117: return (\@types,\%typename);
17118: }
17119:
1.156 albertel 17120: sub icon {
17121: my ($file)=@_;
1.505 albertel 17122: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 17123: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 17124: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 17125: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
17126: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
17127: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17128: $curfext.".gif") {
17129: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
17130: $curfext.".gif";
17131: }
17132: }
1.249 albertel 17133: return &lonhttpdurl($iconname);
1.154 albertel 17134: }
1.84 albertel 17135:
1.575 albertel 17136: sub lonhttpdurl {
1.692 www 17137: #
17138: # Had been used for "small fry" static images on separate port 8080.
17139: # Modify here if lightweight http functionality desired again.
17140: # Currently eliminated due to increasing firewall issues.
17141: #
1.575 albertel 17142: my ($url)=@_;
1.692 www 17143: return $url;
1.215 albertel 17144: }
17145:
1.213 albertel 17146: sub connection_aborted {
17147: my ($r)=@_;
17148: $r->print(" ");$r->rflush();
17149: my $c = $r->connection;
17150: return $c->aborted();
17151: }
17152:
1.221 foxr 17153: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 17154: # strings as 'strings'.
17155: sub escape_single {
1.221 foxr 17156: my ($input) = @_;
1.223 albertel 17157: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 17158: $input =~ s/\'/\\\'/g; # Esacpe the 's....
17159: return $input;
17160: }
1.223 albertel 17161:
1.222 foxr 17162: # Same as escape_single, but escape's "'s This
17163: # can be used for "strings"
17164: sub escape_double {
17165: my ($input) = @_;
17166: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
17167: $input =~ s/\"/\\\"/g; # Esacpe the "s....
17168: return $input;
17169: }
1.223 albertel 17170:
1.222 foxr 17171: # Escapes the last element of a full URL.
17172: sub escape_url {
17173: my ($url) = @_;
1.238 raeburn 17174: my @urlslices = split(/\//, $url,-1);
1.369 www 17175: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 17176: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 17177: }
1.462 albertel 17178:
1.820 raeburn 17179: sub compare_arrays {
17180: my ($arrayref1,$arrayref2) = @_;
17181: my (@difference,%count);
17182: @difference = ();
17183: %count = ();
17184: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
17185: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
17186: foreach my $element (keys(%count)) {
17187: if ($count{$element} == 1) {
17188: push(@difference,$element);
17189: }
17190: }
17191: }
17192: return @difference;
17193: }
17194:
1.1075.2.152 raeburn 17195: sub lon_status_items {
17196: my %defaults = (
17197: E => 100,
17198: W => 4,
17199: N => 1,
17200: U => 5,
17201: threshold => 200,
17202: sysmail => 2500,
17203: );
17204: my %names = (
17205: E => 'Errors',
17206: W => 'Warnings',
17207: N => 'Notices',
17208: U => 'Unsent',
17209: );
17210: return (\%defaults,\%names);
17211: }
17212:
1.817 bisitz 17213: # -------------------------------------------------------- Initialize user login
1.462 albertel 17214: sub init_user_environment {
1.463 albertel 17215: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 17216: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
17217:
17218: my $public=($username eq 'public' && $domain eq 'public');
17219:
17220: # See if old ID present, if so, remove
17221:
1.1075.2.161. .22(raeb 17222:-24): my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv,
17223:-24): $coauthorenv);
1.462 albertel 17224: my $now=time;
17225:
17226: if ($public) {
17227: my $max_public=100;
17228: my $oldest;
17229: my $oldest_time=0;
17230: for(my $next=1;$next<=$max_public;$next++) {
17231: if (-e $lonids."/publicuser_$next.id") {
17232: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
17233: if ($mtime<$oldest_time || !$oldest_time) {
17234: $oldest_time=$mtime;
17235: $oldest=$next;
17236: }
17237: } else {
17238: $cookie="publicuser_$next";
17239: last;
17240: }
17241: }
17242: if (!$cookie) { $cookie="publicuser_$oldest"; }
17243: } else {
1.463 albertel 17244: # if this isn't a robot, kill any existing non-robot sessions
17245: if (!$args->{'robot'}) {
17246: opendir(DIR,$lonids);
17247: while ($filename=readdir(DIR)) {
17248: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1075.2.136 raeburn 17249: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
17250: &GDBM_READER(),0640)) {
17251: my $linkedfile;
17252: if (exists($oldenv{'user.linkedenv'})) {
17253: $linkedfile = $oldenv{'user.linkedenv'};
17254: }
17255: untie(%oldenv);
17256: if (unlink("$lonids/$filename")) {
17257: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
17258: if (-l "$lonids/$linkedfile.id") {
17259: unlink("$lonids/$linkedfile.id");
17260: }
17261: }
17262: }
17263: } else {
17264: unlink($lonids.'/'.$filename);
17265: }
1.463 albertel 17266: }
1.462 albertel 17267: }
1.463 albertel 17268: closedir(DIR);
1.1075.2.84 raeburn 17269: # If there is a undeleted lockfile for the user's paste buffer remove it.
17270: my $namespace = 'nohist_courseeditor';
17271: my $lockingkey = 'paste'."\0".'locked_num';
17272: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
17273: $domain,$username);
17274: if (exists($lockhash{$lockingkey})) {
17275: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
17276: unless ($delresult eq 'ok') {
17277: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
17278: }
17279: }
1.462 albertel 17280: }
17281: # Give them a new cookie
1.463 albertel 17282: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 17283: : $now.$$.int(rand(10000)));
1.463 albertel 17284: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 17285:
17286: # Initialize roles
17287:
1.1075.2.161. .22(raeb 17288:-24): ($userroles,$firstaccenv,$timerintenv,$coauthorenv) =
1.1062 raeburn 17289: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 17290: }
17291: # ------------------------------------ Check browser type and MathML capability
17292:
1.1075.2.77 raeburn 17293: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
17294: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 17295:
17296: # ------------------------------------------------------------- Get environment
17297:
17298: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
17299: my ($tmp) = keys(%userenv);
17300: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
17301: } else {
17302: undef(%userenv);
17303: }
17304: if (($userenv{'interface'}) && (!$form->{'interface'})) {
17305: $form->{'interface'}=$userenv{'interface'};
17306: }
17307: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
17308:
17309: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 17310: foreach my $option ('interface','localpath','localres') {
17311: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 17312: }
17313: # --------------------------------------------------------- Write first profile
17314:
17315: {
1.1075.2.150 raeburn 17316: my $ip = &Apache::lonnet::get_requestor_ip();
1.462 albertel 17317: my %initial_env =
17318: ("user.name" => $username,
17319: "user.domain" => $domain,
17320: "user.home" => $authhost,
17321: "browser.type" => $clientbrowser,
17322: "browser.version" => $clientversion,
17323: "browser.mathml" => $clientmathml,
17324: "browser.unicode" => $clientunicode,
17325: "browser.os" => $clientos,
1.1075.2.42 raeburn 17326: "browser.mobile" => $clientmobile,
17327: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 17328: "browser.osversion" => $clientosversion,
1.462 albertel 17329: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
17330: "request.course.fn" => '',
17331: "request.course.uri" => '',
17332: "request.course.sec" => '',
17333: "request.role" => 'cm',
17334: "request.role.adv" => $env{'user.adv'},
1.1075.2.150 raeburn 17335: "request.host" => $ip,);
1.462 albertel 17336:
17337: if ($form->{'localpath'}) {
17338: $initial_env{"browser.localpath"} = $form->{'localpath'};
17339: $initial_env{"browser.localres"} = $form->{'localres'};
17340: }
17341:
17342: if ($form->{'interface'}) {
17343: $form->{'interface'}=~s/\W//gs;
17344: $initial_env{"browser.interface"} = $form->{'interface'};
17345: $env{'browser.interface'}=$form->{'interface'};
17346: }
17347:
1.1075.2.54 raeburn 17348: if ($form->{'iptoken'}) {
17349: my $lonhost = $r->dir_config('lonHostID');
17350: $initial_env{"user.noloadbalance"} = $lonhost;
17351: $env{'user.noloadbalance'} = $lonhost;
17352: }
17353:
1.1075.2.120 raeburn 17354: if ($form->{'noloadbalance'}) {
17355: my @hosts = &Apache::lonnet::current_machine_ids();
17356: my $hosthere = $form->{'noloadbalance'};
17357: if (grep(/^\Q$hosthere\E$/,@hosts)) {
17358: $initial_env{"user.noloadbalance"} = $hosthere;
17359: $env{'user.noloadbalance'} = $hosthere;
17360: }
17361: }
17362:
1.1016 raeburn 17363: unless ($domain eq 'public') {
1.1075.2.125 raeburn 17364: my %is_adv = ( is_adv => $env{'user.adv'} );
17365: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
1.980 raeburn 17366:
1.1075.2.161. .28(raeb 17367:-24): foreach my $tool ('aboutme','blog','webdav','portfolio','portaccess','timezone') {
17368:-24): $userenv{'availabletools.'.$tool} =
1.1075.2.125 raeburn 17369: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
17370: undef,\%userenv,\%domdef,\%is_adv);
17371: }
1.724 raeburn 17372:
1.1075.2.161. .17(raeb 17373:-23): foreach my $crstype ('official','unofficial','community','textbook','lti') {
1.1075.2.125 raeburn 17374: $userenv{'canrequest.'.$crstype} =
17375: &Apache::lonnet::usertools_access($username,$domain,$crstype,
17376: 'reload','requestcourses',
17377: \%userenv,\%domdef,\%is_adv);
17378: }
1.765 raeburn 17379:
1.1075.2.161. .21(raeb 17380:-24): if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&
17381:-24): (exists($userroles->{"user.role.au./$domain/"}))) {
17382:-24): if ($userenv{'authoreditors'}) {
17383:-24): $userenv{'editors'} = $userenv{'authoreditors'};
17384:-24): } elsif ($domdef{'editors'} ne '') {
17385:-24): $userenv{'editors'} = $domdef{'editors'};
17386:-24): } else {
17387:-24): $userenv{'editors'} = 'edit,xml';
17388:-24): }
.25(raeb 17389:-24): if ($userenv{'authorarchive'}) {
17390:-24): $userenv{'canarchive'} = 1;
17391:-24): } elsif (($userenv{'authorarchive'} eq '') &&
17392:-24): ($domdef{'archive'})) {
17393:-24): $userenv{'canarchive'} = 1;
17394:-24): }
.21(raeb 17395:-24): }
17396:-24):
1.1075.2.125 raeburn 17397: $userenv{'canrequest.author'} =
17398: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
17399: 'reload','requestauthor',
17400: \%userenv,\%domdef,\%is_adv);
17401: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
17402: $domain,$username);
17403: my $reqstatus = $reqauthor{'author_status'};
17404: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
17405: if (ref($reqauthor{'author'}) eq 'HASH') {
17406: $userenv{'requestauthorqueued'} = $reqstatus.':'.
17407: $reqauthor{'author'}{'timestamp'};
17408: }
1.1075.2.14 raeburn 17409: }
17410: }
17411:
1.462 albertel 17412: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 17413:
1.462 albertel 17414: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
17415: &GDBM_WRCREAT(),0640)) {
17416: &_add_to_env(\%disk_env,\%initial_env);
17417: &_add_to_env(\%disk_env,\%userenv,'environment.');
17418: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 17419: if (ref($firstaccenv) eq 'HASH') {
17420: &_add_to_env(\%disk_env,$firstaccenv);
17421: }
17422: if (ref($timerintenv) eq 'HASH') {
17423: &_add_to_env(\%disk_env,$timerintenv);
17424: }
1.1075.2.161. .22(raeb 17425:-24): if (ref($coauthorenv) eq 'HASH') {
17426:-24): if (keys(%{$coauthorenv})) {
17427:-24): &_add_to_env(\%disk_env,$coauthorenv);
17428:-24): }
17429:-24): }
1.463 albertel 17430: if (ref($args->{'extra_env'})) {
17431: &_add_to_env(\%disk_env,$args->{'extra_env'});
17432: }
1.462 albertel 17433: untie(%disk_env);
17434: } else {
1.705 tempelho 17435: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
17436: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 17437: return 'error: '.$!;
17438: }
17439: }
17440: $env{'request.role'}='cm';
17441: $env{'request.role.adv'}=$env{'user.adv'};
17442: $env{'browser.type'}=$clientbrowser;
17443:
17444: return $cookie;
17445:
17446: }
17447:
17448: sub _add_to_env {
17449: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 17450: if (ref($env_data) eq 'HASH') {
17451: while (my ($key,$value) = each(%$env_data)) {
17452: $idf->{$prefix.$key} = $value;
17453: $env{$prefix.$key} = $value;
17454: }
1.462 albertel 17455: }
17456: }
17457:
1.685 tempelho 17458: # --- Get the symbolic name of a problem and the url
17459: sub get_symb {
17460: my ($request,$silent) = @_;
1.726 raeburn 17461: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 17462: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
17463: if ($symb eq '') {
17464: if (!$silent) {
1.1071 raeburn 17465: if (ref($request)) {
17466: $request->print("Unable to handle ambiguous references:$url:.");
17467: }
1.685 tempelho 17468: return ();
17469: }
17470: }
17471: &Apache::lonenc::check_decrypt(\$symb);
17472: return ($symb);
17473: }
17474:
17475: # --------------------------------------------------------------Get annotation
17476:
17477: sub get_annotation {
17478: my ($symb,$enc) = @_;
17479:
17480: my $key = $symb;
17481: if (!$enc) {
17482: $key =
17483: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
17484: }
17485: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
17486: return $annotation{$key};
17487: }
17488:
17489: sub clean_symb {
1.731 raeburn 17490: my ($symb,$delete_enc) = @_;
1.685 tempelho 17491:
17492: &Apache::lonenc::check_decrypt(\$symb);
17493: my $enc = $env{'request.enc'};
1.731 raeburn 17494: if ($delete_enc) {
1.730 raeburn 17495: delete($env{'request.enc'});
17496: }
1.685 tempelho 17497:
17498: return ($symb,$enc);
17499: }
1.462 albertel 17500:
1.1075.2.69 raeburn 17501: ############################################################
17502: ############################################################
17503:
17504: =pod
17505:
17506: =head1 Routines for building display used to search for courses
17507:
17508:
17509: =over 4
17510:
17511: =item * &build_filters()
17512:
17513: Create markup for a table used to set filters to use when selecting
17514: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
17515: and quotacheck.pl
17516:
17517:
17518: Inputs:
17519:
17520: filterlist - anonymous array of fields to include as potential filters
17521:
17522: crstype - course type
17523:
17524: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
17525: to pop-open a course selector (will contain "extra element").
17526:
17527: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
17528:
17529: filter - anonymous hash of criteria and their values
17530:
17531: action - form action
17532:
17533: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
17534:
17535: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
17536:
17537: cloneruname - username of owner of new course who wants to clone
17538:
17539: clonerudom - domain of owner of new course who wants to clone
17540:
17541: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
17542:
17543: codetitlesref - reference to array of titles of components in institutional codes (official courses)
17544:
17545: codedom - domain
17546:
17547: formname - value of form element named "form".
17548:
17549: fixeddom - domain, if fixed.
17550:
17551: prevphase - value to assign to form element named "phase" when going back to the previous screen
17552:
17553: cnameelement - name of form element in form on opener page which will receive title of selected course
17554:
17555: cnumelement - name of form element in form on opener page which will receive courseID of selected course
17556:
17557: cdomelement - name of form element in form on opener page which will receive domain of selected course
17558:
17559: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
17560:
17561: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
17562:
17563: clonewarning - warning message about missing information for intended course owner when DC creates a course
17564:
17565:
17566: Returns: $output - HTML for display of search criteria, and hidden form elements.
17567:
17568:
17569: Side Effects: None
17570:
17571: =cut
17572:
17573: # ---------------------------------------------- search for courses based on last activity etc.
17574:
17575: sub build_filters {
17576: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
17577: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
17578: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
17579: $cnameelement,$cnumelement,$cdomelement,$setroles,
17580: $clonetext,$clonewarning) = @_;
17581: my ($list,$jscript);
17582: my $onchange = 'javascript:updateFilters(this)';
17583: my ($domainselectform,$sincefilterform,$createdfilterform,
17584: $ownerdomselectform,$persondomselectform,$instcodeform,
17585: $typeselectform,$instcodetitle);
17586: if ($formname eq '') {
17587: $formname = $caller;
17588: }
17589: foreach my $item (@{$filterlist}) {
17590: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
17591: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
17592: if ($item eq 'domainfilter') {
17593: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
17594: } elsif ($item eq 'coursefilter') {
17595: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
17596: } elsif ($item eq 'ownerfilter') {
17597: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17598: } elsif ($item eq 'ownerdomfilter') {
17599: $filter->{'ownerdomfilter'} =
17600: &LONCAPA::clean_domain($filter->{$item});
17601: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
17602: 'ownerdomfilter',1);
17603: } elsif ($item eq 'personfilter') {
17604: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
17605: } elsif ($item eq 'persondomfilter') {
17606: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
17607: 'persondomfilter',1);
17608: } else {
17609: $filter->{$item} =~ s/\W//g;
17610: }
17611: if (!$filter->{$item}) {
17612: $filter->{$item} = '';
17613: }
17614: }
17615: if ($item eq 'domainfilter') {
17616: my $allow_blank = 1;
17617: if ($formname eq 'portform') {
17618: $allow_blank=0;
17619: } elsif ($formname eq 'studentform') {
17620: $allow_blank=0;
17621: }
17622: if ($fixeddom) {
17623: $domainselectform = '<input type="hidden" name="domainfilter"'.
17624: ' value="'.$codedom.'" />'.
17625: &Apache::lonnet::domain($codedom,'description');
17626: } else {
17627: $domainselectform = &select_dom_form($filter->{$item},
17628: 'domainfilter',
17629: $allow_blank,'',$onchange);
17630: }
17631: } else {
17632: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
17633: }
17634: }
17635:
17636: # last course activity filter and selection
17637: $sincefilterform = &timebased_select_form('sincefilter',$filter);
17638:
17639: # course created filter and selection
17640: if (exists($filter->{'createdfilter'})) {
17641: $createdfilterform = &timebased_select_form('createdfilter',$filter);
17642: }
17643:
17644: my %lt = &Apache::lonlocal::texthash(
17645: 'cac' => "$crstype Activity",
17646: 'ccr' => "$crstype Created",
17647: 'cde' => "$crstype Title",
17648: 'cdo' => "$crstype Domain",
17649: 'ins' => 'Institutional Code',
17650: 'inc' => 'Institutional Categorization',
17651: 'cow' => "$crstype Owner/Co-owner",
17652: 'cop' => "$crstype Personnel Includes",
17653: 'cog' => 'Type',
17654: );
17655:
17656: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17657: my $typeval = 'Course';
17658: if ($crstype eq 'Community') {
17659: $typeval = 'Community';
17660: }
17661: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
17662: } else {
17663: $typeselectform = '<select name="type" size="1"';
17664: if ($onchange) {
17665: $typeselectform .= ' onchange="'.$onchange.'"';
17666: }
17667: $typeselectform .= '>'."\n";
17668: foreach my $posstype ('Course','Community') {
17669: $typeselectform.='<option value="'.$posstype.'"'.
17670: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
17671: }
17672: $typeselectform.="</select>";
17673: }
17674:
17675: my ($cloneableonlyform,$cloneabletitle);
17676: if (exists($filter->{'cloneableonly'})) {
17677: my $cloneableon = '';
17678: my $cloneableoff = ' checked="checked"';
17679: if ($filter->{'cloneableonly'}) {
17680: $cloneableon = $cloneableoff;
17681: $cloneableoff = '';
17682: }
17683: $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>';
17684: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 17685: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 17686: } else {
17687: $cloneabletitle = &mt('Cloneable by you');
17688: }
17689: }
17690: my $officialjs;
17691: if ($crstype eq 'Course') {
17692: if (exists($filter->{'instcodefilter'})) {
17693: # if (($fixeddom) || ($formname eq 'requestcrs') ||
17694: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
17695: if ($codedom) {
17696: $officialjs = 1;
17697: ($instcodeform,$jscript,$$numtitlesref) =
17698: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
17699: $officialjs,$codetitlesref);
17700: if ($jscript) {
17701: $jscript = '<script type="text/javascript">'."\n".
17702: '// <![CDATA['."\n".
17703: $jscript."\n".
17704: '// ]]>'."\n".
17705: '</script>'."\n";
17706: }
17707: }
17708: if ($instcodeform eq '') {
17709: $instcodeform =
17710: '<input type="text" name="instcodefilter" size="10" value="'.
17711: $list->{'instcodefilter'}.'" />';
17712: $instcodetitle = $lt{'ins'};
17713: } else {
17714: $instcodetitle = $lt{'inc'};
17715: }
17716: if ($fixeddom) {
17717: $instcodetitle .= '<br />('.$codedom.')';
17718: }
17719: }
17720: }
17721: my $output = qq|
17722: <form method="post" name="filterpicker" action="$action">
17723: <input type="hidden" name="form" value="$formname" />
17724: |;
17725: if ($formname eq 'modifycourse') {
17726: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
17727: '<input type="hidden" name="prevphase" value="'.
17728: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 17729: } elsif ($formname eq 'quotacheck') {
17730: $output .= qq|
17731: <input type="hidden" name="sortby" value="" />
17732: <input type="hidden" name="sortorder" value="" />
17733: |;
17734: } else {
1.1075.2.69 raeburn 17735: my $name_input;
17736: if ($cnameelement ne '') {
17737: $name_input = '<input type="hidden" name="cnameelement" value="'.
17738: $cnameelement.'" />';
17739: }
17740: $output .= qq|
17741: <input type="hidden" name="cnumelement" value="$cnumelement" />
17742: <input type="hidden" name="cdomelement" value="$cdomelement" />
17743: $name_input
17744: $roleelement
17745: $multelement
17746: $typeelement
17747: |;
17748: if ($formname eq 'portform') {
17749: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
17750: }
17751: }
17752: if ($fixeddom) {
17753: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
17754: }
17755: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
17756: if ($sincefilterform) {
17757: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
17758: .$sincefilterform
17759: .&Apache::lonhtmlcommon::row_closure();
17760: }
17761: if ($createdfilterform) {
17762: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
17763: .$createdfilterform
17764: .&Apache::lonhtmlcommon::row_closure();
17765: }
17766: if ($domainselectform) {
17767: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
17768: .$domainselectform
17769: .&Apache::lonhtmlcommon::row_closure();
17770: }
17771: if ($typeselectform) {
17772: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
17773: $output .= $typeselectform;
17774: } else {
17775: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
17776: .$typeselectform
17777: .&Apache::lonhtmlcommon::row_closure();
17778: }
17779: }
17780: if ($instcodeform) {
17781: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
17782: .$instcodeform
17783: .&Apache::lonhtmlcommon::row_closure();
17784: }
17785: if (exists($filter->{'ownerfilter'})) {
17786: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
17787: '<table><tr><td>'.&mt('Username').'<br />'.
17788: '<input type="text" name="ownerfilter" size="20" value="'.
17789: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17790: $ownerdomselectform.'</td></tr></table>'.
17791: &Apache::lonhtmlcommon::row_closure();
17792: }
17793: if (exists($filter->{'personfilter'})) {
17794: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
17795: '<table><tr><td>'.&mt('Username').'<br />'.
17796: '<input type="text" name="personfilter" size="20" value="'.
17797: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
17798: $persondomselectform.'</td></tr></table>'.
17799: &Apache::lonhtmlcommon::row_closure();
17800: }
17801: if (exists($filter->{'coursefilter'})) {
17802: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
17803: .'<input type="text" name="coursefilter" size="25" value="'
17804: .$list->{'coursefilter'}.'" />'
17805: .&Apache::lonhtmlcommon::row_closure();
17806: }
17807: if ($cloneableonlyform) {
17808: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
17809: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
17810: }
17811: if (exists($filter->{'descriptfilter'})) {
17812: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
17813: .'<input type="text" name="descriptfilter" size="40" value="'
17814: .$list->{'descriptfilter'}.'" />'
17815: .&Apache::lonhtmlcommon::row_closure(1);
17816: }
17817: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
17818: '<input type="hidden" name="updater" value="" />'."\n".
17819: '<input type="submit" name="gosearch" value="'.
17820: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
17821: return $jscript.$clonewarning.$output;
17822: }
17823:
17824: =pod
17825:
17826: =item * &timebased_select_form()
17827:
17828: Create markup for a dropdown list used to select a time-based
17829: filter e.g., Course Activity, Course Created, when searching for courses
17830: or communities
17831:
17832: Inputs:
17833:
17834: item - name of form element (sincefilter or createdfilter)
17835:
17836: filter - anonymous hash of criteria and their values
17837:
17838: Returns: HTML for a select box contained a blank, then six time selections,
17839: with value set in incoming form variables currently selected.
17840:
17841: Side Effects: None
17842:
17843: =cut
17844:
17845: sub timebased_select_form {
17846: my ($item,$filter) = @_;
17847: if (ref($filter) eq 'HASH') {
17848: $filter->{$item} =~ s/[^\d-]//g;
17849: if (!$filter->{$item}) { $filter->{$item}=-1; }
17850: return &select_form(
17851: $filter->{$item},
17852: $item,
17853: { '-1' => '',
17854: '86400' => &mt('today'),
17855: '604800' => &mt('last week'),
17856: '2592000' => &mt('last month'),
17857: '7776000' => &mt('last three months'),
17858: '15552000' => &mt('last six months'),
17859: '31104000' => &mt('last year'),
17860: 'select_form_order' =>
17861: ['-1','86400','604800','2592000','7776000',
17862: '15552000','31104000']});
17863: }
17864: }
17865:
17866: =pod
17867:
17868: =item * &js_changer()
17869:
17870: Create script tag containing Javascript used to submit course search form
17871: when course type or domain is changed, and also to hide 'Searching ...' on
17872: page load completion for page showing search result.
17873:
17874: Inputs: None
17875:
17876: Returns: markup containing updateFilters() and hideSearching() javascript functions.
17877:
17878: Side Effects: None
17879:
17880: =cut
17881:
17882: sub js_changer {
17883: return <<ENDJS;
17884: <script type="text/javascript">
17885: // <![CDATA[
17886: function updateFilters(caller) {
17887: if (typeof(caller) != "undefined") {
17888: document.filterpicker.updater.value = caller.name;
17889: }
17890: document.filterpicker.submit();
17891: }
17892:
17893: function hideSearching() {
17894: if (document.getElementById('searching')) {
17895: document.getElementById('searching').style.display = 'none';
17896: }
17897: return;
17898: }
17899:
17900: // ]]>
17901: </script>
17902:
17903: ENDJS
17904: }
17905:
17906: =pod
17907:
17908: =item * &search_courses()
17909:
17910: Process selected filters form course search form and pass to lonnet::courseiddump
17911: to retrieve a hash for which keys are courseIDs which match the selected filters.
17912:
17913: Inputs:
17914:
17915: dom - domain being searched
17916:
17917: type - course type ('Course' or 'Community' or '.' if any).
17918:
17919: filter - anonymous hash of criteria and their values
17920:
17921: numtitles - for institutional codes - number of categories
17922:
17923: cloneruname - optional username of new course owner
17924:
17925: clonerudom - optional domain of new course owner
17926:
1.1075.2.95 raeburn 17927: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69 raeburn 17928: (used when DC is using course creation form)
17929:
17930: codetitles - reference to array of titles of components in institutional codes (official courses).
17931:
1.1075.2.95 raeburn 17932: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
17933: (and so can clone automatically)
17934:
17935: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
17936:
17937: reqinstcode - institutional code of new course, where search_courses is used to identify potential
17938: courses to clone
1.1075.2.69 raeburn 17939:
17940: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
17941:
17942:
17943: Side Effects: None
17944:
17945: =cut
17946:
17947:
17948: sub search_courses {
1.1075.2.95 raeburn 17949: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
17950: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69 raeburn 17951: my (%courses,%showcourses,$cloner);
17952: if (($filter->{'ownerfilter'} ne '') ||
17953: ($filter->{'ownerdomfilter'} ne '')) {
17954: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
17955: $filter->{'ownerdomfilter'};
17956: }
17957: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
17958: if (!$filter->{$item}) {
17959: $filter->{$item}='.';
17960: }
17961: }
17962: my $now = time;
17963: my $timefilter =
17964: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
17965: my ($createdbefore,$createdafter);
17966: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
17967: $createdbefore = $now;
17968: $createdafter = $now-$filter->{'createdfilter'};
17969: }
17970: my ($instcodefilter,$regexpok);
17971: if ($numtitles) {
17972: if ($env{'form.official'} eq 'on') {
17973: $instcodefilter =
17974: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17975: $regexpok = 1;
17976: } elsif ($env{'form.official'} eq 'off') {
17977: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
17978: unless ($instcodefilter eq '') {
17979: $regexpok = -1;
17980: }
17981: }
17982: } else {
17983: $instcodefilter = $filter->{'instcodefilter'};
17984: }
17985: if ($instcodefilter eq '') { $instcodefilter = '.'; }
17986: if ($type eq '') { $type = '.'; }
17987:
17988: if (($clonerudom ne '') && ($cloneruname ne '')) {
17989: $cloner = $cloneruname.':'.$clonerudom;
17990: }
17991: %courses = &Apache::lonnet::courseiddump($dom,
17992: $filter->{'descriptfilter'},
17993: $timefilter,
17994: $instcodefilter,
17995: $filter->{'combownerfilter'},
17996: $filter->{'coursefilter'},
17997: undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95 raeburn 17998: undef,undef,$cloner,$cc_clone,
1.1075.2.69 raeburn 17999: $filter->{'cloneableonly'},
18000: $createdbefore,$createdafter,undef,
1.1075.2.95 raeburn 18001: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69 raeburn 18002: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
18003: my $ccrole;
18004: if ($type eq 'Community') {
18005: $ccrole = 'co';
18006: } else {
18007: $ccrole = 'cc';
18008: }
18009: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
18010: $filter->{'persondomfilter'},
18011: 'userroles',undef,
18012: [$ccrole,'in','ad','ep','ta','cr'],
18013: $dom);
18014: foreach my $role (keys(%rolehash)) {
18015: my ($cnum,$cdom,$courserole) = split(':',$role);
18016: my $cid = $cdom.'_'.$cnum;
18017: if (exists($courses{$cid})) {
18018: if (ref($courses{$cid}) eq 'HASH') {
18019: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
18020: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1075.2.119 raeburn 18021: push(@{$courses{$cid}{roles}},$courserole);
1.1075.2.69 raeburn 18022: }
18023: } else {
18024: $courses{$cid}{roles} = [$courserole];
18025: }
18026: $showcourses{$cid} = $courses{$cid};
18027: }
18028: }
18029: }
18030: %courses = %showcourses;
18031: }
18032: return %courses;
18033: }
18034:
18035: =pod
18036:
18037: =back
18038:
1.1075.2.88 raeburn 18039: =head1 Routines for version requirements for current course.
18040:
18041: =over 4
18042:
18043: =item * &check_release_required()
18044:
18045: Compares required LON-CAPA version with version on server, and
18046: if required version is newer looks for a server with the required version.
18047:
18048: Looks first at servers in user's owen domain; if none suitable, looks at
18049: servers in course's domain are permitted to host sessions for user's domain.
18050:
18051: Inputs:
18052:
18053: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18054:
18055: $courseid - Course ID of current course
18056:
18057: $rolecode - User's current role in course (for switchserver query string).
18058:
18059: $required - LON-CAPA version needed by course (format: Major.Minor).
18060:
18061:
18062: Returns:
18063:
18064: $switchserver - query string tp append to /adm/switchserver call (if
18065: current server's LON-CAPA version is too old.
18066:
18067: $warning - Message is displayed if no suitable server could be found.
18068:
18069: =cut
18070:
18071: sub check_release_required {
18072: my ($loncaparev,$courseid,$rolecode,$required) = @_;
18073: my ($switchserver,$warning);
18074: if ($required ne '') {
18075: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
18076: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18077: if ($reqdmajor ne '' && $reqdminor ne '') {
18078: my $otherserver;
18079: if (($major eq '' && $minor eq '') ||
18080: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
18081: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
18082: my $switchlcrev =
18083: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
18084: $userdomserver);
18085: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
18086: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
18087: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
18088: my $cdom = $env{'course.'.$courseid.'.domain'};
18089: if ($cdom ne $env{'user.domain'}) {
18090: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
18091: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
18092: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
18093: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
18094: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
18095: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
18096: my $canhost =
18097: &Apache::lonnet::can_host_session($env{'user.domain'},
18098: $coursedomserver,
18099: $remoterev,
18100: $udomdefaults{'remotesessions'},
18101: $defdomdefaults{'hostedsessions'});
18102:
18103: if ($canhost) {
18104: $otherserver = $coursedomserver;
18105: } else {
18106: $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.");
18107: }
18108: } else {
18109: $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).");
18110: }
18111: } else {
18112: $otherserver = $userdomserver;
18113: }
18114: }
18115: if ($otherserver ne '') {
18116: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
18117: }
18118: }
18119: }
18120: return ($switchserver,$warning);
18121: }
18122:
18123: =pod
18124:
18125: =item * &check_release_result()
18126:
18127: Inputs:
18128:
18129: $switchwarning - Warning message if no suitable server found to host session.
18130:
18131: $switchserver - query string to append to /adm/switchserver containing lonHostID
18132: and current role.
18133:
18134: Returns: HTML to display with information about requirement to switch server.
18135: Either displaying warning with link to Roles/Courses screen or
18136: display link to switchserver.
18137:
1.1075.2.69 raeburn 18138: =cut
18139:
1.1075.2.88 raeburn 18140: sub check_release_result {
18141: my ($switchwarning,$switchserver) = @_;
18142: my $output = &start_page('Selected course unavailable on this server').
18143: '<p class="LC_warning">';
18144: if ($switchwarning) {
18145: $output .= $switchwarning.'<br /><a href="/adm/roles">';
18146: if (&show_course()) {
18147: $output .= &mt('Display courses');
18148: } else {
18149: $output .= &mt('Display roles');
18150: }
18151: $output .= '</a>';
18152: } elsif ($switchserver) {
18153: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
18154: '<br />'.
18155: '<a href="/adm/switchserver?'.$switchserver.'">'.
18156: &mt('Switch Server').
18157: '</a>';
18158: }
18159: $output .= '</p>'.&end_page();
18160: return $output;
18161: }
18162:
18163: =pod
18164:
18165: =item * &needs_coursereinit()
18166:
18167: Determine if course contents stored for user's session needs to be
18168: refreshed, because content has changed since "Big Hash" last tied.
18169:
18170: Check for change is made if time last checked is more than 10 minutes ago
18171: (by default).
18172:
18173: Inputs:
18174:
18175: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
18176:
18177: $interval (optional) - Time which may elapse (in s) between last check for content
18178: change in current course. (default: 600 s).
18179:
18180: Returns: an array; first element is:
18181:
18182: =over 4
18183:
18184: 'switch' - if content updates mean user's session
18185: needs to be switched to a server running a newer LON-CAPA version
18186:
18187: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
18188: on current server hosting user's session
18189:
18190: '' - if no action required.
18191:
18192: =back
18193:
18194: If first item element is 'switch':
18195:
18196: second item is $switchwarning - Warning message if no suitable server found to host session.
18197:
18198: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
18199: and current role.
18200:
18201: otherwise: no other elements returned.
18202:
18203: =back
18204:
18205: =cut
18206:
18207: sub needs_coursereinit {
18208: my ($loncaparev,$interval) = @_;
18209: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
18210: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18211: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
18212: my $now = time;
18213: if ($interval eq '') {
18214: $interval = 600;
18215: }
18216: if (($now-$env{'request.course.timechecked'})>$interval) {
18217: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
1.1075.2.161. .4(raebu 18218:22): my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
.1(raebu 18219:21): if ($blocked) {
18220:21): return ();
18221:21): }
.13(raeb 18222:-23): my $update;
18223:-23): my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
18224:-23): my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
18225:-23): if ($lastmainchange > $env{'request.course.tied'}) {
18226:-23): my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
18227:-23): if ($needswitch) {
18228:-23): return ('switch',$switchwarning,$switchserver);
18229:-23): }
18230:-23): $update = 'main';
18231:-23): }
18232:-23): if ($lastsuppchange > $env{'request.course.suppupdated'}) {
18233:-23): if ($update) {
18234:-23): $update = 'both';
18235:-23): } else {
18236:-23): my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
18237:-23): if ($needswitch) {
18238:-23): return ('switch',$switchwarning,$switchserver);
18239:-23): } else {
18240:-23): $update = 'supp';
1.1075.2.88 raeburn 18241: }
18242: }
1.1075.2.161. .13(raeb 18243:-23): return ($update);
18244:-23): }
18245:-23): }
18246:-23): return ();
18247:-23): }
18248:-23):
18249:-23): sub switch_for_update {
18250:-23): my ($loncaparev,$cdom,$cnum) = @_;
18251:-23): my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18252:-23): if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
18253:-23): my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
18254:-23): if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
18255:-23): &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
18256:-23): $curr_reqd_hash{'internal.releaserequired'}});
18257:-23): my ($switchserver,$switchwarning) =
18258:-23): &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
18259:-23): $curr_reqd_hash{'internal.releaserequired'});
18260:-23): if ($switchwarning ne '' || $switchserver ne '') {
18261:-23): return ('switch',$switchwarning,$switchserver);
18262:-23): }
1.1075.2.88 raeburn 18263: }
18264: }
18265: return ();
18266: }
1.1075.2.69 raeburn 18267:
1.1075.2.11 raeburn 18268: sub update_content_constraints {
18269: my ($cdom,$cnum,$chome,$cid) = @_;
18270: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
18271: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
18272: my %checkresponsetypes;
18273: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
18274: my ($item,$name,$value) = split(/:/,$key);
18275: if ($item eq 'resourcetag') {
18276: if ($name eq 'responsetype') {
18277: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
18278: }
18279: }
18280: }
18281: my $navmap = Apache::lonnavmaps::navmap->new();
18282: if (defined($navmap)) {
18283: my %allresponses;
18284: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
18285: my %responses = $res->responseTypes();
18286: foreach my $key (keys(%responses)) {
18287: next unless(exists($checkresponsetypes{$key}));
18288: $allresponses{$key} += $responses{$key};
18289: }
18290: }
18291: foreach my $key (keys(%allresponses)) {
18292: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
18293: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
18294: ($reqdmajor,$reqdminor) = ($major,$minor);
18295: }
18296: }
18297: undef($navmap);
18298: }
18299: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
18300: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
18301: }
18302: return;
18303: }
18304:
1.1075.2.27 raeburn 18305: sub allmaps_incourse {
18306: my ($cdom,$cnum,$chome,$cid) = @_;
18307: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
18308: $cid = $env{'request.course.id'};
18309: $cdom = $env{'course.'.$cid.'.domain'};
18310: $cnum = $env{'course.'.$cid.'.num'};
18311: $chome = $env{'course.'.$cid.'.home'};
18312: }
18313: my %allmaps = ();
18314: my $lastchange =
18315: &Apache::lonnet::get_coursechange($cdom,$cnum);
18316: if ($lastchange > $env{'request.course.tied'}) {
18317: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
18318: unless ($ferr) {
18319: &update_content_constraints($cdom,$cnum,$chome,$cid);
18320: }
18321: }
18322: my $navmap = Apache::lonnavmaps::navmap->new();
18323: if (defined($navmap)) {
18324: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
18325: $allmaps{$res->src()} = 1;
18326: }
18327: }
18328: return \%allmaps;
18329: }
18330:
1.1075.2.11 raeburn 18331: sub parse_supplemental_title {
18332: my ($title) = @_;
18333:
18334: my ($foldertitle,$renametitle);
18335: if ($title =~ /&&&/) {
18336: $title = &HTML::Entites::decode($title);
18337: }
18338: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
18339: $renametitle=$4;
18340: my ($time,$uname,$udom) = ($1,$2,$3);
18341: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
18342: my $name = &plainname($uname,$udom);
18343: $name = &HTML::Entities::encode($name,'"<>&\'');
18344: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
1.1075.2.161. .16(raeb 18345:-23): $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.$name;
18346:-23): if ($foldertitle ne '') {
18347:-23): $title .= ': <br />'.$foldertitle;
18348:-23): }
1.1075.2.11 raeburn 18349: }
18350: if (wantarray) {
18351: return ($title,$foldertitle,$renametitle);
18352: }
18353: return $title;
18354: }
18355:
1.1075.2.161. .13(raeb 18356:-23): sub get_supplemental {
18357:-23): my ($cnum,$cdom,$ignorecache,$possdel)=@_;
18358:-23): my $hashid=$cnum.':'.$cdom;
18359:-23): my ($supplemental,$cached,$set_httprefs);
18360:-23): unless ($ignorecache) {
18361:-23): ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
18362:-23): }
18363:-23): unless (defined($cached)) {
18364:-23): my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
18365:-23): unless ($chome eq 'no_host') {
18366:-23): my @order = @LONCAPA::map::order;
18367:-23): my @resources = @LONCAPA::map::resources;
18368:-23): my @resparms = @LONCAPA::map::resparms;
18369:-23): my @zombies = @LONCAPA::map::zombies;
18370:-23): my ($errors,%ids,%hidden);
18371:-23): $errors =
18372:-23): &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
18373:-23): $errors,$possdel,\%ids,\%hidden);
18374:-23): @LONCAPA::map::order = @order;
18375:-23): @LONCAPA::map::resources = @resources;
18376:-23): @LONCAPA::map::resparms = @resparms;
18377:-23): @LONCAPA::map::zombies = @zombies;
18378:-23): $set_httprefs = 1;
18379:-23): if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
18380:-23): &Apache::lonnet::appenv({'request.course.suppupdated' => time});
18381:-23): }
18382:-23): $supplemental = {
18383:-23): ids => \%ids,
18384:-23): hidden => \%hidden,
18385:-23): };
18386:-23): &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
18387:-23): }
18388:-23): }
18389:-23): return ($supplemental,$set_httprefs);
18390:-23): }
18391:-23):
1.1075.2.43 raeburn 18392: sub recurse_supplemental {
1.1075.2.161. .13(raeb 18393:-23): my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
18394:-23): if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
18395:-23): my $mapnum;
18396:-23): if ($suppmap eq 'supplemental.sequence') {
18397:-23): $mapnum = 0;
18398:-23): } else {
18399:-23): ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
18400:-23): }
1.1075.2.43 raeburn 18401: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
18402: if ($fatal) {
18403: $errors ++;
18404: } else {
1.1075.2.161. .13(raeb 18405:-23): my @order = @LONCAPA::map::order;
18406:-23): if (@order > 0) {
18407:-23): my @resources = @LONCAPA::map::resources;
18408:-23): my @resparms = @LONCAPA::map::resparms;
18409:-23): foreach my $idx (@order) {
18410:-23): my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1075.2.43 raeburn 18411: if (($src ne '') && ($status eq 'res')) {
1.1075.2.161. .13(raeb 18412:-23): my $id = $mapnum.':'.$idx;
18413:-23): push(@{$suppids->{$src}},$id);
18414:-23): if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
18415:-23): $hiddensupp->{$id} = 1;
18416:-23): }
1.1075.2.46 raeburn 18417: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
1.1075.2.161. .13(raeb 18418:-23): $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
18419:-23): $hiddensupp,$hiddensupp->{$id});
1.1075.2.43 raeburn 18420: } else {
1.1075.2.161. .13(raeb 18421:-23): my $allowed;
18422:-23): if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
18423:-23): $allowed = 1;
18424:-23): } elsif ($possdel) {
18425:-23): foreach my $item (@{$suppids->{$src}}) {
18426:-23): next if ($item eq $id);
18427:-23): unless ($hiddensupp->{$item}) {
18428:-23): $allowed = 1;
18429:-23): last;
18430:-23): }
18431:-23): }
18432:-23): if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
18433:-23): &Apache::lonnet::delenv('httpref.'.$src);
18434:-23): }
18435:-23): }
18436:-23): if ($allowed && (!exists($env{'httpref.'.$src}))) {
18437:-23): &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
18438:-23): }
18439:-23): }
18440:-23): }
18441:-23): }
18442:-23): }
18443:-23): }
18444:-23): }
18445:-23): return $errors;
18446:-23): }
18447:-23):
18448:-23): sub set_supp_httprefs {
18449:-23): my ($cnum,$cdom,$supplemental,$possdel) = @_;
18450:-23): if (ref($supplemental) eq 'HASH') {
18451:-23): if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
18452:-23): foreach my $src (keys(%{$supplemental->{'ids'}})) {
18453:-23): next if ($src =~ /\.sequence$/);
18454:-23): if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
18455:-23): my $allowed;
18456:-23): if ($env{'request.role.adv'}) {
18457:-23): $allowed = 1;
18458:-23): } else {
18459:-23): foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
18460:-23): unless ($supplemental->{'hidden'}->{$id}) {
18461:-23): $allowed = 1;
18462:-23): last;
18463:-23): }
18464:-23): }
18465:-23): }
18466:-23): if (exists($env{'httpref.'.$src})) {
18467:-23): if ($possdel) {
18468:-23): unless ($allowed) {
18469:-23): &Apache::lonnet::delenv('httpref.'.$src);
18470:-23): }
1.1075.2.43 raeburn 18471: }
1.1075.2.161. .13(raeb 18472:-23): } elsif ($allowed) {
18473:-23): &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
1.1075.2.43 raeburn 18474: }
18475: }
18476: }
1.1075.2.161. .13(raeb 18477:-23): if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
18478:-23): &Apache::lonnet::appenv({'request.course.suppupdated' => time});
18479:-23): }
1.1075.2.43 raeburn 18480: }
18481: }
1.1075.2.161. .13(raeb 18482:-23): }
18483:-23):
18484:-23): sub get_supp_parameter {
18485:-23): my ($resparm,$name)=@_;
18486:-23): return if ($resparm eq '');
18487:-23): my $value=undef;
18488:-23): my $ptype=undef;
18489:-23): foreach (split('&&&',$resparm)) {
18490:-23): my ($thistype,$thisname,$thisvalue)=split('___',$_);
18491:-23): if ($thisname eq $name) {
18492:-23): $value=$thisvalue;
18493:-23): $ptype=$thistype;
18494:-23): }
18495:-23): }
18496:-23): return $value;
1.1075.2.43 raeburn 18497: }
18498:
1.1075.2.18 raeburn 18499: sub symb_to_docspath {
1.1075.2.119 raeburn 18500: my ($symb,$navmapref) = @_;
18501: return unless ($symb && ref($navmapref));
1.1075.2.18 raeburn 18502: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
18503: if ($resurl=~/\.(sequence|page)$/) {
18504: $mapurl=$resurl;
18505: } elsif ($resurl eq 'adm/navmaps') {
18506: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
18507: }
18508: my $mapresobj;
1.1075.2.119 raeburn 18509: unless (ref($$navmapref)) {
18510: $$navmapref = Apache::lonnavmaps::navmap->new();
18511: }
18512: if (ref($$navmapref)) {
18513: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1075.2.18 raeburn 18514: }
18515: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
18516: my $type=$2;
18517: my $path;
18518: if (ref($mapresobj)) {
18519: my $pcslist = $mapresobj->map_hierarchy();
18520: if ($pcslist ne '') {
18521: foreach my $pc (split(/,/,$pcslist)) {
18522: next if ($pc <= 1);
1.1075.2.119 raeburn 18523: my $res = $$navmapref->getByMapPc($pc);
1.1075.2.18 raeburn 18524: if (ref($res)) {
18525: my $thisurl = $res->src();
18526: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
18527: my $thistitle = $res->title();
18528: $path .= '&'.
18529: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 18530: &escape($thistitle).
1.1075.2.18 raeburn 18531: ':'.$res->randompick().
18532: ':'.$res->randomout().
18533: ':'.$res->encrypted().
18534: ':'.$res->randomorder().
18535: ':'.$res->is_page();
18536: }
18537: }
18538: }
18539: $path =~ s/^\&//;
18540: my $maptitle = $mapresobj->title();
18541: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 18542: $maptitle = 'Main Content';
1.1075.2.18 raeburn 18543: }
18544: $path .= (($path ne '')? '&' : '').
18545: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 18546: &escape($maptitle).
1.1075.2.18 raeburn 18547: ':'.$mapresobj->randompick().
18548: ':'.$mapresobj->randomout().
18549: ':'.$mapresobj->encrypted().
18550: ':'.$mapresobj->randomorder().
18551: ':'.$mapresobj->is_page();
18552: } else {
18553: my $maptitle = &Apache::lonnet::gettitle($mapurl);
18554: my $ispage = (($type eq 'page')? 1 : '');
18555: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 18556: $maptitle = 'Main Content';
1.1075.2.18 raeburn 18557: }
18558: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 18559: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 18560: }
18561: unless ($mapurl eq 'default') {
18562: $path = 'default&'.
1.1075.2.46 raeburn 18563: &escape('Main Content').
1.1075.2.18 raeburn 18564: ':::::&'.$path;
18565: }
18566: return $path;
18567: }
18568:
1.1075.2.161. .13(raeb 18569:-23): sub validate_folderpath {
18570:-23): my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
18571:-23): if ($env{'form.folderpath'} ne '') {
18572:-23): my @items = split(/\&/,$env{'form.folderpath'});
18573:-23): my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
18574:-23): for (my $i=0; $i<@items; $i++) {
18575:-23): my $odd = $i%2;
18576:-23): if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
18577:-23): $badpath = 1;
18578:-23): } elsif ($odd && $supplementalflag) {
18579:-23): my $idx = $i-1;
18580:-23): if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
18581:-23): my $esc_name = $1;
18582:-23): if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
18583:-23): $supppath .= '&'.$esc_name;
18584:-23): $changed = 1;
18585:-23): } else {
18586:-23): $supppath .= '&'.$items[$i];
18587:-23): }
18588:-23): } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
18589:-23): $changed = 1;
18590:-23): my $is_hidden;
18591:-23): unless ($got_supp) {
18592:-23): my ($supplemental) = &get_supplemental($coursenum,$coursedom);
18593:-23): if (ref($supplemental) eq 'HASH') {
18594:-23): if (ref($supplemental->{'hidden'}) eq 'HASH') {
18595:-23): %supphidden = %{$supplemental->{'hidden'}};
18596:-23): }
18597:-23): if (ref($supplemental->{'ids'}) eq 'HASH') {
18598:-23): %suppids = %{$supplemental->{'ids'}};
18599:-23): }
18600:-23): }
18601:-23): $got_supp = 1;
18602:-23): }
18603:-23): if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
18604:-23): my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
18605:-23): if ($supphidden{$mapid}) {
18606:-23): $is_hidden = 1;
18607:-23): }
18608:-23): }
18609:-23): $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
18610:-23): } else {
18611:-23): $supppath .= '&'.$items[$i];
18612:-23): }
18613:-23): } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
18614:-23): $badpath = 1;
18615:-23): } elsif ($supplementalflag) {
18616:-23): $supppath .= '&'.$items[$i];
18617:-23): }
18618:-23): last if ($badpath);
18619:-23): }
18620:-23): if ($badpath) {
18621:-23): delete($env{'form.folderpath'});
18622:-23): } elsif ($changed && $supplementalflag) {
18623:-23): $supppath =~ s/^\&//;
18624:-23): $env{'form.folderpath'} = $supppath;
18625:-23): }
18626:-23): }
18627:-23): return;
18628:-23): }
18629:-23):
1.1075.2.14 raeburn 18630: sub captcha_display {
1.1075.2.137 raeburn 18631: my ($context,$lonhost,$defdom) = @_;
1.1075.2.14 raeburn 18632: my ($output,$error);
1.1075.2.107 raeburn 18633: my ($captcha,$pubkey,$privkey,$version) =
1.1075.2.137 raeburn 18634: &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14 raeburn 18635: if ($captcha eq 'original') {
18636: $output = &create_captcha();
18637: unless ($output) {
18638: $error = 'captcha';
18639: }
18640: } elsif ($captcha eq 'recaptcha') {
1.1075.2.107 raeburn 18641: $output = &create_recaptcha($pubkey,$version);
1.1075.2.14 raeburn 18642: unless ($output) {
18643: $error = 'recaptcha';
18644: }
18645: }
1.1075.2.107 raeburn 18646: return ($output,$error,$captcha,$version);
1.1075.2.14 raeburn 18647: }
18648:
18649: sub captcha_response {
1.1075.2.137 raeburn 18650: my ($context,$lonhost,$defdom) = @_;
1.1075.2.14 raeburn 18651: my ($captcha_chk,$captcha_error);
1.1075.2.137 raeburn 18652: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14 raeburn 18653: if ($captcha eq 'original') {
18654: ($captcha_chk,$captcha_error) = &check_captcha();
18655: } elsif ($captcha eq 'recaptcha') {
1.1075.2.107 raeburn 18656: $captcha_chk = &check_recaptcha($privkey,$version);
1.1075.2.14 raeburn 18657: } else {
18658: $captcha_chk = 1;
18659: }
18660: return ($captcha_chk,$captcha_error);
18661: }
18662:
18663: sub get_captcha_config {
1.1075.2.137 raeburn 18664: my ($context,$lonhost,$dom_in_effect) = @_;
1.1075.2.107 raeburn 18665: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1075.2.14 raeburn 18666: my $hostname = &Apache::lonnet::hostname($lonhost);
18667: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
18668: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
18669: if ($context eq 'usercreation') {
18670: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
18671: if (ref($domconfig{$context}) eq 'HASH') {
18672: $hashtocheck = $domconfig{$context}{'cancreate'};
18673: if (ref($hashtocheck) eq 'HASH') {
18674: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
18675: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
18676: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
18677: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
18678: }
18679: if ($privkey && $pubkey) {
18680: $captcha = 'recaptcha';
1.1075.2.107 raeburn 18681: $version = $hashtocheck->{'recaptchaversion'};
18682: if ($version ne '2') {
18683: $version = 1;
18684: }
1.1075.2.14 raeburn 18685: } else {
18686: $captcha = 'original';
18687: }
18688: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
18689: $captcha = 'original';
18690: }
18691: }
18692: } else {
18693: $captcha = 'captcha';
18694: }
18695: } elsif ($context eq 'login') {
18696: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
18697: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
18698: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
18699: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
18700: if ($privkey && $pubkey) {
18701: $captcha = 'recaptcha';
1.1075.2.107 raeburn 18702: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
18703: if ($version ne '2') {
18704: $version = 1;
18705: }
1.1075.2.14 raeburn 18706: } else {
18707: $captcha = 'original';
18708: }
18709: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
18710: $captcha = 'original';
18711: }
1.1075.2.137 raeburn 18712: } elsif ($context eq 'passwords') {
18713: if ($dom_in_effect) {
18714: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
18715: if ($passwdconf{'captcha'} eq 'recaptcha') {
18716: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
18717: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
18718: $privkey = $passwdconf{'recaptchakeys'}{'private'};
18719: }
18720: if ($privkey && $pubkey) {
18721: $captcha = 'recaptcha';
18722: $version = $passwdconf{'recaptchaversion'};
18723: if ($version ne '2') {
18724: $version = 1;
18725: }
18726: } else {
18727: $captcha = 'original';
18728: }
18729: } elsif ($passwdconf{'captcha'} ne 'notused') {
18730: $captcha = 'original';
18731: }
18732: }
1.1075.2.14 raeburn 18733: }
1.1075.2.107 raeburn 18734: return ($captcha,$pubkey,$privkey,$version);
1.1075.2.14 raeburn 18735: }
18736:
18737: sub create_captcha {
18738: my %captcha_params = &captcha_settings();
18739: my ($output,$maxtries,$tries) = ('',10,0);
18740: while ($tries < $maxtries) {
18741: $tries ++;
18742: my $captcha = Authen::Captcha->new (
18743: output_folder => $captcha_params{'output_dir'},
18744: data_folder => $captcha_params{'db_dir'},
18745: );
18746: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
18747:
18748: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
18749: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1075.2.158 raeburn 18750: '<span class="LC_nobreak">'.
1.1075.2.14 raeburn 18751: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.161. .15(raeb 18752:-23): '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1075.2.158 raeburn 18753: '</span><br />'.
1.1075.2.66 raeburn 18754: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 18755: last;
18756: }
18757: }
1.1075.2.158 raeburn 18758: if ($output eq '') {
18759: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
18760: }
1.1075.2.14 raeburn 18761: return $output;
18762: }
18763:
18764: sub captcha_settings {
18765: my %captcha_params = (
18766: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
18767: www_output_dir => "/captchaspool",
18768: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
18769: numchars => '5',
18770: );
18771: return %captcha_params;
18772: }
18773:
18774: sub check_captcha {
18775: my ($captcha_chk,$captcha_error);
18776: my $code = $env{'form.code'};
18777: my $md5sum = $env{'form.crypt'};
18778: my %captcha_params = &captcha_settings();
18779: my $captcha = Authen::Captcha->new(
18780: output_folder => $captcha_params{'output_dir'},
18781: data_folder => $captcha_params{'db_dir'},
18782: );
1.1075.2.26 raeburn 18783: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 18784: my %captcha_hash = (
18785: 0 => 'Code not checked (file error)',
18786: -1 => 'Failed: code expired',
18787: -2 => 'Failed: invalid code (not in database)',
18788: -3 => 'Failed: invalid code (code does not match crypt)',
18789: );
18790: if ($captcha_chk != 1) {
18791: $captcha_error = $captcha_hash{$captcha_chk}
18792: }
18793: return ($captcha_chk,$captcha_error);
18794: }
18795:
18796: sub create_recaptcha {
1.1075.2.107 raeburn 18797: my ($pubkey,$version) = @_;
18798: if ($version >= 2) {
1.1075.2.158 raeburn 18799: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
18800: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1075.2.107 raeburn 18801: } else {
18802: my $use_ssl;
18803: if ($ENV{'SERVER_PORT'} == 443) {
18804: $use_ssl = 1;
18805: }
18806: my $captcha = Captcha::reCAPTCHA->new;
18807: return $captcha->get_options_setter({theme => 'white'})."\n".
18808: $captcha->get_html($pubkey,undef,$use_ssl).
18809: &mt('If the text is hard to read, [_1] will replace them.',
18810: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
18811: '<br /><br />';
18812: }
1.1075.2.14 raeburn 18813: }
18814:
18815: sub check_recaptcha {
1.1075.2.107 raeburn 18816: my ($privkey,$version) = @_;
1.1075.2.14 raeburn 18817: my $captcha_chk;
1.1075.2.150 raeburn 18818: my $ip = &Apache::lonnet::get_requestor_ip();
1.1075.2.107 raeburn 18819: if ($version >= 2) {
18820: my $ua = LWP::UserAgent->new;
18821: $ua->timeout(10);
18822: my %info = (
18823: secret => $privkey,
18824: response => $env{'form.g-recaptcha-response'},
1.1075.2.150 raeburn 18825: remoteip => $ip,
1.1075.2.107 raeburn 18826: );
18827: my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
18828: if ($response->is_success) {
18829: my $data = JSON::DWIW->from_json($response->decoded_content);
18830: if (ref($data) eq 'HASH') {
18831: if ($data->{'success'}) {
18832: $captcha_chk = 1;
18833: }
18834: }
18835: }
18836: } else {
18837: my $captcha = Captcha::reCAPTCHA->new;
18838: my $captcha_result =
18839: $captcha->check_answer(
18840: $privkey,
1.1075.2.150 raeburn 18841: $ip,
1.1075.2.107 raeburn 18842: $env{'form.recaptcha_challenge_field'},
18843: $env{'form.recaptcha_response_field'},
18844: );
18845: if ($captcha_result->{is_valid}) {
18846: $captcha_chk = 1;
18847: }
1.1075.2.14 raeburn 18848: }
18849: return $captcha_chk;
18850: }
18851:
1.1075.2.64 raeburn 18852: sub emailusername_info {
1.1075.2.103 raeburn 18853: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1075.2.64 raeburn 18854: my %titles = &Apache::lonlocal::texthash (
18855: lastname => 'Last Name',
18856: firstname => 'First Name',
18857: institution => 'School/college/university',
18858: location => "School's city, state/province, country",
18859: web => "School's web address",
18860: officialemail => 'E-mail address at institution (if different)',
1.1075.2.103 raeburn 18861: id => 'Student/Employee ID',
1.1075.2.64 raeburn 18862: );
18863: return (\@fields,\%titles);
18864: }
18865:
1.1075.2.56 raeburn 18866: sub cleanup_html {
18867: my ($incoming) = @_;
18868: my $outgoing;
18869: if ($incoming ne '') {
18870: $outgoing = $incoming;
18871: $outgoing =~ s/;/;/g;
18872: $outgoing =~ s/\#/#/g;
18873: $outgoing =~ s/\&/&/g;
18874: $outgoing =~ s/</</g;
18875: $outgoing =~ s/>/>/g;
18876: $outgoing =~ s/\(/(/g;
18877: $outgoing =~ s/\)/)/g;
18878: $outgoing =~ s/"/"/g;
18879: $outgoing =~ s/'/'/g;
18880: $outgoing =~ s/\$/$/g;
18881: $outgoing =~ s{/}{/}g;
18882: $outgoing =~ s/=/=/g;
18883: $outgoing =~ s/\\/\/g
18884: }
18885: return $outgoing;
18886: }
18887:
1.1075.2.74 raeburn 18888: # Checks for critical messages and returns a redirect url if one exists.
18889: # $interval indicates how often to check for messages.
1.1075.2.161. .1(raebu 18890:21): # $context is the calling context -- roles, grades, contents, menu or flip.
1.1075.2.74 raeburn 18891: sub critical_redirect {
1.1075.2.161. .1(raebu 18892:21): my ($interval,$context) = @_;
1.1075.2.158 raeburn 18893: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
18894: return ();
18895: }
1.1075.2.74 raeburn 18896: if ((time-$env{'user.criticalcheck.time'})>$interval) {
1.1075.2.161. .1(raebu 18897:21): if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
18898:21): my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
18899:21): my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
.4(raebu 18900:22): my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
.1(raebu 18901:21): if ($blocked) {
18902:21): my $checkrole = "cm./$cdom/$cnum";
18903:21): if ($env{'request.course.sec'} ne '') {
18904:21): $checkrole .= "/$env{'request.course.sec'}";
18905:21): }
18906:21): unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
18907:21): ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
18908:21): return;
18909:21): }
18910:21): }
18911:21): }
1.1075.2.74 raeburn 18912: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
18913: $env{'user.name'});
18914: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
18915: my $redirecturl;
18916: if ($what[0]) {
1.1075.2.158 raeburn 18917: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1075.2.74 raeburn 18918: $redirecturl='/adm/email?critical=display';
18919: my $url=&Apache::lonnet::absolute_url().$redirecturl;
18920: return (1, $url);
18921: }
18922: }
18923: }
18924: return ();
18925: }
18926:
1.1075.2.64 raeburn 18927: # Use:
18928: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
18929: #
18930: ##################################################
18931: # password associated functions #
18932: ##################################################
18933: sub des_keys {
18934: # Make a new key for DES encryption.
18935: # Each key has two parts which are returned separately.
18936: # Please note: Each key must be passed through the &hex function
18937: # before it is output to the web browser. The hex versions cannot
18938: # be used to decrypt.
18939: my @hexstr=('0','1','2','3','4','5','6','7',
18940: '8','9','a','b','c','d','e','f');
18941: my $lkey='';
18942: for (0..7) {
18943: $lkey.=$hexstr[rand(15)];
18944: }
18945: my $ukey='';
18946: for (0..7) {
18947: $ukey.=$hexstr[rand(15)];
18948: }
18949: return ($lkey,$ukey);
18950: }
18951:
18952: sub des_decrypt {
18953: my ($key,$cyphertext) = @_;
18954: my $keybin=pack("H16",$key);
18955: my $cypher;
18956: if ($Crypt::DES::VERSION>=2.03) {
18957: $cypher=new Crypt::DES $keybin;
18958: } else {
18959: $cypher=new DES $keybin;
18960: }
1.1075.2.106 raeburn 18961: my $plaintext='';
18962: my $cypherlength = length($cyphertext);
18963: my $numchunks = int($cypherlength/32);
18964: for (my $j=0; $j<$numchunks; $j++) {
18965: my $start = $j*32;
18966: my $cypherblock = substr($cyphertext,$start,32);
18967: my $chunk =
18968: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
18969: $chunk .=
18970: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
18971: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
18972: $plaintext .= $chunk;
18973: }
1.1075.2.64 raeburn 18974: return $plaintext;
18975: }
18976:
1.1075.2.161. .1(raebu 18977:21): sub get_requested_shorturls {
18978:21): my ($cdom,$cnum,$navmap) = @_;
18979:21): return unless (ref($navmap));
18980:21): my ($numnew,$errors);
18981:21): my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
18982:21): if (@toshorten) {
18983:21): my (%maps,%resources,%titles);
18984:21): &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
18985:21): 'shorturls',$cdom,$cnum);
18986:21): if (keys(%resources)) {
18987:21): my %tocreate;
18988:21): foreach my $item (sort {$a <=> $b} (@toshorten)) {
18989:21): my $symb = $resources{$item};
18990:21): if ($symb) {
18991:21): $tocreate{$cnum.'&'.$symb} = 1;
18992:21): }
18993:21): }
18994:21): if (keys(%tocreate)) {
18995:21): ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
18996:21): \%tocreate);
18997:21): }
18998:21): }
18999:21): }
19000:21): return ($numnew,$errors);
19001:21): }
19002:21):
19003:21): sub make_short_symbs {
19004:21): my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
19005:21): my ($numnew,@errors);
19006:21): if (ref($tocreateref) eq 'HASH') {
19007:21): my %tocreate = %{$tocreateref};
19008:21): if (keys(%tocreate)) {
19009:21): my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
19010:21): my $su = Short::URL->new(no_vowels => 1);
19011:21): my $init = '';
19012:21): my (%newunique,%addcourse,%courseonly,%failed);
19013:21): # get lock on tiny db
19014:21): my $now = time;
19015:21): if ($lockuser eq '') {
19016:21): $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
19017:21): }
19018:21): my $lockhash = {
19019:21): "lock\0$now" => $lockuser,
19020:21): };
19021:21): my $tries = 0;
19022:21): my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
19023:21): my ($code,$error);
19024:21): while (($gotlock ne 'ok') && ($tries<3)) {
19025:21): $tries ++;
19026:21): sleep 1;
19027:21): $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
19028:21): }
19029:21): if ($gotlock eq 'ok') {
19030:21): $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
19031:21): \%addcourse,\%courseonly,\%failed);
19032:21): if (keys(%failed)) {
19033:21): my $numfailed = scalar(keys(%failed));
19034:21): push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
19035:21): }
19036:21): if (keys(%newunique)) {
19037:21): my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
19038:21): if ($putres eq 'ok') {
19039:21): $numnew = scalar(keys(%newunique));
19040:21): my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
19041:21): unless ($newputres eq 'ok') {
19042:21): push(@errors,&mt('error: could not store course look-up of short URLs'));
19043:21): }
19044:21): } else {
19045:21): push(@errors,&mt('error: could not store unique six character URLs'));
19046:21): }
19047:21): }
19048:21): my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
19049:21): unless ($dellockres eq 'ok') {
19050:21): push(@errors,&mt('error: could not release lockfile'));
19051:21): }
19052:21): } else {
19053:21): push(@errors,&mt('error: could not obtain lockfile'));
19054:21): }
19055:21): if (keys(%courseonly)) {
19056:21): my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
19057:21): if ($result ne 'ok') {
19058:21): push(@errors,&mt('error: could not update course look-up of short URLs'));
19059:21): }
19060:21): }
19061:21): }
19062:21): }
19063:21): return ($numnew,\@errors);
19064:21): }
19065:21):
19066:21): sub shorten_symbs {
19067:21): my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
19068:21): return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
19069:21): (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
19070:21): (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
19071:21): my (%possibles,%collisions);
19072:21): foreach my $key (keys(%{$tocreate})) {
19073:21): my $num = String::CRC32::crc32($key);
19074:21): my $tiny = $su->encode($num,$init);
19075:21): if ($tiny) {
19076:21): $possibles{$tiny} = $key;
19077:21): }
19078:21): }
19079:21): if (!$init) {
19080:21): $init = 1;
19081:21): } else {
19082:21): $init ++;
19083:21): }
19084:21): if (keys(%possibles)) {
19085:21): my @posstiny = keys(%possibles);
19086:21): my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
19087:21): my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
19088:21): if (keys(%currtiny)) {
19089:21): foreach my $key (keys(%currtiny)) {
19090:21): next if ($currtiny{$key} eq '');
19091:21): if ($currtiny{$key} eq $possibles{$key}) {
19092:21): my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
19093:21): unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19094:21): $courseonly->{$tsymb} = $key;
19095:21): }
19096:21): } else {
19097:21): $collisions{$possibles{$key}} = 1;
19098:21): }
19099:21): delete($possibles{$key});
19100:21): }
19101:21): }
19102:21): foreach my $key (keys(%possibles)) {
19103:21): $newunique->{$key} = $possibles{$key};
19104:21): my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
19105:21): unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
19106:21): $addcourse->{$tsymb} = $key;
19107:21): }
19108:21): }
19109:21): }
19110:21): if (keys(%collisions)) {
19111:21): if ($init <5) {
19112:21): if (!$init) {
19113:21): $init = 1;
19114:21): } else {
19115:21): $init ++;
19116:21): }
19117:21): $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
19118:21): $newunique,$addcourse,$courseonly,$failed);
19119:21): } else {
19120:21): foreach my $key (keys(%collisions)) {
19121:21): $failed->{$key} = 1;
19122:21): $failed->{$key} = 1;
19123:21): }
19124:21): }
19125:21): }
19126:21): return $init;
19127:21): }
19128:21):
1.1075.2.135 raeburn 19129: sub is_nonframeable {
19130: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
19131: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
19132: return if (($remprotocol eq '') || ($remhost eq ''));
19133:
19134: $remprotocol = lc($remprotocol);
19135: $remhost = lc($remhost);
19136: my $remport = 80;
19137: if ($remprotocol eq 'https') {
19138: $remport = 443;
19139: }
19140: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
19141: if ($cached) {
19142: unless ($nocache) {
19143: if ($result) {
19144: return 1;
19145: } else {
19146: return 0;
19147: }
19148: }
19149: }
19150: my $uselink;
19151: my $request = new HTTP::Request('HEAD',$url);
1.1075.2.142 raeburn 19152: my $ua = LWP::UserAgent->new;
19153: $ua->timeout(5);
19154: my $response=$ua->request($request);
1.1075.2.135 raeburn 19155: if ($response->is_success()) {
19156: my $secpolicy = lc($response->header('content-security-policy'));
19157: my $xframeop = lc($response->header('x-frame-options'));
19158: $secpolicy =~ s/^\s+|\s+$//g;
19159: $xframeop =~ s/^\s+|\s+$//g;
19160: if (($secpolicy ne '') || ($xframeop ne '')) {
19161: my $remotehost = $remprotocol.'://'.$remhost;
19162: my ($origin,$protocol,$port);
19163: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
19164: $port = $ENV{'SERVER_PORT'};
19165: } else {
19166: $port = 80;
19167: }
19168: if ($absolute eq '') {
19169: $protocol = 'http:';
19170: if ($port == 443) {
19171: $protocol = 'https:';
19172: }
19173: $origin = $protocol.'//'.lc($hostname);
19174: } else {
19175: $origin = lc($absolute);
19176: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
19177: }
19178: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
19179: my $framepolicy = $1;
19180: $framepolicy =~ s/^\s+|\s+$//g;
19181: my @policies = split(/\s+/,$framepolicy);
19182: if (@policies) {
19183: if (grep(/^\Q'none'\E$/,@policies)) {
19184: $uselink = 1;
19185: } else {
19186: $uselink = 1;
19187: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
19188: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
19189: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
19190: undef($uselink);
19191: }
19192: if ($uselink) {
19193: if (grep(/^\Q'self'\E$/,@policies)) {
19194: if (($origin ne '') && ($remotehost eq $origin)) {
19195: undef($uselink);
19196: }
19197: }
19198: }
19199: if ($uselink) {
19200: my @possok;
19201: if ($ip ne '') {
19202: push(@possok,$ip);
19203: }
19204: my $hoststr = '';
19205: foreach my $part (reverse(split(/\./,$hostname))) {
19206: if ($hoststr eq '') {
19207: $hoststr = $part;
19208: } else {
19209: $hoststr = "$part.$hoststr";
19210: }
19211: if ($hoststr eq $hostname) {
19212: push(@possok,$hostname);
19213: } else {
19214: push(@possok,"*.$hoststr");
19215: }
19216: }
19217: if (@possok) {
19218: foreach my $poss (@possok) {
19219: last if (!$uselink);
19220: foreach my $policy (@policies) {
19221: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
19222: undef($uselink);
19223: last;
19224: }
19225: }
19226: }
19227: }
19228: }
19229: }
19230: }
19231: } elsif ($xframeop ne '') {
19232: $uselink = 1;
19233: my @policies = split(/\s*,\s*/,$xframeop);
19234: if (@policies) {
19235: unless (grep(/^deny$/,@policies)) {
19236: if ($origin ne '') {
19237: if (grep(/^sameorigin$/,@policies)) {
19238: if ($remotehost eq $origin) {
19239: undef($uselink);
19240: }
19241: }
19242: if ($uselink) {
19243: foreach my $policy (@policies) {
19244: if ($policy =~ /^allow-from\s*(.+)$/) {
19245: my $allowfrom = $1;
19246: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
19247: undef($uselink);
19248: last;
19249: }
19250: }
19251: }
19252: }
19253: }
19254: }
19255: }
19256: }
19257: }
19258: }
19259: if ($nocache) {
19260: if ($cached) {
19261: my $devalidate;
19262: if ($uselink && !$result) {
19263: $devalidate = 1;
19264: } elsif (!$uselink && $result) {
19265: $devalidate = 1;
19266: }
19267: if ($devalidate) {
19268: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
19269: }
19270: }
19271: } else {
19272: if ($uselink) {
19273: $result = 1;
19274: } else {
19275: $result = 0;
19276: }
19277: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
19278: }
19279: return $uselink;
19280: }
19281:
1.1075.2.161. .1(raebu 19282:21): sub page_menu {
19283:21): my ($menucolls,$menunum) = @_;
19284:21): my %menu;
19285:21): foreach my $item (split(/;/,$menucolls)) {
19286:21): my ($num,$value) = split(/\%/,$item);
19287:21): if ($num eq $menunum) {
19288:21): my @entries = split(/\&/,$value);
19289:21): foreach my $entry (@entries) {
19290:21): my ($name,$fields) = split(/=/,$entry);
19291:21): if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
19292:21): $menu{$name} = $fields;
19293:21): } else {
19294:21): my @shown;
19295:21): if ($fields =~ /,/) {
19296:21): @shown = split(/,/,$fields);
19297:21): } else {
19298:21): @shown = ($fields);
19299:21): }
19300:21): if (@shown) {
19301:21): foreach my $field (@shown) {
19302:21): next if ($field eq '');
19303:21): $menu{$field} = 1;
19304:21): }
19305:21): }
19306:21): }
19307:21): }
19308:21): }
19309:21): }
19310:21): return %menu;
19311:21): }
19312:21):
1.112 bowersj2 19313: 1;
19314: __END__;
1.41 ng 19315:
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