Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.176
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.176! raeburn 4: # $Id: loncommon.pm,v 1.1075.2.175 2024/12/29 01:49:56 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.139 matthew 64: use HTML::Entities;
1.334 albertel 65: use Apache::lonhtmlcommon();
66: use Apache::loncoursedata();
1.344 albertel 67: use Apache::lontexconvert();
1.444 albertel 68: use Apache::lonclonecourse();
1.1075.2.25 raeburn 69: use Apache::lonuserutils();
1.1075.2.27 raeburn 70: use Apache::lonuserstate();
1.1075.2.69 raeburn 71: use Apache::courseclassifier();
1.479 albertel 72: use LONCAPA qw(:DEFAULT :match);
1.1075.2.135 raeburn 73: use HTTP::Request;
1.657 raeburn 74: use DateTime::TimeZone;
1.1075.2.102 raeburn 75: use DateTime::Locale;
1.1075.2.94 raeburn 76: use Encode();
1.1075.2.14 raeburn 77: use Authen::Captcha;
78: use Captcha::reCAPTCHA;
1.1075.2.107 raeburn 79: use JSON::DWIW;
80: use LWP::UserAgent;
1.1075.2.64 raeburn 81: use Crypt::DES;
82: use DynaLoader; # for Crypt::DES version
1.1075.2.128 raeburn 83: use File::Copy();
84: use File::Path();
1.117 www 85:
1.517 raeburn 86: # ---------------------------------------------- Designs
87: use vars qw(%defaultdesign);
88:
1.22 www 89: my $readit;
90:
1.517 raeburn 91:
1.157 matthew 92: ##
93: ## Global Variables
94: ##
1.46 matthew 95:
1.643 foxr 96:
97: # ----------------------------------------------- SSI with retries:
98: #
99:
100: =pod
101:
1.648 raeburn 102: =head1 Server Side include with retries:
1.643 foxr 103:
104: =over 4
105:
1.648 raeburn 106: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 107:
108: Performs an ssi with some number of retries. Retries continue either
109: until the result is ok or until the retry count supplied by the
110: caller is exhausted.
111:
112: Inputs:
1.648 raeburn 113:
114: =over 4
115:
1.643 foxr 116: resource - Identifies the resource to insert.
1.648 raeburn 117:
1.643 foxr 118: retries - Count of the number of retries allowed.
1.648 raeburn 119:
1.643 foxr 120: form - Hash that identifies the rendering options.
121:
1.648 raeburn 122: =back
123:
124: Returns:
125:
126: =over 4
127:
1.643 foxr 128: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 129:
1.643 foxr 130: response - The response from the last attempt (which may or may not have been successful.
131:
1.648 raeburn 132: =back
133:
134: =back
135:
1.643 foxr 136: =cut
137:
138: sub ssi_with_retries {
139: my ($resource, $retries, %form) = @_;
140:
141:
142: my $ok = 0; # True if we got a good response.
143: my $content;
144: my $response;
145:
146: # Try to get the ssi done. within the retries count:
147:
148: do {
149: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
150: $ok = $response->is_success;
1.650 www 151: if (!$ok) {
152: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
153: }
1.643 foxr 154: $retries--;
155: } while (!$ok && ($retries > 0));
156:
157: if (!$ok) {
158: $content = ''; # On error return an empty content.
159: }
160: return ($content, $response);
161:
162: }
163:
164:
165:
1.20 www 166: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 167: my %language;
1.124 www 168: my %supported_language;
1.1048 foxr 169: my %latex_language; # For choosing hyphenation in <transl..>
170: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 171: my %cprtag;
1.192 taceyjo1 172: my %scprtag;
1.351 www 173: my %fe; my %fd; my %fm;
1.41 ng 174: my %category_extensions;
1.12 harris41 175:
1.46 matthew 176: # ---------------------------------------------- Thesaurus variables
1.144 matthew 177: #
178: # %Keywords:
179: # A hash used by &keyword to determine if a word is considered a keyword.
180: # $thesaurus_db_file
181: # Scalar containing the full path to the thesaurus database.
1.46 matthew 182:
183: my %Keywords;
184: my $thesaurus_db_file;
185:
1.144 matthew 186: #
187: # Initialize values from language.tab, copyright.tab, filetypes.tab,
188: # thesaurus.tab, and filecategories.tab.
189: #
1.18 www 190: BEGIN {
1.46 matthew 191: # Variable initialization
192: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
193: #
1.22 www 194: unless ($readit) {
1.12 harris41 195: # ------------------------------------------------------------------- languages
196: {
1.158 raeburn 197: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
198: '/language.tab';
1.1075.2.128 raeburn 199: if ( open(my $fh,'<',$langtabfile) ) {
1.356 albertel 200: while (my $line = <$fh>) {
201: next if ($line=~/^\#/);
202: chomp($line);
1.1048 foxr 203: my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 204: $language{$key}=$val.' - '.$enc;
205: if ($sup) {
206: $supported_language{$key}=$sup;
207: }
1.1048 foxr 208: if ($latex) {
209: $latex_language_bykey{$key} = $latex;
210: $latex_language{$two} = $latex;
211: }
1.158 raeburn 212: }
213: close($fh);
214: }
1.12 harris41 215: }
216: # ------------------------------------------------------------------ copyrights
217: {
1.158 raeburn 218: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
219: '/copyright.tab';
1.1075.2.128 raeburn 220: if ( open (my $fh,'<',$copyrightfile) ) {
1.356 albertel 221: while (my $line = <$fh>) {
222: next if ($line=~/^\#/);
223: chomp($line);
224: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 225: $cprtag{$key}=$val;
226: }
227: close($fh);
228: }
1.12 harris41 229: }
1.351 www 230: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 231: {
232: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
233: '/source_copyright.tab';
1.1075.2.128 raeburn 234: if ( open (my $fh,'<',$sourcecopyrightfile) ) {
1.356 albertel 235: while (my $line = <$fh>) {
236: next if ($line =~ /^\#/);
237: chomp($line);
238: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 239: $scprtag{$key}=$val;
240: }
241: close($fh);
242: }
243: }
1.63 www 244:
1.517 raeburn 245: # -------------------------------------------------------------- default domain designs
1.63 www 246: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 247: my $designfile = $designdir.'/default.tab';
1.1075.2.128 raeburn 248: if ( open (my $fh,'<',$designfile) ) {
1.517 raeburn 249: while (my $line = <$fh>) {
250: next if ($line =~ /^\#/);
251: chomp($line);
252: my ($key,$val)=(split(/\=/,$line));
253: if ($val) { $defaultdesign{$key}=$val; }
254: }
255: close($fh);
1.63 www 256: }
257:
1.15 harris41 258: # ------------------------------------------------------------- file categories
259: {
1.158 raeburn 260: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
261: '/filecategories.tab';
1.1075.2.128 raeburn 262: if ( open (my $fh,'<',$categoryfile) ) {
1.356 albertel 263: while (my $line = <$fh>) {
264: next if ($line =~ /^\#/);
265: chomp($line);
266: my ($extension,$category)=(split(/\s+/,$line,2));
1.1075.2.119 raeburn 267: push(@{$category_extensions{lc($category)}},$extension);
1.158 raeburn 268: }
269: close($fh);
270: }
271:
1.15 harris41 272: }
1.12 harris41 273: # ------------------------------------------------------------------ file types
274: {
1.158 raeburn 275: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
276: '/filetypes.tab';
1.1075.2.128 raeburn 277: if ( open (my $fh,'<',$typesfile) ) {
1.356 albertel 278: while (my $line = <$fh>) {
279: next if ($line =~ /^\#/);
280: chomp($line);
281: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 282: if ($descr ne '') {
283: $fe{$ending}=lc($emb);
284: $fd{$ending}=$descr;
1.351 www 285: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 286: }
287: }
288: close($fh);
289: }
1.12 harris41 290: }
1.22 www 291: &Apache::lonnet::logthis(
1.705 tempelho 292: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 293: $readit=1;
1.46 matthew 294: } # end of unless($readit)
1.32 matthew 295:
296: }
1.112 bowersj2 297:
1.42 matthew 298: ###############################################################
299: ## HTML and Javascript Helper Functions ##
300: ###############################################################
301:
302: =pod
303:
1.112 bowersj2 304: =head1 HTML and Javascript Functions
1.42 matthew 305:
1.112 bowersj2 306: =over 4
307:
1.648 raeburn 308: =item * &browser_and_searcher_javascript()
1.112 bowersj2 309:
310: X<browsing, javascript>X<searching, javascript>Returns a string
311: containing javascript with two functions, C<openbrowser> and
312: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
313: tags.
1.42 matthew 314:
1.648 raeburn 315: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 316:
317: inputs: formname, elementname, only, omit
318:
319: formname and elementname indicate the name of the html form and name of
320: the element that the results of the browsing selection are to be placed in.
321:
322: Specifying 'only' will restrict the browser to displaying only files
1.185 www 323: with the given extension. Can be a comma separated list.
1.42 matthew 324:
325: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 326: with the given extension. Can be a comma separated list.
1.42 matthew 327:
1.648 raeburn 328: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 329:
330: Inputs: formname, elementname
331:
332: formname and elementname specify the name of the html form and the name
333: of the element the selection from the search results will be placed in.
1.542 raeburn 334:
1.42 matthew 335: =cut
336:
337: sub browser_and_searcher_javascript {
1.199 albertel 338: my ($mode)=@_;
339: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 340: my $resurl=&escape_single(&lastresurl());
1.42 matthew 341: return <<END;
1.219 albertel 342: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 343: var editbrowser = null;
1.135 albertel 344: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 345: var url = '$resurl/?';
1.42 matthew 346: if (editbrowser == null) {
347: url += 'launch=1&';
348: }
349: url += 'catalogmode=interactive&';
1.199 albertel 350: url += 'mode=$mode&';
1.611 albertel 351: url += 'inhibitmenu=yes&';
1.42 matthew 352: url += 'form=' + formname + '&';
353: if (only != null) {
354: url += 'only=' + only + '&';
1.217 albertel 355: } else {
356: url += 'only=&';
357: }
1.42 matthew 358: if (omit != null) {
359: url += 'omit=' + omit + '&';
1.217 albertel 360: } else {
361: url += 'omit=&';
362: }
1.135 albertel 363: if (titleelement != null) {
364: url += 'titleelement=' + titleelement + '&';
1.217 albertel 365: } else {
366: url += 'titleelement=&';
367: }
1.42 matthew 368: url += 'element=' + elementname + '';
369: var title = 'Browser';
1.435 albertel 370: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 371: options += ',width=700,height=600';
372: editbrowser = open(url,title,options,'1');
373: editbrowser.focus();
374: }
375: var editsearcher;
1.135 albertel 376: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 377: var url = '/adm/searchcat?';
378: if (editsearcher == null) {
379: url += 'launch=1&';
380: }
381: url += 'catalogmode=interactive&';
1.199 albertel 382: url += 'mode=$mode&';
1.42 matthew 383: url += 'form=' + formname + '&';
1.135 albertel 384: if (titleelement != null) {
385: url += 'titleelement=' + titleelement + '&';
1.217 albertel 386: } else {
387: url += 'titleelement=&';
388: }
1.42 matthew 389: url += 'element=' + elementname + '';
390: var title = 'Search';
1.435 albertel 391: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 392: options += ',width=700,height=600';
393: editsearcher = open(url,title,options,'1');
394: editsearcher.focus();
395: }
1.219 albertel 396: // END LON-CAPA Internal -->
1.42 matthew 397: END
1.170 www 398: }
399:
400: sub lastresurl {
1.258 albertel 401: if ($env{'environment.lastresurl'}) {
402: return $env{'environment.lastresurl'}
1.170 www 403: } else {
404: return '/res';
405: }
406: }
407:
408: sub storeresurl {
409: my $resurl=&Apache::lonnet::clutter(shift);
410: unless ($resurl=~/^\/res/) { return 0; }
411: $resurl=~s/\/$//;
412: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 413: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 414: return 1;
1.42 matthew 415: }
416:
1.74 www 417: sub studentbrowser_javascript {
1.111 www 418: unless (
1.258 albertel 419: (($env{'request.course.id'}) &&
1.302 albertel 420: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
421: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
422: '/'.$env{'request.course.sec'})
423: ))
1.258 albertel 424: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 425: ) { return ''; }
1.74 www 426: return (<<'ENDSTDBRW');
1.776 bisitz 427: <script type="text/javascript" language="Javascript">
1.824 bisitz 428: // <![CDATA[
1.74 www 429: var stdeditbrowser;
1.1075.2.143 raeburn 430: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
1.74 www 431: var url = '/adm/pickstudent?';
432: var filter;
1.558 albertel 433: if (!ignorefilter) {
434: eval('filter=document.'+formname+'.'+uname+'.value;');
435: }
1.74 www 436: if (filter != null) {
437: if (filter != '') {
438: url += 'filter='+filter+'&';
439: }
440: }
441: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 442: '&udomelement='+udom+
443: '&clicker='+clicker;
1.111 www 444: if (roleflag) { url+="&roles=1"; }
1.1075.2.143 raeburn 445: if (courseadv == 'condition') {
446: if (document.getElementById('courseadv')) {
447: courseadv = document.getElementById('courseadv').value;
448: }
449: }
450: if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; }
1.102 www 451: var title = 'Student_Browser';
1.74 www 452: var options = 'scrollbars=1,resizable=1,menubar=0';
453: options += ',width=700,height=600';
454: stdeditbrowser = open(url,title,options,'1');
455: stdeditbrowser.focus();
456: }
1.824 bisitz 457: // ]]>
1.74 www 458: </script>
459: ENDSTDBRW
460: }
1.42 matthew 461:
1.1003 www 462: sub resourcebrowser_javascript {
463: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 464: return (<<'ENDRESBRW');
1.1003 www 465: <script type="text/javascript" language="Javascript">
466: // <![CDATA[
467: var reseditbrowser;
1.1004 www 468: function openresbrowser(formname,reslink) {
1.1005 www 469: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 470: var title = 'Resource_Browser';
471: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 472: options += ',width=700,height=500';
1.1004 www 473: reseditbrowser = open(url,title,options,'1');
474: reseditbrowser.focus();
1.1003 www 475: }
476: // ]]>
477: </script>
1.1004 www 478: ENDRESBRW
1.1003 www 479: }
480:
1.74 www 481: sub selectstudent_link {
1.1075.2.143 raeburn 482: my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
1.999 www 483: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
484: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
485: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 486: if ($env{'request.course.id'}) {
1.302 albertel 487: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
488: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
489: '/'.$env{'request.course.sec'})) {
1.111 www 490: return '';
491: }
1.999 www 492: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.1075.2.143 raeburn 493: if ($courseadv eq 'only') {
494: $callargs .= ",'',1,'$courseadv'";
495: } elsif ($courseadv eq 'none') {
496: $callargs .= ",'','','$courseadv'";
497: } elsif ($courseadv eq 'condition') {
498: $callargs .= ",'','','$courseadv'";
1.793 raeburn 499: }
500: return '<span class="LC_nobreak">'.
501: '<a href="javascript:openstdbrowser('.$callargs.');">'.
502: &mt('Select User').'</a></span>';
1.74 www 503: }
1.258 albertel 504: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 505: $callargs .= ",'',1";
1.793 raeburn 506: return '<span class="LC_nobreak">'.
507: '<a href="javascript:openstdbrowser('.$callargs.');">'.
508: &mt('Select User').'</a></span>';
1.111 www 509: }
510: return '';
1.91 www 511: }
512:
1.1004 www 513: sub selectresource_link {
514: my ($form,$reslink,$arg)=@_;
515:
516: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
517: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
518: unless ($env{'request.course.id'}) { return $arg; }
519: return '<span class="LC_nobreak">'.
520: '<a href="javascript:openresbrowser('.$callargs.');">'.
521: $arg.'</a></span>';
522: }
523:
524:
525:
1.653 raeburn 526: sub authorbrowser_javascript {
527: return <<"ENDAUTHORBRW";
1.776 bisitz 528: <script type="text/javascript" language="JavaScript">
1.824 bisitz 529: // <![CDATA[
1.653 raeburn 530: var stdeditbrowser;
531:
532: function openauthorbrowser(formname,udom) {
533: var url = '/adm/pickauthor?';
534: url += 'form='+formname+'&roledom='+udom;
535: var title = 'Author_Browser';
536: var options = 'scrollbars=1,resizable=1,menubar=0';
537: options += ',width=700,height=600';
538: stdeditbrowser = open(url,title,options,'1');
539: stdeditbrowser.focus();
540: }
541:
1.824 bisitz 542: // ]]>
1.653 raeburn 543: </script>
544: ENDAUTHORBRW
545: }
546:
1.91 www 547: sub coursebrowser_javascript {
1.1075.2.31 raeburn 548: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
1.1075.2.95 raeburn 549: $credits_element,$instcode) = @_;
1.932 raeburn 550: my $wintitle = 'Course_Browser';
1.931 raeburn 551: if ($crstype eq 'Community') {
1.932 raeburn 552: $wintitle = 'Community_Browser';
1.909 raeburn 553: }
1.876 raeburn 554: my $id_functions = &javascript_index_functions();
555: my $output = '
1.776 bisitz 556: <script type="text/javascript" language="JavaScript">
1.824 bisitz 557: // <![CDATA[
1.468 raeburn 558: var stdeditbrowser;'."\n";
1.876 raeburn 559:
560: $output .= <<"ENDSTDBRW";
1.909 raeburn 561: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 562: var url = '/adm/pickcourse?';
1.895 raeburn 563: var formid = getFormIdByName(formname);
1.876 raeburn 564: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 565: if (domainfilter != null) {
566: if (domainfilter != '') {
567: url += 'domainfilter='+domainfilter+'&';
568: }
569: }
1.91 www 570: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 571: '&cdomelement='+udom+
572: '&cnameelement='+desc;
1.468 raeburn 573: if (extra_element !=null && extra_element != '') {
1.594 raeburn 574: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 575: url += '&roleelement='+extra_element;
576: if (domainfilter == null || domainfilter == '') {
577: url += '&domainfilter='+extra_element;
578: }
1.234 raeburn 579: }
1.468 raeburn 580: else {
581: if (formname == 'portform') {
582: url += '&setroles='+extra_element;
1.800 raeburn 583: } else {
584: if (formname == 'rules') {
585: url += '&fixeddom='+extra_element;
586: }
1.468 raeburn 587: }
588: }
1.230 raeburn 589: }
1.909 raeburn 590: if (type != null && type != '') {
591: url += '&type='+type;
592: }
593: if (type_elem != null && type_elem != '') {
594: url += '&typeelement='+type_elem;
595: }
1.872 raeburn 596: if (formname == 'ccrs') {
597: var ownername = document.forms[formid].ccuname.value;
598: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
1.1075.2.101 raeburn 599: url += '&cloner='+ownername+':'+ownerdom;
600: if (type == 'Course') {
601: url += '&crscode='+document.forms[formid].crscode.value;
602: }
1.1075.2.95 raeburn 603: }
604: if (formname == 'requestcrs') {
605: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 606: }
1.293 raeburn 607: if (multflag !=null && multflag != '') {
608: url += '&multiple='+multflag;
609: }
1.909 raeburn 610: var title = '$wintitle';
1.91 www 611: var options = 'scrollbars=1,resizable=1,menubar=0';
612: options += ',width=700,height=600';
613: stdeditbrowser = open(url,title,options,'1');
614: stdeditbrowser.focus();
615: }
1.876 raeburn 616: $id_functions
617: ENDSTDBRW
1.1075.2.31 raeburn 618: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
619: $output .= &setsec_javascript($sec_element,$formname,$role_element,
620: $credits_element);
1.876 raeburn 621: }
622: $output .= '
623: // ]]>
624: </script>';
625: return $output;
626: }
627:
628: sub javascript_index_functions {
629: return <<"ENDJS";
630:
631: function getFormIdByName(formname) {
632: for (var i=0;i<document.forms.length;i++) {
633: if (document.forms[i].name == formname) {
634: return i;
635: }
636: }
637: return -1;
638: }
639:
640: function getIndexByName(formid,item) {
641: for (var i=0;i<document.forms[formid].elements.length;i++) {
642: if (document.forms[formid].elements[i].name == item) {
643: return i;
644: }
645: }
646: return -1;
647: }
1.468 raeburn 648:
1.876 raeburn 649: function getDomainFromSelectbox(formname,udom) {
650: var userdom;
651: var formid = getFormIdByName(formname);
652: if (formid > -1) {
653: var domid = getIndexByName(formid,udom);
654: if (domid > -1) {
655: if (document.forms[formid].elements[domid].type == 'select-one') {
656: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
657: }
658: if (document.forms[formid].elements[domid].type == 'hidden') {
659: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 660: }
661: }
662: }
1.876 raeburn 663: return userdom;
664: }
665:
666: ENDJS
1.468 raeburn 667:
1.876 raeburn 668: }
669:
1.1017 raeburn 670: sub javascript_array_indexof {
1.1018 raeburn 671: return <<ENDJS;
1.1017 raeburn 672: <script type="text/javascript" language="JavaScript">
673: // <![CDATA[
674:
675: if (!Array.prototype.indexOf) {
676: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
677: "use strict";
678: if (this === void 0 || this === null) {
679: throw new TypeError();
680: }
681: var t = Object(this);
682: var len = t.length >>> 0;
683: if (len === 0) {
684: return -1;
685: }
686: var n = 0;
687: if (arguments.length > 0) {
688: n = Number(arguments[1]);
689: if (n !== n) { // shortcut for verifying if it's NaN
690: n = 0;
691: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
692: n = (n > 0 || -1) * Math.floor(Math.abs(n));
693: }
694: }
695: if (n >= len) {
696: return -1;
697: }
698: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
699: for (; k < len; k++) {
700: if (k in t && t[k] === searchElement) {
701: return k;
702: }
703: }
704: return -1;
705: }
706: }
707:
708: // ]]>
709: </script>
710:
711: ENDJS
712:
713: }
714:
1.876 raeburn 715: sub userbrowser_javascript {
716: my $id_functions = &javascript_index_functions();
717: return <<"ENDUSERBRW";
718:
1.888 raeburn 719: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 720: var url = '/adm/pickuser?';
721: var userdom = getDomainFromSelectbox(formname,udom);
722: if (userdom != null) {
723: if (userdom != '') {
724: url += 'srchdom='+userdom+'&';
725: }
726: }
727: url += 'form=' + formname + '&unameelement='+uname+
728: '&udomelement='+udom+
729: '&ulastelement='+ulast+
730: '&ufirstelement='+ufirst+
731: '&uemailelement='+uemail+
1.881 raeburn 732: '&hideudomelement='+hideudom+
733: '&coursedom='+crsdom;
1.888 raeburn 734: if ((caller != null) && (caller != undefined)) {
735: url += '&caller='+caller;
736: }
1.876 raeburn 737: var title = 'User_Browser';
738: var options = 'scrollbars=1,resizable=1,menubar=0';
739: options += ',width=700,height=600';
740: var stdeditbrowser = open(url,title,options,'1');
741: stdeditbrowser.focus();
742: }
743:
1.888 raeburn 744: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 745: var formid = getFormIdByName(formname);
746: if (formid > -1) {
1.888 raeburn 747: var unameid = getIndexByName(formid,uname);
1.876 raeburn 748: var domid = getIndexByName(formid,udom);
749: var hidedomid = getIndexByName(formid,origdom);
750: if (hidedomid > -1) {
751: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 752: var unameval = document.forms[formid].elements[unameid].value;
753: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
754: if (domid > -1) {
755: var slct = document.forms[formid].elements[domid];
756: if (slct.type == 'select-one') {
757: var i;
758: for (i=0;i<slct.length;i++) {
759: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
760: }
761: }
762: if (slct.type == 'hidden') {
763: slct.value = fixeddom;
1.876 raeburn 764: }
765: }
1.468 raeburn 766: }
767: }
768: }
1.876 raeburn 769: return;
770: }
771:
772: $id_functions
773: ENDUSERBRW
1.468 raeburn 774: }
775:
776: sub setsec_javascript {
1.1075.2.31 raeburn 777: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 778: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
779: $communityrolestr);
780: if ($role_element ne '') {
781: my @allroles = ('st','ta','ep','in','ad');
782: foreach my $crstype ('Course','Community') {
783: if ($crstype eq 'Community') {
784: foreach my $role (@allroles) {
785: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
786: }
787: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
788: } else {
789: foreach my $role (@allroles) {
790: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
791: }
792: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
793: }
794: }
795: $rolestr = '"'.join('","',@allroles).'"';
796: $courserolestr = '"'.join('","',@courserolenames).'"';
797: $communityrolestr = '"'.join('","',@communityrolenames).'"';
798: }
1.468 raeburn 799: my $setsections = qq|
800: function setSect(sectionlist) {
1.629 raeburn 801: var sectionsArray = new Array();
802: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
803: sectionsArray = sectionlist.split(",");
804: }
1.468 raeburn 805: var numSections = sectionsArray.length;
806: document.$formname.$sec_element.length = 0;
807: if (numSections == 0) {
808: document.$formname.$sec_element.multiple=false;
809: document.$formname.$sec_element.size=1;
810: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
811: } else {
812: if (numSections == 1) {
813: document.$formname.$sec_element.multiple=false;
814: document.$formname.$sec_element.size=1;
815: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
816: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
817: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
818: } else {
819: for (var i=0; i<numSections; i++) {
820: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
821: }
822: document.$formname.$sec_element.multiple=true
823: if (numSections < 3) {
824: document.$formname.$sec_element.size=numSections;
825: } else {
826: document.$formname.$sec_element.size=3;
827: }
828: document.$formname.$sec_element.options[0].selected = false
829: }
830: }
1.91 www 831: }
1.905 raeburn 832:
833: function setRole(crstype) {
1.468 raeburn 834: |;
1.905 raeburn 835: if ($role_element eq '') {
836: $setsections .= ' return;
837: }
838: ';
839: } else {
840: $setsections .= qq|
841: var elementLength = document.$formname.$role_element.length;
842: var allroles = Array($rolestr);
843: var courserolenames = Array($courserolestr);
844: var communityrolenames = Array($communityrolestr);
845: if (elementLength != undefined) {
846: if (document.$formname.$role_element.options[5].value == 'cc') {
847: if (crstype == 'Course') {
848: return;
849: } else {
850: allroles[5] = 'co';
851: for (var i=0; i<6; i++) {
852: document.$formname.$role_element.options[i].value = allroles[i];
853: document.$formname.$role_element.options[i].text = communityrolenames[i];
854: }
855: }
856: } else {
857: if (crstype == 'Community') {
858: return;
859: } else {
860: allroles[5] = 'cc';
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 = courserolenames[i];
864: }
865: }
866: }
867: }
868: return;
869: }
870: |;
871: }
1.1075.2.31 raeburn 872: if ($credits_element) {
873: $setsections .= qq|
874: function setCredits(defaultcredits) {
875: document.$formname.$credits_element.value = defaultcredits;
876: return;
877: }
878: |;
879: }
1.468 raeburn 880: return $setsections;
881: }
882:
1.91 www 883: sub selectcourse_link {
1.909 raeburn 884: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
885: $typeelement) = @_;
886: my $type = $selecttype;
1.871 raeburn 887: my $linktext = &mt('Select Course');
888: if ($selecttype eq 'Community') {
1.909 raeburn 889: $linktext = &mt('Select Community');
1.906 raeburn 890: } elsif ($selecttype eq 'Course/Community') {
891: $linktext = &mt('Select Course/Community');
1.909 raeburn 892: $type = '';
1.1019 raeburn 893: } elsif ($selecttype eq 'Select') {
894: $linktext = &mt('Select');
895: $type = '';
1.871 raeburn 896: }
1.787 bisitz 897: return '<span class="LC_nobreak">'
898: ."<a href='"
899: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
900: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 901: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 902: ."'>".$linktext.'</a>'
1.787 bisitz 903: .'</span>';
1.74 www 904: }
1.42 matthew 905:
1.653 raeburn 906: sub selectauthor_link {
907: my ($form,$udom)=@_;
908: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
909: &mt('Select Author').'</a>';
910: }
911:
1.876 raeburn 912: sub selectuser_link {
1.881 raeburn 913: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 914: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 915: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 916: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 917: ');">'.$linktext.'</a>';
1.876 raeburn 918: }
919:
1.273 raeburn 920: sub check_uncheck_jscript {
921: my $jscript = <<"ENDSCRT";
922: function checkAll(field) {
923: if (field.length > 0) {
924: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 925: if (!field[i].disabled) {
926: field[i].checked = true;
927: }
1.273 raeburn 928: }
929: } else {
1.1075.2.14 raeburn 930: if (!field.disabled) {
931: field.checked = true;
932: }
1.273 raeburn 933: }
934: }
935:
936: function uncheckAll(field) {
937: if (field.length > 0) {
938: for (i = 0; i < field.length; i++) {
939: field[i].checked = false ;
1.543 albertel 940: }
941: } else {
1.273 raeburn 942: field.checked = false ;
943: }
944: }
945: ENDSCRT
946: return $jscript;
947: }
948:
1.656 www 949: sub select_timezone {
1.1075.2.115 raeburn 950: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
951: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.659 raeburn 952: if ($includeempty) {
953: $output .= '<option value=""';
954: if (($selected eq '') || ($selected eq 'local')) {
955: $output .= ' selected="selected" ';
956: }
957: $output .= '> </option>';
958: }
1.657 raeburn 959: my @timezones = DateTime::TimeZone->all_names;
960: foreach my $tzone (@timezones) {
961: $output.= '<option value="'.$tzone.'"';
962: if ($tzone eq $selected) {
963: $output.=' selected="selected"';
964: }
965: $output.=">$tzone</option>\n";
1.656 www 966: }
967: $output.="</select>";
968: return $output;
969: }
1.273 raeburn 970:
1.687 raeburn 971: sub select_datelocale {
1.1075.2.115 raeburn 972: my ($name,$selected,$onchange,$includeempty,$disabled)=@_;
973: my $output='<select name="'.$name.'" '.$onchange.$disabled.'>'."\n";
1.687 raeburn 974: if ($includeempty) {
975: $output .= '<option value=""';
976: if ($selected eq '') {
977: $output .= ' selected="selected" ';
978: }
979: $output .= '> </option>';
980: }
1.1075.2.102 raeburn 981: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 982: my (@possibles,%locale_names);
1.1075.2.102 raeburn 983: my @locales = DateTime::Locale->ids();
984: foreach my $id (@locales) {
985: if ($id ne '') {
986: my ($en_terr,$native_terr);
987: my $loc = DateTime::Locale->load($id);
988: if (ref($loc)) {
989: $en_terr = $loc->name();
990: $native_terr = $loc->native_name();
1.687 raeburn 991: if (grep(/^en$/,@languages) || !@languages) {
992: if ($en_terr ne '') {
993: $locale_names{$id} = '('.$en_terr.')';
994: } elsif ($native_terr ne '') {
995: $locale_names{$id} = $native_terr;
996: }
997: } else {
998: if ($native_terr ne '') {
999: $locale_names{$id} = $native_terr.' ';
1000: } elsif ($en_terr ne '') {
1001: $locale_names{$id} = '('.$en_terr.')';
1002: }
1003: }
1.1075.2.94 raeburn 1004: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102 raeburn 1005: push(@possibles,$id);
1.687 raeburn 1006: }
1007: }
1008: }
1009: foreach my $item (sort(@possibles)) {
1010: $output.= '<option value="'.$item.'"';
1011: if ($item eq $selected) {
1012: $output.=' selected="selected"';
1013: }
1014: $output.=">$item";
1015: if ($locale_names{$item} ne '') {
1.1075.2.94 raeburn 1016: $output.=' '.$locale_names{$item};
1.687 raeburn 1017: }
1018: $output.="</option>\n";
1019: }
1020: $output.="</select>";
1021: return $output;
1022: }
1023:
1.792 raeburn 1024: sub select_language {
1.1075.2.115 raeburn 1025: my ($name,$selected,$includeempty,$noedit) = @_;
1.792 raeburn 1026: my %langchoices;
1027: if ($includeempty) {
1.1075.2.32 raeburn 1028: %langchoices = ('' => 'No language preference');
1.792 raeburn 1029: }
1030: foreach my $id (&languageids()) {
1031: my $code = &supportedlanguagecode($id);
1032: if ($code) {
1033: $langchoices{$code} = &plainlanguagedescription($id);
1034: }
1035: }
1.1075.2.32 raeburn 1036: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.1075.2.115 raeburn 1037: return &select_form($selected,$name,\%langchoices,undef,$noedit);
1.792 raeburn 1038: }
1039:
1.42 matthew 1040: =pod
1.36 matthew 1041:
1.648 raeburn 1042: =item * &linked_select_forms(...)
1.36 matthew 1043:
1044: linked_select_forms returns a string containing a <script></script> block
1045: and html for two <select> menus. The select menus will be linked in that
1046: changing the value of the first menu will result in new values being placed
1047: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1048: order unless a defined order is provided.
1.36 matthew 1049:
1050: linked_select_forms takes the following ordered inputs:
1051:
1052: =over 4
1053:
1.112 bowersj2 1054: =item * $formname, the name of the <form> tag
1.36 matthew 1055:
1.112 bowersj2 1056: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1057:
1.112 bowersj2 1058: =item * $firstdefault, the default value for the first menu
1.36 matthew 1059:
1.112 bowersj2 1060: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1061:
1.112 bowersj2 1062: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1063:
1.112 bowersj2 1064: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1065:
1.609 raeburn 1066: =item * $menuorder, the order of values in the first menu
1067:
1.1075.2.31 raeburn 1068: =item * $onchangefirst, additional javascript call to execute for an onchange
1069: event for the first <select> tag
1070:
1071: =item * $onchangesecond, additional javascript call to execute for an onchange
1072: event for the second <select> tag
1073:
1.41 ng 1074: =back
1075:
1.36 matthew 1076: Below is an example of such a hash. Only the 'text', 'default', and
1077: 'select2' keys must appear as stated. keys(%menu) are the possible
1078: values for the first select menu. The text that coincides with the
1.41 ng 1079: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1080: and text for the second menu are given in the hash pointed to by
1081: $menu{$choice1}->{'select2'}.
1082:
1.112 bowersj2 1083: my %menu = ( A1 => { text =>"Choice A1" ,
1084: default => "B3",
1085: select2 => {
1086: B1 => "Choice B1",
1087: B2 => "Choice B2",
1088: B3 => "Choice B3",
1089: B4 => "Choice B4"
1.609 raeburn 1090: },
1091: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1092: },
1093: A2 => { text =>"Choice A2" ,
1094: default => "C2",
1095: select2 => {
1096: C1 => "Choice C1",
1097: C2 => "Choice C2",
1098: C3 => "Choice C3"
1.609 raeburn 1099: },
1100: order => ['C2','C1','C3'],
1.112 bowersj2 1101: },
1102: A3 => { text =>"Choice A3" ,
1103: default => "D6",
1104: select2 => {
1105: D1 => "Choice D1",
1106: D2 => "Choice D2",
1107: D3 => "Choice D3",
1108: D4 => "Choice D4",
1109: D5 => "Choice D5",
1110: D6 => "Choice D6",
1111: D7 => "Choice D7"
1.609 raeburn 1112: },
1113: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1114: }
1115: );
1.36 matthew 1116:
1117: =cut
1118:
1119: sub linked_select_forms {
1120: my ($formname,
1121: $middletext,
1122: $firstdefault,
1123: $firstselectname,
1124: $secondselectname,
1.609 raeburn 1125: $hashref,
1126: $menuorder,
1.1075.2.31 raeburn 1127: $onchangefirst,
1128: $onchangesecond
1.36 matthew 1129: ) = @_;
1130: my $second = "document.$formname.$secondselectname";
1131: my $first = "document.$formname.$firstselectname";
1132: # output the javascript to do the changing
1133: my $result = '';
1.776 bisitz 1134: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1135: $result.="// <![CDATA[\n";
1.36 matthew 1136: $result.="var select2data = new Object();\n";
1137: $" = '","';
1138: my $debug = '';
1139: foreach my $s1 (sort(keys(%$hashref))) {
1140: $result.="select2data.d_$s1 = new Object();\n";
1141: $result.="select2data.d_$s1.def = new String('".
1142: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1143: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1144: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1145: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1146: @s2values = @{$hashref->{$s1}->{'order'}};
1147: }
1.36 matthew 1148: $result.="\"@s2values\");\n";
1149: $result.="select2data.d_$s1.texts = new Array(";
1150: my @s2texts;
1151: foreach my $value (@s2values) {
1.1075.2.119 raeburn 1152: push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
1.36 matthew 1153: }
1154: $result.="\"@s2texts\");\n";
1155: }
1156: $"=' ';
1157: $result.= <<"END";
1158:
1159: function select1_changed() {
1160: // Determine new choice
1161: var newvalue = "d_" + $first.value;
1162: // update select2
1163: var values = select2data[newvalue].values;
1164: var texts = select2data[newvalue].texts;
1165: var select2def = select2data[newvalue].def;
1166: var i;
1167: // out with the old
1168: for (i = 0; i < $second.options.length; i++) {
1169: $second.options[i] = null;
1170: }
1171: // in with the nuclear
1172: for (i=0;i<values.length; i++) {
1173: $second.options[i] = new Option(values[i]);
1.143 matthew 1174: $second.options[i].value = values[i];
1.36 matthew 1175: $second.options[i].text = texts[i];
1176: if (values[i] == select2def) {
1177: $second.options[i].selected = true;
1178: }
1179: }
1180: }
1.824 bisitz 1181: // ]]>
1.36 matthew 1182: </script>
1183: END
1184: # output the initial values for the selection lists
1.1075.2.31 raeburn 1185: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1186: my @order = sort(keys(%{$hashref}));
1187: if (ref($menuorder) eq 'ARRAY') {
1188: @order = @{$menuorder};
1189: }
1190: foreach my $value (@order) {
1.36 matthew 1191: $result.=" <option value=\"$value\" ";
1.253 albertel 1192: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1193: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1194: }
1195: $result .= "</select>\n";
1196: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1197: $result .= $middletext;
1.1075.2.31 raeburn 1198: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1199: if ($onchangesecond) {
1200: $result .= ' onchange="'.$onchangesecond.'"';
1201: }
1202: $result .= ">\n";
1.36 matthew 1203: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1204:
1205: my @secondorder = sort(keys(%select2));
1206: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1207: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1208: }
1209: foreach my $value (@secondorder) {
1.36 matthew 1210: $result.=" <option value=\"$value\" ";
1.253 albertel 1211: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1212: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1213: }
1214: $result .= "</select>\n";
1215: # return $debug;
1216: return $result;
1217: } # end of sub linked_select_forms {
1218:
1.45 matthew 1219: =pod
1.44 bowersj2 1220:
1.973 raeburn 1221: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1222:
1.112 bowersj2 1223: Returns a string corresponding to an HTML link to the given help
1224: $topic, where $topic corresponds to the name of a .tex file in
1225: /home/httpd/html/adm/help/tex, with underscores replaced by
1226: spaces.
1227:
1228: $text will optionally be linked to the same topic, allowing you to
1229: link text in addition to the graphic. If you do not want to link
1230: text, but wish to specify one of the later parameters, pass an
1231: empty string.
1232:
1233: $stayOnPage is a value that will be interpreted as a boolean. If true,
1234: the link will not open a new window. If false, the link will open
1235: a new window using Javascript. (Default is false.)
1236:
1237: $width and $height are optional numerical parameters that will
1238: override the width and height of the popped up window, which may
1.973 raeburn 1239: be useful for certain help topics with big pictures included.
1240:
1241: $imgid is the id of the img tag used for the help icon. This may be
1242: used in a javascript call to switch the image src. See
1243: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1244:
1245: =cut
1246:
1247: sub help_open_topic {
1.973 raeburn 1248: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1249: $text = "" if (not defined $text);
1.44 bowersj2 1250: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1251: $width = 500 if (not defined $width);
1.44 bowersj2 1252: $height = 400 if (not defined $height);
1253: my $filename = $topic;
1254: $filename =~ s/ /_/g;
1255:
1.48 bowersj2 1256: my $template = "";
1257: my $link;
1.572 banghart 1258:
1.159 www 1259: $topic=~s/\W/\_/g;
1.44 bowersj2 1260:
1.572 banghart 1261: if (!$stayOnPage) {
1.1075.2.50 raeburn 1262: if ($env{'browser.mobile'}) {
1263: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1264: } else {
1265: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1266: }
1.1037 www 1267: } elsif ($stayOnPage eq 'popup') {
1268: $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 1269: } else {
1.48 bowersj2 1270: $link = "/adm/help/${filename}.hlp";
1271: }
1272:
1273: # Add the text
1.755 neumanie 1274: if ($text ne "") {
1.763 bisitz 1275: $template.='<span class="LC_help_open_topic">'
1276: .'<a target="_top" href="'.$link.'">'
1277: .$text.'</a>';
1.48 bowersj2 1278: }
1279:
1.763 bisitz 1280: # (Always) Add the graphic
1.179 matthew 1281: my $title = &mt('Online Help');
1.667 raeburn 1282: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1283: if ($imgid ne '') {
1284: $imgid = ' id="'.$imgid.'"';
1285: }
1.763 bisitz 1286: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1287: .'<img src="'.$helpicon.'" border="0"'
1288: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1289: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1290: .' /></a>';
1291: if ($text ne "") {
1292: $template.='</span>';
1293: }
1.44 bowersj2 1294: return $template;
1295:
1.106 bowersj2 1296: }
1297:
1298: # This is a quicky function for Latex cheatsheet editing, since it
1299: # appears in at least four places
1300: sub helpLatexCheatsheet {
1.1037 www 1301: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1302: my $out;
1.106 bowersj2 1303: my $addOther = '';
1.732 raeburn 1304: if ($topic) {
1.1037 www 1305: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1306: }
1307: $out = '<span>' # Start cheatsheet
1308: .$addOther
1309: .'<span>'
1.1037 www 1310: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1311: .'</span> <span>'
1.1037 www 1312: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1313: .'</span>';
1.732 raeburn 1314: unless ($not_author) {
1.763 bisitz 1315: $out .= ' <span>'
1.1037 www 1316: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1317: .'</span> <span>'
1.1075.2.78 raeburn 1318: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1319: .'</span>';
1.732 raeburn 1320: }
1.763 bisitz 1321: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1322: return $out;
1.172 www 1323: }
1324:
1.430 albertel 1325: sub general_help {
1326: my $helptopic='Student_Intro';
1327: if ($env{'request.role'}=~/^(ca|au)/) {
1328: $helptopic='Authoring_Intro';
1.907 raeburn 1329: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1330: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1331: } elsif ($env{'request.role'}=~/^dc/) {
1332: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1333: }
1334: return $helptopic;
1335: }
1336:
1337: sub update_help_link {
1338: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1339: my $origurl = $ENV{'REQUEST_URI'};
1340: $origurl=~s|^/~|/priv/|;
1341: my $timestamp = time;
1342: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1343: $$datum = &escape($$datum);
1344: }
1345:
1346: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1347: my $output .= <<"ENDOUTPUT";
1348: <script type="text/javascript">
1.824 bisitz 1349: // <![CDATA[
1.430 albertel 1350: banner_link = '$banner_link';
1.824 bisitz 1351: // ]]>
1.430 albertel 1352: </script>
1353: ENDOUTPUT
1354: return $output;
1355: }
1356:
1357: # now just updates the help link and generates a blue icon
1.193 raeburn 1358: sub help_open_menu {
1.430 albertel 1359: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1360: = @_;
1.949 droeschl 1361: $stayOnPage = 1;
1.430 albertel 1362: my $output;
1363: if ($component_help) {
1364: if (!$text) {
1365: $output=&help_open_topic($component_help,undef,$stayOnPage,
1366: $width,$height);
1367: } else {
1368: my $help_text;
1369: $help_text=&unescape($topic);
1370: $output='<table><tr><td>'.
1371: &help_open_topic($component_help,$help_text,$stayOnPage,
1372: $width,$height).'</td></tr></table>';
1373: }
1374: }
1375: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1376: return $output.$banner_link;
1377: }
1378:
1379: sub top_nav_help {
1.1075.2.158 raeburn 1380: my ($text,$linkattr) = @_;
1.436 albertel 1381: $text = &mt($text);
1.1075.2.60 raeburn 1382: my $stay_on_page;
1383: unless ($env{'environment.remote'} eq 'on') {
1384: $stay_on_page = 1;
1385: }
1.1075.2.61 raeburn 1386: my ($link,$banner_link);
1387: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1388: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1389: : "javascript:helpMenu('open')";
1390: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1391: }
1.201 raeburn 1392: my $title = &mt('Get help');
1.1075.2.61 raeburn 1393: if ($link) {
1394: return <<"END";
1.436 albertel 1395: $banner_link
1.1075.2.158 raeburn 1396: <a href="$link" title="$title" $linkattr>$text</a>
1.436 albertel 1397: END
1.1075.2.61 raeburn 1398: } else {
1399: return ' '.$text.' ';
1400: }
1.436 albertel 1401: }
1402:
1403: sub help_menu_js {
1.1075.2.52 raeburn 1404: my ($httphost) = @_;
1.949 droeschl 1405: my $stayOnPage = 1;
1.436 albertel 1406: my $width = 620;
1407: my $height = 600;
1.430 albertel 1408: my $helptopic=&general_help();
1.1075.2.52 raeburn 1409: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1410: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1411: my $start_page =
1412: &Apache::loncommon::start_page('Help Menu', undef,
1413: {'frameset' => 1,
1414: 'js_ready' => 1,
1.1075.2.136 raeburn 1415: 'use_absolute' => $httphost,
1.331 albertel 1416: 'add_entries' => {
1417: 'border' => '0',
1.579 raeburn 1418: 'rows' => "110,*",},});
1.331 albertel 1419: my $end_page =
1420: &Apache::loncommon::end_page({'frameset' => 1,
1421: 'js_ready' => 1,});
1422:
1.436 albertel 1423: my $template .= <<"ENDTEMPLATE";
1424: <script type="text/javascript">
1.877 bisitz 1425: // <![CDATA[
1.253 albertel 1426: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1427: var banner_link = '';
1.243 raeburn 1428: function helpMenu(target) {
1429: var caller = this;
1430: if (target == 'open') {
1431: var newWindow = null;
1432: try {
1.262 albertel 1433: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1434: }
1435: catch(error) {
1436: writeHelp(caller);
1437: return;
1438: }
1439: if (newWindow) {
1440: caller = newWindow;
1441: }
1.193 raeburn 1442: }
1.243 raeburn 1443: writeHelp(caller);
1444: return;
1445: }
1446: function writeHelp(caller) {
1.1075.2.61 raeburn 1447: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1448: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1449: caller.document.close();
1450: caller.focus();
1.193 raeburn 1451: }
1.877 bisitz 1452: // END LON-CAPA Internal -->
1.253 albertel 1453: // ]]>
1.436 albertel 1454: </script>
1.193 raeburn 1455: ENDTEMPLATE
1456: return $template;
1457: }
1458:
1.172 www 1459: sub help_open_bug {
1460: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1461: unless ($env{'user.adv'}) { return ''; }
1.172 www 1462: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1463: $text = "" if (not defined $text);
1464: $stayOnPage=1;
1.184 albertel 1465: $width = 600 if (not defined $width);
1466: $height = 600 if (not defined $height);
1.172 www 1467:
1468: $topic=~s/\W+/\+/g;
1469: my $link='';
1470: my $template='';
1.379 albertel 1471: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1472: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1473: if (!$stayOnPage)
1474: {
1475: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1476: }
1477: else
1478: {
1479: $link = $url;
1480: }
1481: # Add the text
1482: if ($text ne "")
1483: {
1484: $template .=
1485: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1486: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1487: }
1488:
1489: # Add the graphic
1.179 matthew 1490: my $title = &mt('Report a Bug');
1.215 albertel 1491: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1492: $template .= <<"ENDTEMPLATE";
1.436 albertel 1493: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1494: ENDTEMPLATE
1495: if ($text ne '') { $template.='</td></tr></table>' };
1496: return $template;
1497:
1498: }
1499:
1500: sub help_open_faq {
1501: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1502: unless ($env{'user.adv'}) { return ''; }
1.172 www 1503: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1504: $text = "" if (not defined $text);
1505: $stayOnPage=1;
1506: $width = 350 if (not defined $width);
1507: $height = 400 if (not defined $height);
1508:
1509: $topic=~s/\W+/\+/g;
1510: my $link='';
1511: my $template='';
1512: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1513: if (!$stayOnPage)
1514: {
1515: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1516: }
1517: else
1518: {
1519: $link = $url;
1520: }
1521:
1522: # Add the text
1523: if ($text ne "")
1524: {
1525: $template .=
1.173 www 1526: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1527: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1528: }
1529:
1530: # Add the graphic
1.179 matthew 1531: my $title = &mt('View the FAQ');
1.215 albertel 1532: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1533: $template .= <<"ENDTEMPLATE";
1.436 albertel 1534: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1535: ENDTEMPLATE
1536: if ($text ne '') { $template.='</td></tr></table>' };
1537: return $template;
1538:
1.44 bowersj2 1539: }
1.37 matthew 1540:
1.180 matthew 1541: ###############################################################
1542: ###############################################################
1543:
1.45 matthew 1544: =pod
1545:
1.648 raeburn 1546: =item * &change_content_javascript():
1.256 matthew 1547:
1548: This and the next function allow you to create small sections of an
1549: otherwise static HTML page that you can update on the fly with
1550: Javascript, even in Netscape 4.
1551:
1552: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1553: must be written to the HTML page once. It will prove the Javascript
1554: function "change(name, content)". Calling the change function with the
1555: name of the section
1556: you want to update, matching the name passed to C<changable_area>, and
1557: the new content you want to put in there, will put the content into
1558: that area.
1559:
1560: B<Note>: Netscape 4 only reserves enough space for the changable area
1561: to contain room for the original contents. You need to "make space"
1562: for whatever changes you wish to make, and be B<sure> to check your
1563: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1564: it's adequate for updating a one-line status display, but little more.
1565: This script will set the space to 100% width, so you only need to
1566: worry about height in Netscape 4.
1567:
1568: Modern browsers are much less limiting, and if you can commit to the
1569: user not using Netscape 4, this feature may be used freely with
1570: pretty much any HTML.
1571:
1572: =cut
1573:
1574: sub change_content_javascript {
1575: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1576: if ($env{'browser.type'} eq 'netscape' &&
1577: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1578: return (<<NETSCAPE4);
1579: function change(name, content) {
1580: doc = document.layers[name+"___escape"].layers[0].document;
1581: doc.open();
1582: doc.write(content);
1583: doc.close();
1584: }
1585: NETSCAPE4
1586: } else {
1587: # Otherwise, we need to use semi-standards-compliant code
1588: # (technically, "innerHTML" isn't standard but the equivalent
1589: # is really scary, and every useful browser supports it
1590: return (<<DOMBASED);
1591: function change(name, content) {
1592: element = document.getElementById(name);
1593: element.innerHTML = content;
1594: }
1595: DOMBASED
1596: }
1597: }
1598:
1599: =pod
1600:
1.648 raeburn 1601: =item * &changable_area($name,$origContent):
1.256 matthew 1602:
1603: This provides a "changable area" that can be modified on the fly via
1604: the Javascript code provided in C<change_content_javascript>. $name is
1605: the name you will use to reference the area later; do not repeat the
1606: same name on a given HTML page more then once. $origContent is what
1607: the area will originally contain, which can be left blank.
1608:
1609: =cut
1610:
1611: sub changable_area {
1612: my ($name, $origContent) = @_;
1613:
1.258 albertel 1614: if ($env{'browser.type'} eq 'netscape' &&
1615: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1616: # If this is netscape 4, we need to use the Layer tag
1617: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1618: } else {
1619: return "<span id='$name'>$origContent</span>";
1620: }
1621: }
1622:
1623: =pod
1624:
1.648 raeburn 1625: =item * &viewport_geometry_js
1.590 raeburn 1626:
1627: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1628:
1629: =cut
1630:
1631:
1632: sub viewport_geometry_js {
1633: return <<"GEOMETRY";
1634: var Geometry = {};
1635: function init_geometry() {
1636: if (Geometry.init) { return };
1637: Geometry.init=1;
1638: if (window.innerHeight) {
1639: Geometry.getViewportHeight = function() { return window.innerHeight; };
1640: Geometry.getViewportWidth = function() { return window.innerWidth; };
1641: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1642: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1643: }
1644: else if (document.documentElement && document.documentElement.clientHeight) {
1645: Geometry.getViewportHeight =
1646: function() { return document.documentElement.clientHeight; };
1647: Geometry.getViewportWidth =
1648: function() { return document.documentElement.clientWidth; };
1649:
1650: Geometry.getHorizontalScroll =
1651: function() { return document.documentElement.scrollLeft; };
1652: Geometry.getVerticalScroll =
1653: function() { return document.documentElement.scrollTop; };
1654: }
1655: else if (document.body.clientHeight) {
1656: Geometry.getViewportHeight =
1657: function() { return document.body.clientHeight; };
1658: Geometry.getViewportWidth =
1659: function() { return document.body.clientWidth; };
1660: Geometry.getHorizontalScroll =
1661: function() { return document.body.scrollLeft; };
1662: Geometry.getVerticalScroll =
1663: function() { return document.body.scrollTop; };
1664: }
1665: }
1666:
1667: GEOMETRY
1668: }
1669:
1670: =pod
1671:
1.648 raeburn 1672: =item * &viewport_size_js()
1.590 raeburn 1673:
1674: 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.
1675:
1676: =cut
1677:
1678: sub viewport_size_js {
1679: my $geometry = &viewport_geometry_js();
1680: return <<"DIMS";
1681:
1682: $geometry
1683:
1684: function getViewportDims(width,height) {
1685: init_geometry();
1686: width.value = Geometry.getViewportWidth();
1687: height.value = Geometry.getViewportHeight();
1688: return;
1689: }
1690:
1691: DIMS
1692: }
1693:
1694: =pod
1695:
1.648 raeburn 1696: =item * &resize_textarea_js()
1.565 albertel 1697:
1698: emits the needed javascript to resize a textarea to be as big as possible
1699:
1700: creates a function resize_textrea that takes two IDs first should be
1701: the id of the element to resize, second should be the id of a div that
1702: surrounds everything that comes after the textarea, this routine needs
1703: to be attached to the <body> for the onload and onresize events.
1704:
1.648 raeburn 1705: =back
1.565 albertel 1706:
1707: =cut
1708:
1709: sub resize_textarea_js {
1.590 raeburn 1710: my $geometry = &viewport_geometry_js();
1.565 albertel 1711: return <<"RESIZE";
1712: <script type="text/javascript">
1.824 bisitz 1713: // <![CDATA[
1.590 raeburn 1714: $geometry
1.565 albertel 1715:
1.588 albertel 1716: function getX(element) {
1717: var x = 0;
1718: while (element) {
1719: x += element.offsetLeft;
1720: element = element.offsetParent;
1721: }
1722: return x;
1723: }
1724: function getY(element) {
1725: var y = 0;
1726: while (element) {
1727: y += element.offsetTop;
1728: element = element.offsetParent;
1729: }
1730: return y;
1731: }
1732:
1733:
1.565 albertel 1734: function resize_textarea(textarea_id,bottom_id) {
1735: init_geometry();
1736: var textarea = document.getElementById(textarea_id);
1737: //alert(textarea);
1738:
1.588 albertel 1739: var textarea_top = getY(textarea);
1.565 albertel 1740: var textarea_height = textarea.offsetHeight;
1741: var bottom = document.getElementById(bottom_id);
1.588 albertel 1742: var bottom_top = getY(bottom);
1.565 albertel 1743: var bottom_height = bottom.offsetHeight;
1744: var window_height = Geometry.getViewportHeight();
1.588 albertel 1745: var fudge = 23;
1.565 albertel 1746: var new_height = window_height-fudge-textarea_top-bottom_height;
1747: if (new_height < 300) {
1748: new_height = 300;
1749: }
1750: textarea.style.height=new_height+'px';
1751: }
1.824 bisitz 1752: // ]]>
1.565 albertel 1753: </script>
1754: RESIZE
1755:
1756: }
1757:
1.1075.2.112 raeburn 1758: sub colorfuleditor_js {
1759: return <<"COLORFULEDIT"
1760: <script type="text/javascript">
1761: // <![CDATA[>
1762: function fold_box(curDepth, lastresource){
1763:
1764: // we need a list because there can be several blocks you need to fold in one tag
1765: var block = document.getElementsByName('foldblock_'+curDepth);
1766: // but there is only one folding button per tag
1767: var foldbutton = document.getElementById('folding_btn_'+curDepth);
1768:
1769: if(block.item(0).style.display == 'none'){
1770:
1771: foldbutton.value = '@{[&mt("Hide")]}';
1772: for (i = 0; i < block.length; i++){
1773: block.item(i).style.display = '';
1774: }
1775: }else{
1776:
1777: foldbutton.value = '@{[&mt("Show")]}';
1778: for (i = 0; i < block.length; i++){
1779: // block.item(i).style.visibility = 'collapse';
1780: block.item(i).style.display = 'none';
1781: }
1782: };
1783: saveState(lastresource);
1784: }
1785:
1786: function saveState (lastresource) {
1787:
1788: var tag_list = getTagList();
1789: if(tag_list != null){
1790: var timestamp = new Date().getTime();
1791: var key = lastresource;
1792:
1793: // the value pattern is: 'time;key1,value1;key2,value2; ... '
1794: // starting with timestamp
1795: var value = timestamp+';';
1796:
1797: // building the list of key-value pairs
1798: for(var i = 0; i < tag_list.length; i++){
1799: value += tag_list[i]+',';
1800: value += document.getElementsByName(tag_list[i])[0].style.display+';';
1801: }
1802:
1803: // only iterate whole storage if nothing to override
1804: if(localStorage.getItem(key) == null){
1805:
1806: // prevent storage from growing large
1807: if(localStorage.length > 50){
1808: var regex_getTimestamp = /^(?:\d)+;/;
1809: var oldest_timestamp = regex_getTimestamp.exec(localStorage.key(0));
1810: var oldest_key;
1811:
1812: for(var i = 1; i < localStorage.length; i++){
1813: if (regex_getTimestamp.exec(localStorage.key(i)) < oldest_timestamp) {
1814: oldest_key = localStorage.key(i);
1815: oldest_timestamp = regex_getTimestamp.exec(oldest_key);
1816: }
1817: }
1818: localStorage.removeItem(oldest_key);
1819: }
1820: }
1821: localStorage.setItem(key,value);
1822: }
1823: }
1824:
1825: // restore folding status of blocks (on page load)
1826: function restoreState (lastresource) {
1827: if(localStorage.getItem(lastresource) != null){
1828: var key = lastresource;
1829: var value = localStorage.getItem(key);
1830: var regex_delTimestamp = /^\d+;/;
1831:
1832: value.replace(regex_delTimestamp, '');
1833:
1834: var valueArr = value.split(';');
1835: var pairs;
1836: var elements;
1837: for (var i = 0; i < valueArr.length; i++){
1838: pairs = valueArr[i].split(',');
1839: elements = document.getElementsByName(pairs[0]);
1840:
1841: for (var j = 0; j < elements.length; j++){
1842: elements[j].style.display = pairs[1];
1843: if (pairs[1] == "none"){
1844: var regex_id = /([_\\d]+)\$/;
1845: regex_id.exec(pairs[0]);
1846: document.getElementById("folding_btn"+RegExp.\$1).value = "Show";
1847: }
1848: }
1849: }
1850: }
1851: }
1852:
1853: function getTagList () {
1854:
1855: var stringToSearch = document.lonhomework.innerHTML;
1856:
1857: var ret = new Array();
1858: var regex_findBlock = /(foldblock_.*?)"/g;
1859: var tag_list = stringToSearch.match(regex_findBlock);
1860:
1861: if(tag_list != null){
1862: for(var i = 0; i < tag_list.length; i++){
1863: ret.push(tag_list[i].replace(/"/, ''));
1864: }
1865: }
1866: return ret;
1867: }
1868:
1869: function saveScrollPosition (resource) {
1870: var tag_list = getTagList();
1871:
1872: // we dont always want to jump to the first block
1873: // 170 is roughly above the "Problem Editing" header. we just want to save if the user scrolled down further than this
1874: if(\$(window).scrollTop() > 170){
1875: if(tag_list != null){
1876: var result;
1877: for(var i = 0; i < tag_list.length; i++){
1878: if(isElementInViewport(tag_list[i])){
1879: result += tag_list[i]+';';
1880: }
1881: }
1882: sessionStorage.setItem('anchor_'+resource, result);
1883: }
1884: } else {
1885: // we dont need to save zero, just delete the item to leave everything tidy
1886: sessionStorage.removeItem('anchor_'+resource);
1887: }
1888: }
1889:
1890: function restoreScrollPosition(resource){
1891:
1892: var elem = sessionStorage.getItem('anchor_'+resource);
1893: if(elem != null){
1894: var tag_list = elem.split(';');
1895: var elem_list;
1896:
1897: for(var i = 0; i < tag_list.length; i++){
1898: elem_list = document.getElementsByName(tag_list[i]);
1899:
1900: if(elem_list.length > 0){
1901: elem = elem_list[0];
1902: break;
1903: }
1904: }
1905: elem.scrollIntoView();
1906: }
1907: }
1908:
1909: function isElementInViewport(el) {
1910:
1911: // change to last element instead of first
1912: var elem = document.getElementsByName(el);
1913: var rect = elem[0].getBoundingClientRect();
1914:
1915: return (
1916: rect.top >= 0 &&
1917: rect.left >= 0 &&
1918: rect.bottom <= (window.innerHeight || document.documentElement.clientHeight) && /*or $(window).height() */
1919: rect.right <= (window.innerWidth || document.documentElement.clientWidth) /*or $(window).width() */
1920: );
1921: }
1922:
1923: function autosize(depth){
1924: var cmInst = window['cm'+depth];
1925: var fitsizeButton = document.getElementById('fitsize'+depth);
1926:
1927: // is fixed size, switching to dynamic
1928: if (sessionStorage.getItem("autosized_"+depth) == null) {
1929: cmInst.setSize("","auto");
1930: fitsizeButton.value = "@{[&mt('Fixed size')]}";
1931: sessionStorage.setItem("autosized_"+depth, "yes");
1932:
1933: // is dynamic size, switching to fixed
1934: } else {
1935: cmInst.setSize("","300px");
1936: fitsizeButton.value = "@{[&mt('Dynamic size')]}";
1937: sessionStorage.removeItem("autosized_"+depth);
1938: }
1939: }
1940:
1941:
1942:
1943: // ]]>
1944: </script>
1945: COLORFULEDIT
1946: }
1947:
1948: sub xmleditor_js {
1949: return <<XMLEDIT
1950: <script type="text/javascript" src="/adm/jQuery/addons/jquery-scrolltofixed.js"></script>
1951: <script type="text/javascript">
1952: // <![CDATA[>
1953:
1954: function saveScrollPosition (resource) {
1955:
1956: var scrollPos = \$(window).scrollTop();
1957: sessionStorage.setItem(resource,scrollPos);
1958: }
1959:
1960: function restoreScrollPosition(resource){
1961:
1962: var scrollPos = sessionStorage.getItem(resource);
1963: \$(window).scrollTop(scrollPos);
1964: }
1965:
1966: // unless internet explorer
1967: if (!(window.navigator.appName == "Microsoft Internet Explorer" && (document.documentMode || document.compatMode))){
1968:
1969: \$(document).ready(function() {
1970: \$(".LC_edit_actionbar").scrollToFixed(\{zIndex: 100\});
1971: });
1972: }
1973:
1974: // inserts text at cursor position into codemirror (xml editor only)
1975: function insertText(text){
1976: cm.focus();
1977: var curPos = cm.getCursor();
1978: cm.replaceRange(text.replace(/ESCAPEDSCRIPT/g,'script'), {line: curPos.line,ch: curPos.ch});
1979: }
1980: // ]]>
1981: </script>
1982: XMLEDIT
1983: }
1984:
1985: sub insert_folding_button {
1986: my $curDepth = $Apache::lonxml::curdepth;
1987: my $lastresource = $env{'request.ambiguous'};
1988:
1989: return "<input type=\"button\" id=\"folding_btn_$curDepth\"
1990: value=\"".&mt('Hide')."\" onclick=\"fold_box('$curDepth','$lastresource')\">";
1991: }
1992:
1993:
1.565 albertel 1994: =pod
1995:
1.256 matthew 1996: =head1 Excel and CSV file utility routines
1997:
1998: =cut
1999:
2000: ###############################################################
2001: ###############################################################
2002:
2003: =pod
2004:
1.1075.2.56 raeburn 2005: =over 4
2006:
1.648 raeburn 2007: =item * &csv_translate($text)
1.37 matthew 2008:
1.185 www 2009: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 2010: format.
2011:
2012: =cut
2013:
1.180 matthew 2014: ###############################################################
2015: ###############################################################
1.37 matthew 2016: sub csv_translate {
2017: my $text = shift;
2018: $text =~ s/\"/\"\"/g;
1.209 albertel 2019: $text =~ s/\n/ /g;
1.37 matthew 2020: return $text;
2021: }
1.180 matthew 2022:
2023: ###############################################################
2024: ###############################################################
2025:
2026: =pod
2027:
1.648 raeburn 2028: =item * &define_excel_formats()
1.180 matthew 2029:
2030: Define some commonly used Excel cell formats.
2031:
2032: Currently supported formats:
2033:
2034: =over 4
2035:
2036: =item header
2037:
2038: =item bold
2039:
2040: =item h1
2041:
2042: =item h2
2043:
2044: =item h3
2045:
1.256 matthew 2046: =item h4
2047:
2048: =item i
2049:
1.180 matthew 2050: =item date
2051:
2052: =back
2053:
2054: Inputs: $workbook
2055:
2056: Returns: $format, a hash reference.
2057:
1.1057 foxr 2058:
1.180 matthew 2059: =cut
2060:
2061: ###############################################################
2062: ###############################################################
2063: sub define_excel_formats {
2064: my ($workbook) = @_;
2065: my $format;
2066: $format->{'header'} = $workbook->add_format(bold => 1,
2067: bottom => 1,
2068: align => 'center');
2069: $format->{'bold'} = $workbook->add_format(bold=>1);
2070: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
2071: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
2072: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 2073: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 2074: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 2075: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 2076: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 2077: return $format;
2078: }
2079:
2080: ###############################################################
2081: ###############################################################
1.113 bowersj2 2082:
2083: =pod
2084:
1.648 raeburn 2085: =item * &create_workbook()
1.255 matthew 2086:
2087: Create an Excel worksheet. If it fails, output message on the
2088: request object and return undefs.
2089:
2090: Inputs: Apache request object
2091:
2092: Returns (undef) on failure,
2093: Excel worksheet object, scalar with filename, and formats
2094: from &Apache::loncommon::define_excel_formats on success
2095:
2096: =cut
2097:
2098: ###############################################################
2099: ###############################################################
2100: sub create_workbook {
2101: my ($r) = @_;
2102: #
2103: # Create the excel spreadsheet
2104: my $filename = '/prtspool/'.
1.258 albertel 2105: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 2106: time.'_'.rand(1000000000).'.xls';
2107: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
2108: if (! defined($workbook)) {
2109: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 2110: $r->print(
2111: '<p class="LC_error">'
2112: .&mt('Problems occurred in creating the new Excel file.')
2113: .' '.&mt('This error has been logged.')
2114: .' '.&mt('Please alert your LON-CAPA administrator.')
2115: .'</p>'
2116: );
1.255 matthew 2117: return (undef);
2118: }
2119: #
1.1014 foxr 2120: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 2121: #
2122: my $format = &Apache::loncommon::define_excel_formats($workbook);
2123: return ($workbook,$filename,$format);
2124: }
2125:
2126: ###############################################################
2127: ###############################################################
2128:
2129: =pod
2130:
1.648 raeburn 2131: =item * &create_text_file()
1.113 bowersj2 2132:
1.542 raeburn 2133: Create a file to write to and eventually make available to the user.
1.256 matthew 2134: If file creation fails, outputs an error message on the request object and
2135: return undefs.
1.113 bowersj2 2136:
1.256 matthew 2137: Inputs: Apache request object, and file suffix
1.113 bowersj2 2138:
1.256 matthew 2139: Returns (undef) on failure,
2140: Filehandle and filename on success.
1.113 bowersj2 2141:
2142: =cut
2143:
1.256 matthew 2144: ###############################################################
2145: ###############################################################
2146: sub create_text_file {
2147: my ($r,$suffix) = @_;
2148: if (! defined($suffix)) { $suffix = 'txt'; };
2149: my $fh;
2150: my $filename = '/prtspool/'.
1.258 albertel 2151: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 2152: time.'_'.rand(1000000000).'.'.$suffix;
2153: $fh = Apache::File->new('>/home/httpd'.$filename);
2154: if (! defined($fh)) {
2155: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 2156: $r->print(
2157: '<p class="LC_error">'
2158: .&mt('Problems occurred in creating the output file.')
2159: .' '.&mt('This error has been logged.')
2160: .' '.&mt('Please alert your LON-CAPA administrator.')
2161: .'</p>'
2162: );
1.113 bowersj2 2163: }
1.256 matthew 2164: return ($fh,$filename)
1.113 bowersj2 2165: }
2166:
2167:
1.256 matthew 2168: =pod
1.113 bowersj2 2169:
2170: =back
2171:
2172: =cut
1.37 matthew 2173:
2174: ###############################################################
1.33 matthew 2175: ## Home server <option> list generating code ##
2176: ###############################################################
1.35 matthew 2177:
1.169 www 2178: # ------------------------------------------
2179:
2180: sub domain_select {
2181: my ($name,$value,$multiple)=@_;
2182: my %domains=map {
1.514 albertel 2183: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 2184: } &Apache::lonnet::all_domains();
1.169 www 2185: if ($multiple) {
2186: $domains{''}=&mt('Any domain');
1.550 albertel 2187: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 2188: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 2189: } else {
1.550 albertel 2190: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 2191: return &select_form($name,$value,\%domains);
1.169 www 2192: }
2193: }
2194:
1.282 albertel 2195: #-------------------------------------------
2196:
2197: =pod
2198:
1.519 raeburn 2199: =head1 Routines for form select boxes
2200:
2201: =over 4
2202:
1.648 raeburn 2203: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 2204:
2205: Returns a string containing a <select> element int multiple mode
2206:
2207:
2208: Args:
2209: $name - name of the <select> element
1.506 raeburn 2210: $value - scalar or array ref of values that should already be selected
1.282 albertel 2211: $size - number of rows long the select element is
1.283 albertel 2212: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 2213: (shown text should already have been &mt())
1.506 raeburn 2214: $order - (optional) array ref of the order to show the elements in
1.283 albertel 2215:
1.282 albertel 2216: =cut
2217:
2218: #-------------------------------------------
1.169 www 2219: sub multiple_select_form {
1.284 albertel 2220: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 2221: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
2222: my $output='';
1.191 matthew 2223: if (! defined($size)) {
2224: $size = 4;
1.283 albertel 2225: if (scalar(keys(%$hash))<4) {
2226: $size = scalar(keys(%$hash));
1.191 matthew 2227: }
2228: }
1.734 bisitz 2229: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 2230: my @order;
1.506 raeburn 2231: if (ref($order) eq 'ARRAY') {
2232: @order = @{$order};
2233: } else {
2234: @order = sort(keys(%$hash));
1.501 banghart 2235: }
2236: if (exists($$hash{'select_form_order'})) {
2237: @order = @{$$hash{'select_form_order'}};
2238: }
2239:
1.284 albertel 2240: foreach my $key (@order) {
1.356 albertel 2241: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2242: $output.='selected="selected" ' if ($selected{$key});
2243: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2244: }
2245: $output.="</select>\n";
2246: return $output;
2247: }
2248:
1.88 www 2249: #-------------------------------------------
2250:
2251: =pod
2252:
1.1075.2.115 raeburn 2253: =item * &select_form($defdom,$name,$hashref,$onchange,$readonly)
1.88 www 2254:
2255: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2256: allow a user to select options from a ref to a hash containing:
2257: option_name => displayed text. An optional $onchange can include
1.1075.2.115 raeburn 2258: a javascript onchange item, e.g., onchange="this.form.submit();".
2259: An optional arg -- $readonly -- if true will cause the select form
2260: to be disabled, e.g., for the case where an instructor has a section-
2261: specific role, and is viewing/modifying parameters.
1.970 raeburn 2262:
1.88 www 2263: See lonrights.pm for an example invocation and use.
2264:
2265: =cut
2266:
2267: #-------------------------------------------
2268: sub select_form {
1.1075.2.115 raeburn 2269: my ($def,$name,$hashref,$onchange,$readonly) = @_;
1.970 raeburn 2270: return unless (ref($hashref) eq 'HASH');
2271: if ($onchange) {
2272: $onchange = ' onchange="'.$onchange.'"';
2273: }
1.1075.2.129 raeburn 2274: my $disabled;
2275: if ($readonly) {
2276: $disabled = ' disabled="disabled"';
2277: }
2278: my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.128 albertel 2279: my @keys;
1.970 raeburn 2280: if (exists($hashref->{'select_form_order'})) {
2281: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2282: } else {
1.970 raeburn 2283: @keys=sort(keys(%{$hashref}));
1.128 albertel 2284: }
1.356 albertel 2285: foreach my $key (@keys) {
2286: $selectform.=
2287: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2288: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2289: ">".$hashref->{$key}."</option>\n";
1.88 www 2290: }
2291: $selectform.="</select>";
2292: return $selectform;
2293: }
2294:
1.475 www 2295: # For display filters
2296:
2297: sub display_filter {
1.1074 raeburn 2298: my ($context) = @_;
1.475 www 2299: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2300: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2301: my $phraseinput = 'hidden';
2302: my $includeinput = 'hidden';
2303: my ($checked,$includetypestext);
2304: if ($env{'form.displayfilter'} eq 'containing') {
2305: $phraseinput = 'text';
2306: if ($context eq 'parmslog') {
2307: $includeinput = 'checkbox';
2308: if ($env{'form.includetypes'}) {
2309: $checked = ' checked="checked"';
2310: }
2311: $includetypestext = &mt('Include parameter types');
2312: }
2313: } else {
2314: $includetypestext = ' ';
2315: }
2316: my ($additional,$secondid,$thirdid);
2317: if ($context eq 'parmslog') {
2318: $additional =
2319: '<label><input type="'.$includeinput.'" name="includetypes"'.
2320: $checked.' name="includetypes" value="1" id="includetypes" />'.
2321: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2322: '</label>';
2323: $secondid = 'includetypes';
2324: $thirdid = 'includetypestext';
2325: }
2326: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2327: '$secondid','$thirdid')";
2328: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2329: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2330: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2331: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2332: &mt('Filter: [_1]',
1.477 www 2333: &select_form($env{'form.displayfilter'},
2334: 'displayfilter',
1.970 raeburn 2335: {'currentfolder' => 'Current folder/page',
1.477 www 2336: 'containing' => 'Containing phrase',
1.1074 raeburn 2337: 'none' => 'None'},$onchange)).' '.
2338: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2339: &HTML::Entities::encode($env{'form.containingphrase'}).
2340: '" />'.$additional;
2341: }
2342:
2343: sub display_filter_js {
2344: my $includetext = &mt('Include parameter types');
2345: return <<"ENDJS";
2346:
2347: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2348: var firstType = 'hidden';
2349: if (setter.options[setter.selectedIndex].value == 'containing') {
2350: firstType = 'text';
2351: }
2352: firstObject = document.getElementById(firstid);
2353: if (typeof(firstObject) == 'object') {
2354: if (firstObject.type != firstType) {
2355: changeInputType(firstObject,firstType);
2356: }
2357: }
2358: if (context == 'parmslog') {
2359: var secondType = 'hidden';
2360: if (firstType == 'text') {
2361: secondType = 'checkbox';
2362: }
2363: secondObject = document.getElementById(secondid);
2364: if (typeof(secondObject) == 'object') {
2365: if (secondObject.type != secondType) {
2366: changeInputType(secondObject,secondType);
2367: }
2368: }
2369: var textItem = document.getElementById(thirdid);
2370: var currtext = textItem.innerHTML;
2371: var newtext;
2372: if (firstType == 'text') {
2373: newtext = '$includetext';
2374: } else {
2375: newtext = ' ';
2376: }
2377: if (currtext != newtext) {
2378: textItem.innerHTML = newtext;
2379: }
2380: }
2381: return;
2382: }
2383:
2384: function changeInputType(oldObject,newType) {
2385: var newObject = document.createElement('input');
2386: newObject.type = newType;
2387: if (oldObject.size) {
2388: newObject.size = oldObject.size;
2389: }
2390: if (oldObject.value) {
2391: newObject.value = oldObject.value;
2392: }
2393: if (oldObject.name) {
2394: newObject.name = oldObject.name;
2395: }
2396: if (oldObject.id) {
2397: newObject.id = oldObject.id;
2398: }
2399: oldObject.parentNode.replaceChild(newObject,oldObject);
2400: return;
2401: }
2402:
2403: ENDJS
1.475 www 2404: }
2405:
1.167 www 2406: sub gradeleveldescription {
2407: my $gradelevel=shift;
2408: my %gradelevels=(0 => 'Not specified',
2409: 1 => 'Grade 1',
2410: 2 => 'Grade 2',
2411: 3 => 'Grade 3',
2412: 4 => 'Grade 4',
2413: 5 => 'Grade 5',
2414: 6 => 'Grade 6',
2415: 7 => 'Grade 7',
2416: 8 => 'Grade 8',
2417: 9 => 'Grade 9',
2418: 10 => 'Grade 10',
2419: 11 => 'Grade 11',
2420: 12 => 'Grade 12',
2421: 13 => 'Grade 13',
2422: 14 => '100 Level',
2423: 15 => '200 Level',
2424: 16 => '300 Level',
2425: 17 => '400 Level',
2426: 18 => 'Graduate Level');
2427: return &mt($gradelevels{$gradelevel});
2428: }
2429:
1.163 www 2430: sub select_level_form {
2431: my ($deflevel,$name)=@_;
2432: unless ($deflevel) { $deflevel=0; }
1.167 www 2433: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2434: for (my $i=0; $i<=18; $i++) {
2435: $selectform.="<option value=\"$i\" ".
1.253 albertel 2436: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2437: ">".&gradeleveldescription($i)."</option>\n";
2438: }
2439: $selectform.="</select>";
2440: return $selectform;
1.163 www 2441: }
1.167 www 2442:
1.35 matthew 2443: #-------------------------------------------
2444:
1.45 matthew 2445: =pod
2446:
1.1075.2.115 raeburn 2447: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled)
1.35 matthew 2448:
2449: Returns a string containing a <select name='$name' size='1'> form to
2450: allow a user to select the domain to preform an operation in.
2451: See loncreateuser.pm for an example invocation and use.
2452:
1.90 www 2453: If the $includeempty flag is set, it also includes an empty choice ("no domain
2454: selected");
2455:
1.743 raeburn 2456: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2457:
1.910 raeburn 2458: 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.
2459:
1.1075.2.36 raeburn 2460: The optional $incdoms is a reference to an array of domains which will be the only available options.
2461:
1.1075.2.115 raeburn 2462: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
2463:
2464: The optional $disabled argument, if true, adds the disabled attribute to the select tag.
1.563 raeburn 2465:
1.35 matthew 2466: =cut
2467:
2468: #-------------------------------------------
1.34 matthew 2469: sub select_dom_form {
1.1075.2.115 raeburn 2470: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms,$disabled) = @_;
1.872 raeburn 2471: if ($onchange) {
1.874 raeburn 2472: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2473: }
1.1075.2.115 raeburn 2474: if ($disabled) {
2475: $disabled = ' disabled="disabled"';
2476: }
1.1075.2.36 raeburn 2477: my (@domains,%exclude);
1.910 raeburn 2478: if (ref($incdoms) eq 'ARRAY') {
2479: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2480: } else {
2481: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2482: }
1.90 www 2483: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2484: if (ref($excdoms) eq 'ARRAY') {
2485: map { $exclude{$_} = 1; } @{$excdoms};
2486: }
1.1075.2.115 raeburn 2487: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
1.356 albertel 2488: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2489: next if ($exclude{$dom});
1.356 albertel 2490: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2491: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2492: if ($showdomdesc) {
2493: if ($dom ne '') {
2494: my $domdesc = &Apache::lonnet::domain($dom,'description');
2495: if ($domdesc ne '') {
2496: $selectdomain .= ' ('.$domdesc.')';
2497: }
2498: }
2499: }
2500: $selectdomain .= "</option>\n";
1.34 matthew 2501: }
2502: $selectdomain.="</select>";
2503: return $selectdomain;
2504: }
2505:
1.35 matthew 2506: #-------------------------------------------
2507:
1.45 matthew 2508: =pod
2509:
1.648 raeburn 2510: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2511:
1.586 raeburn 2512: input: 4 arguments (two required, two optional) -
2513: $domain - domain of new user
2514: $name - name of form element
2515: $default - Value of 'default' causes a default item to be first
2516: option, and selected by default.
2517: $hide - Value of 'hide' causes hiding of the name of the server,
2518: if 1 server found, or default, if 0 found.
1.594 raeburn 2519: output: returns 2 items:
1.586 raeburn 2520: (a) form element which contains either:
2521: (i) <select name="$name">
2522: <option value="$hostid1">$hostid $servers{$hostid}</option>
2523: <option value="$hostid2">$hostid $servers{$hostid}</option>
2524: </select>
2525: form item if there are multiple library servers in $domain, or
2526: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2527: if there is only one library server in $domain.
2528:
2529: (b) number of library servers found.
2530:
2531: See loncreateuser.pm for example of use.
1.35 matthew 2532:
2533: =cut
2534:
2535: #-------------------------------------------
1.586 raeburn 2536: sub home_server_form_item {
2537: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2538: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2539: my $result;
2540: my $numlib = keys(%servers);
2541: if ($numlib > 1) {
2542: $result .= '<select name="'.$name.'" />'."\n";
2543: if ($default) {
1.804 bisitz 2544: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2545: '</option>'."\n";
2546: }
2547: foreach my $hostid (sort(keys(%servers))) {
2548: $result.= '<option value="'.$hostid.'">'.
2549: $hostid.' '.$servers{$hostid}."</option>\n";
2550: }
2551: $result .= '</select>'."\n";
2552: } elsif ($numlib == 1) {
2553: my $hostid;
2554: foreach my $item (keys(%servers)) {
2555: $hostid = $item;
2556: }
2557: $result .= '<input type="hidden" name="'.$name.'" value="'.
2558: $hostid.'" />';
2559: if (!$hide) {
2560: $result .= $hostid.' '.$servers{$hostid};
2561: }
2562: $result .= "\n";
2563: } elsif ($default) {
2564: $result .= '<input type="hidden" name="'.$name.
2565: '" value="default" />';
2566: if (!$hide) {
2567: $result .= &mt('default');
2568: }
2569: $result .= "\n";
1.33 matthew 2570: }
1.586 raeburn 2571: return ($result,$numlib);
1.33 matthew 2572: }
1.112 bowersj2 2573:
2574: =pod
2575:
1.534 albertel 2576: =back
2577:
1.112 bowersj2 2578: =cut
1.87 matthew 2579:
2580: ###############################################################
1.112 bowersj2 2581: ## Decoding User Agent ##
1.87 matthew 2582: ###############################################################
2583:
2584: =pod
2585:
1.112 bowersj2 2586: =head1 Decoding the User Agent
2587:
2588: =over 4
2589:
2590: =item * &decode_user_agent()
1.87 matthew 2591:
2592: Inputs: $r
2593:
2594: Outputs:
2595:
2596: =over 4
2597:
1.112 bowersj2 2598: =item * $httpbrowser
1.87 matthew 2599:
1.112 bowersj2 2600: =item * $clientbrowser
1.87 matthew 2601:
1.112 bowersj2 2602: =item * $clientversion
1.87 matthew 2603:
1.112 bowersj2 2604: =item * $clientmathml
1.87 matthew 2605:
1.112 bowersj2 2606: =item * $clientunicode
1.87 matthew 2607:
1.112 bowersj2 2608: =item * $clientos
1.87 matthew 2609:
1.1075.2.42 raeburn 2610: =item * $clientmobile
2611:
2612: =item * $clientinfo
2613:
1.1075.2.77 raeburn 2614: =item * $clientosversion
2615:
1.87 matthew 2616: =back
2617:
1.157 matthew 2618: =back
2619:
1.87 matthew 2620: =cut
2621:
2622: ###############################################################
2623: ###############################################################
2624: sub decode_user_agent {
1.247 albertel 2625: my ($r)=@_;
1.87 matthew 2626: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2627: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2628: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2629: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2630: my $clientbrowser='unknown';
2631: my $clientversion='0';
2632: my $clientmathml='';
2633: my $clientunicode='0';
1.1075.2.42 raeburn 2634: my $clientmobile=0;
1.1075.2.77 raeburn 2635: my $clientosversion='';
1.87 matthew 2636: for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76 raeburn 2637: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2638: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2639: $clientbrowser=$bname;
2640: $httpbrowser=~/$vreg/i;
2641: $clientversion=$1;
2642: $clientmathml=($clientversion>=$minv);
2643: $clientunicode=($clientversion>=$univ);
2644: }
2645: }
2646: my $clientos='unknown';
1.1075.2.42 raeburn 2647: my $clientinfo;
1.87 matthew 2648: if (($httpbrowser=~/linux/i) ||
2649: ($httpbrowser=~/unix/i) ||
2650: ($httpbrowser=~/ux/i) ||
2651: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2652: if (($httpbrowser=~/vax/i) ||
2653: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2654: if ($httpbrowser=~/next/i) { $clientos='next'; }
2655: if (($httpbrowser=~/mac/i) ||
2656: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77 raeburn 2657: if ($httpbrowser=~/win/i) {
2658: $clientos='win';
2659: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2660: $clientosversion = $1;
2661: }
2662: }
1.87 matthew 2663: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2664: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2665: $clientmobile=lc($1);
2666: }
2667: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2668: $clientinfo = 'firefox-'.$1;
2669: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2670: $clientinfo = 'chromeframe-'.$1;
2671: }
1.87 matthew 2672: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77 raeburn 2673: $clientunicode,$clientos,$clientmobile,$clientinfo,
2674: $clientosversion);
1.87 matthew 2675: }
2676:
1.32 matthew 2677: ###############################################################
2678: ## Authentication changing form generation subroutines ##
2679: ###############################################################
2680: ##
2681: ## All of the authform_xxxxxxx subroutines take their inputs in a
2682: ## hash, and have reasonable default values.
2683: ##
2684: ## formname = the name given in the <form> tag.
1.35 matthew 2685: #-------------------------------------------
2686:
1.45 matthew 2687: =pod
2688:
1.112 bowersj2 2689: =head1 Authentication Routines
2690:
2691: =over 4
2692:
1.648 raeburn 2693: =item * &authform_xxxxxx()
1.35 matthew 2694:
2695: The authform_xxxxxx subroutines provide javascript and html forms which
2696: handle some of the conveniences required for authentication forms.
2697: This is not an optimal method, but it works.
2698:
2699: =over 4
2700:
1.112 bowersj2 2701: =item * authform_header
1.35 matthew 2702:
1.112 bowersj2 2703: =item * authform_authorwarning
1.35 matthew 2704:
1.112 bowersj2 2705: =item * authform_nochange
1.35 matthew 2706:
1.112 bowersj2 2707: =item * authform_kerberos
1.35 matthew 2708:
1.112 bowersj2 2709: =item * authform_internal
1.35 matthew 2710:
1.112 bowersj2 2711: =item * authform_filesystem
1.35 matthew 2712:
2713: =back
2714:
1.648 raeburn 2715: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2716:
1.35 matthew 2717: =cut
2718:
2719: #-------------------------------------------
1.32 matthew 2720: sub authform_header{
2721: my %in = (
2722: formname => 'cu',
1.80 albertel 2723: kerb_def_dom => '',
1.32 matthew 2724: @_,
2725: );
2726: $in{'formname'} = 'document.' . $in{'formname'};
2727: my $result='';
1.80 albertel 2728:
2729: #---------------------------------------------- Code for upper case translation
2730: my $Javascript_toUpperCase;
2731: unless ($in{kerb_def_dom}) {
2732: $Javascript_toUpperCase =<<"END";
2733: switch (choice) {
2734: case 'krb': currentform.elements[choicearg].value =
2735: currentform.elements[choicearg].value.toUpperCase();
2736: break;
2737: default:
2738: }
2739: END
2740: } else {
2741: $Javascript_toUpperCase = "";
2742: }
2743:
1.165 raeburn 2744: my $radioval = "'nochange'";
1.591 raeburn 2745: if (defined($in{'curr_authtype'})) {
2746: if ($in{'curr_authtype'} ne '') {
2747: $radioval = "'".$in{'curr_authtype'}."arg'";
2748: }
1.174 matthew 2749: }
1.165 raeburn 2750: my $argfield = 'null';
1.591 raeburn 2751: if (defined($in{'mode'})) {
1.165 raeburn 2752: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2753: if (defined($in{'curr_autharg'})) {
2754: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2755: $argfield = "'$in{'curr_autharg'}'";
2756: }
2757: }
2758: }
2759: }
2760:
1.32 matthew 2761: $result.=<<"END";
2762: var current = new Object();
1.165 raeburn 2763: current.radiovalue = $radioval;
2764: current.argfield = $argfield;
1.32 matthew 2765:
2766: function changed_radio(choice,currentform) {
2767: var choicearg = choice + 'arg';
2768: // If a radio button in changed, we need to change the argfield
2769: if (current.radiovalue != choice) {
2770: current.radiovalue = choice;
2771: if (current.argfield != null) {
2772: currentform.elements[current.argfield].value = '';
2773: }
2774: if (choice == 'nochange') {
2775: current.argfield = null;
2776: } else {
2777: current.argfield = choicearg;
2778: switch(choice) {
2779: case 'krb':
2780: currentform.elements[current.argfield].value =
2781: "$in{'kerb_def_dom'}";
2782: break;
2783: default:
2784: break;
2785: }
2786: }
2787: }
2788: return;
2789: }
1.22 www 2790:
1.32 matthew 2791: function changed_text(choice,currentform) {
2792: var choicearg = choice + 'arg';
2793: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2794: $Javascript_toUpperCase
1.32 matthew 2795: // clear old field
2796: if ((current.argfield != choicearg) && (current.argfield != null)) {
2797: currentform.elements[current.argfield].value = '';
2798: }
2799: current.argfield = choicearg;
2800: }
2801: set_auth_radio_buttons(choice,currentform);
2802: return;
1.20 www 2803: }
1.32 matthew 2804:
2805: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2806: var numauthchoices = currentform.login.length;
2807: if (typeof numauthchoices == "undefined") {
2808: return;
2809: }
1.32 matthew 2810: var i=0;
1.986 raeburn 2811: while (i < numauthchoices) {
1.32 matthew 2812: if (currentform.login[i].value == newvalue) { break; }
2813: i++;
2814: }
1.986 raeburn 2815: if (i == numauthchoices) {
1.32 matthew 2816: return;
2817: }
2818: current.radiovalue = newvalue;
2819: currentform.login[i].checked = true;
2820: return;
2821: }
2822: END
2823: return $result;
2824: }
2825:
1.1075.2.20 raeburn 2826: sub authform_authorwarning {
1.32 matthew 2827: my $result='';
1.144 matthew 2828: $result='<i>'.
2829: &mt('As a general rule, only authors or co-authors should be '.
2830: 'filesystem authenticated '.
2831: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2832: return $result;
2833: }
2834:
1.1075.2.20 raeburn 2835: sub authform_nochange {
1.32 matthew 2836: my %in = (
2837: formname => 'document.cu',
2838: kerb_def_dom => 'MSU.EDU',
2839: @_,
2840: );
1.1075.2.20 raeburn 2841: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2842: my $result;
1.1075.2.20 raeburn 2843: if (!$authnum) {
2844: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2845: } else {
2846: $result = '<label>'.&mt('[_1] Do not change login data',
2847: '<input type="radio" name="login" value="nochange" '.
2848: 'checked="checked" onclick="'.
1.281 albertel 2849: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2850: '</label>';
1.586 raeburn 2851: }
1.32 matthew 2852: return $result;
2853: }
2854:
1.591 raeburn 2855: sub authform_kerberos {
1.32 matthew 2856: my %in = (
2857: formname => 'document.cu',
2858: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2859: kerb_def_auth => 'krb4',
1.32 matthew 2860: @_,
2861: );
1.586 raeburn 2862: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
1.1075.2.117 raeburn 2863: $autharg,$jscall,$disabled);
1.1075.2.20 raeburn 2864: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2865: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2866: $check5 = ' checked="checked"';
1.80 albertel 2867: } else {
1.772 bisitz 2868: $check4 = ' checked="checked"';
1.80 albertel 2869: }
1.1075.2.117 raeburn 2870: if ($in{'readonly'}) {
2871: $disabled = ' disabled="disabled"';
2872: }
1.165 raeburn 2873: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2874: if (defined($in{'curr_authtype'})) {
2875: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2876: $krbcheck = ' checked="checked"';
1.623 raeburn 2877: if (defined($in{'mode'})) {
2878: if ($in{'mode'} eq 'modifyuser') {
2879: $krbcheck = '';
2880: }
2881: }
1.591 raeburn 2882: if (defined($in{'curr_kerb_ver'})) {
2883: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2884: $check5 = ' checked="checked"';
1.591 raeburn 2885: $check4 = '';
2886: } else {
1.772 bisitz 2887: $check4 = ' checked="checked"';
1.591 raeburn 2888: $check5 = '';
2889: }
1.586 raeburn 2890: }
1.591 raeburn 2891: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2892: $krbarg = $in{'curr_autharg'};
2893: }
1.586 raeburn 2894: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2895: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2896: $result =
2897: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2898: $in{'curr_autharg'},$krbver);
2899: } else {
2900: $result =
2901: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2902: }
2903: return $result;
2904: }
2905: }
2906: } else {
2907: if ($authnum == 1) {
1.784 bisitz 2908: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2909: }
2910: }
1.586 raeburn 2911: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2912: return;
1.587 raeburn 2913: } elsif ($authtype eq '') {
1.591 raeburn 2914: if (defined($in{'mode'})) {
1.587 raeburn 2915: if ($in{'mode'} eq 'modifycourse') {
2916: if ($authnum == 1) {
1.1075.2.117 raeburn 2917: $authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
1.587 raeburn 2918: }
2919: }
2920: }
1.586 raeburn 2921: }
2922: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2923: if ($authtype eq '') {
2924: $authtype = '<input type="radio" name="login" value="krb" '.
2925: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
1.1075.2.117 raeburn 2926: $krbcheck.$disabled.' />';
1.586 raeburn 2927: }
2928: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2929: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2930: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2931: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2932: $in{'curr_authtype'} eq 'krb4')) {
2933: $result .= &mt
1.144 matthew 2934: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2935: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2936: '<label>'.$authtype,
1.281 albertel 2937: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2938: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2939: 'onchange="'.$jscall.'"'.$disabled.' />',
2940: '<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
2941: '</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
1.281 albertel 2942: '</label>');
1.586 raeburn 2943: } elsif ($can_assign{'krb4'}) {
2944: $result .= &mt
2945: ('[_1] Kerberos authenticated with domain [_2] '.
2946: '[_3] Version 4 [_4]',
2947: '<label>'.$authtype,
2948: '</label><input type="text" size="10" name="krbarg" '.
2949: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2950: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 2951: '<label><input type="hidden" name="krbver" value="4" />',
2952: '</label>');
2953: } elsif ($can_assign{'krb5'}) {
2954: $result .= &mt
2955: ('[_1] Kerberos authenticated with domain [_2] '.
2956: '[_3] Version 5 [_4]',
2957: '<label>'.$authtype,
2958: '</label><input type="text" size="10" name="krbarg" '.
2959: 'value="'.$krbarg.'" '.
1.1075.2.117 raeburn 2960: 'onchange="'.$jscall.'"'.$disabled.' />',
1.586 raeburn 2961: '<label><input type="hidden" name="krbver" value="5" />',
2962: '</label>');
2963: }
1.32 matthew 2964: return $result;
2965: }
2966:
1.1075.2.20 raeburn 2967: sub authform_internal {
1.586 raeburn 2968: my %in = (
1.32 matthew 2969: formname => 'document.cu',
2970: kerb_def_dom => 'MSU.EDU',
2971: @_,
2972: );
1.1075.2.117 raeburn 2973: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 2974: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 2975: if ($in{'readonly'}) {
2976: $disabled = ' disabled="disabled"';
2977: }
1.591 raeburn 2978: if (defined($in{'curr_authtype'})) {
2979: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2980: if ($can_assign{'int'}) {
1.772 bisitz 2981: $intcheck = 'checked="checked" ';
1.623 raeburn 2982: if (defined($in{'mode'})) {
2983: if ($in{'mode'} eq 'modifyuser') {
2984: $intcheck = '';
2985: }
2986: }
1.591 raeburn 2987: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2988: $intarg = $in{'curr_autharg'};
2989: }
2990: } else {
2991: $result = &mt('Currently internally authenticated.');
2992: return $result;
1.165 raeburn 2993: }
2994: }
1.586 raeburn 2995: } else {
2996: if ($authnum == 1) {
1.784 bisitz 2997: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2998: }
2999: }
3000: if (!$can_assign{'int'}) {
3001: return;
1.587 raeburn 3002: } elsif ($authtype eq '') {
1.591 raeburn 3003: if (defined($in{'mode'})) {
1.587 raeburn 3004: if ($in{'mode'} eq 'modifycourse') {
3005: if ($authnum == 1) {
1.1075.2.117 raeburn 3006: $authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
1.587 raeburn 3007: }
3008: }
3009: }
1.165 raeburn 3010: }
1.586 raeburn 3011: $jscall = "javascript:changed_radio('int',$in{'formname'});";
3012: if ($authtype eq '') {
3013: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
1.1075.2.117 raeburn 3014: ' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3015: }
1.605 bisitz 3016: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.1075.2.117 raeburn 3017: $intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3018: $result = &mt
1.144 matthew 3019: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 3020: '<label>'.$authtype,'</label>'.$autharg);
1.1075.2.118 raeburn 3021: $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 3022: return $result;
3023: }
3024:
1.1075.2.20 raeburn 3025: sub authform_local {
1.32 matthew 3026: my %in = (
3027: formname => 'document.cu',
3028: kerb_def_dom => 'MSU.EDU',
3029: @_,
3030: );
1.1075.2.117 raeburn 3031: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3032: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3033: if ($in{'readonly'}) {
3034: $disabled = ' disabled="disabled"';
3035: }
1.591 raeburn 3036: if (defined($in{'curr_authtype'})) {
3037: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 3038: if ($can_assign{'loc'}) {
1.772 bisitz 3039: $loccheck = 'checked="checked" ';
1.623 raeburn 3040: if (defined($in{'mode'})) {
3041: if ($in{'mode'} eq 'modifyuser') {
3042: $loccheck = '';
3043: }
3044: }
1.591 raeburn 3045: if (defined($in{'curr_autharg'})) {
1.586 raeburn 3046: $locarg = $in{'curr_autharg'};
3047: }
3048: } else {
3049: $result = &mt('Currently using local (institutional) authentication.');
3050: return $result;
1.165 raeburn 3051: }
3052: }
1.586 raeburn 3053: } else {
3054: if ($authnum == 1) {
1.784 bisitz 3055: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 3056: }
3057: }
3058: if (!$can_assign{'loc'}) {
3059: return;
1.587 raeburn 3060: } elsif ($authtype eq '') {
1.591 raeburn 3061: if (defined($in{'mode'})) {
1.587 raeburn 3062: if ($in{'mode'} eq 'modifycourse') {
3063: if ($authnum == 1) {
1.1075.2.117 raeburn 3064: $authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
1.587 raeburn 3065: }
3066: }
3067: }
1.165 raeburn 3068: }
1.586 raeburn 3069: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
3070: if ($authtype eq '') {
3071: $authtype = '<input type="radio" name="login" value="loc" '.
3072: $loccheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117 raeburn 3073: $jscall.'"'.$disabled.' />';
1.586 raeburn 3074: }
3075: $autharg = '<input type="text" size="10" name="locarg" value="'.
1.1075.2.117 raeburn 3076: $locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3077: $result = &mt('[_1] Local Authentication with argument [_2]',
3078: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3079: return $result;
3080: }
3081:
1.1075.2.20 raeburn 3082: sub authform_filesystem {
1.32 matthew 3083: my %in = (
3084: formname => 'document.cu',
3085: kerb_def_dom => 'MSU.EDU',
3086: @_,
3087: );
1.1075.2.117 raeburn 3088: my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
1.1075.2.20 raeburn 3089: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.1075.2.117 raeburn 3090: if ($in{'readonly'}) {
3091: $disabled = ' disabled="disabled"';
3092: }
1.591 raeburn 3093: if (defined($in{'curr_authtype'})) {
3094: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 3095: if ($can_assign{'fsys'}) {
1.772 bisitz 3096: $fsyscheck = 'checked="checked" ';
1.623 raeburn 3097: if (defined($in{'mode'})) {
3098: if ($in{'mode'} eq 'modifyuser') {
3099: $fsyscheck = '';
3100: }
3101: }
1.586 raeburn 3102: } else {
3103: $result = &mt('Currently Filesystem Authenticated.');
3104: return $result;
3105: }
3106: }
3107: } else {
3108: if ($authnum == 1) {
1.784 bisitz 3109: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 3110: }
3111: }
3112: if (!$can_assign{'fsys'}) {
3113: return;
1.587 raeburn 3114: } elsif ($authtype eq '') {
1.591 raeburn 3115: if (defined($in{'mode'})) {
1.587 raeburn 3116: if ($in{'mode'} eq 'modifycourse') {
3117: if ($authnum == 1) {
1.1075.2.117 raeburn 3118: $authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
1.587 raeburn 3119: }
3120: }
3121: }
1.586 raeburn 3122: }
3123: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
3124: if ($authtype eq '') {
3125: $authtype = '<input type="radio" name="login" value="fsys" '.
3126: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
1.1075.2.117 raeburn 3127: $jscall.'"'.$disabled.' />';
1.586 raeburn 3128: }
1.1075.2.158 raeburn 3129: $autharg = '<input type="password" size="10" name="fsysarg" value=""'.
1.1075.2.117 raeburn 3130: ' onchange="'.$jscall.'"'.$disabled.' />';
1.586 raeburn 3131: $result = &mt
1.144 matthew 3132: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.1075.2.158 raeburn 3133: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 3134: return $result;
3135: }
3136:
1.586 raeburn 3137: sub get_assignable_auth {
3138: my ($dom) = @_;
3139: if ($dom eq '') {
3140: $dom = $env{'request.role.domain'};
3141: }
3142: my %can_assign = (
3143: krb4 => 1,
3144: krb5 => 1,
3145: int => 1,
3146: loc => 1,
3147: );
3148: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
3149: if (ref($domconfig{'usercreation'}) eq 'HASH') {
3150: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
3151: my $authhash = $domconfig{'usercreation'}{'authtypes'};
3152: my $context;
3153: if ($env{'request.role'} =~ /^au/) {
3154: $context = 'author';
1.1075.2.117 raeburn 3155: } elsif ($env{'request.role'} =~ /^(dc|dh)/) {
1.586 raeburn 3156: $context = 'domain';
3157: } elsif ($env{'request.course.id'}) {
3158: $context = 'course';
3159: }
3160: if ($context) {
3161: if (ref($authhash->{$context}) eq 'HASH') {
3162: %can_assign = %{$authhash->{$context}};
3163: }
3164: }
3165: }
3166: }
3167: my $authnum = 0;
3168: foreach my $key (keys(%can_assign)) {
3169: if ($can_assign{$key}) {
3170: $authnum ++;
3171: }
3172: }
3173: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
3174: $authnum --;
3175: }
3176: return ($authnum,%can_assign);
3177: }
3178:
1.1075.2.137 raeburn 3179: sub check_passwd_rules {
3180: my ($domain,$plainpass) = @_;
3181: my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
3182: my ($min,$max,@chars,@brokerule,$warning);
1.1075.2.138 raeburn 3183: $min = $Apache::lonnet::passwdmin;
1.1075.2.137 raeburn 3184: if (ref($passwdconf{'chars'}) eq 'ARRAY') {
3185: if ($passwdconf{'min'} =~ /^\d+$/) {
1.1075.2.138 raeburn 3186: if ($passwdconf{'min'} > $min) {
3187: $min = $passwdconf{'min'};
3188: }
1.1075.2.137 raeburn 3189: }
3190: if ($passwdconf{'max'} =~ /^\d+$/) {
3191: $max = $passwdconf{'max'};
3192: }
3193: @chars = @{$passwdconf{'chars'}};
3194: }
3195: if (($min) && (length($plainpass) < $min)) {
3196: push(@brokerule,'min');
3197: }
3198: if (($max) && (length($plainpass) > $max)) {
3199: push(@brokerule,'max');
3200: }
3201: if (@chars) {
3202: my %rules;
3203: map { $rules{$_} = 1; } @chars;
3204: if ($rules{'uc'}) {
3205: unless ($plainpass =~ /[A-Z]/) {
3206: push(@brokerule,'uc');
3207: }
3208: }
3209: if ($rules{'lc'}) {
3210: unless ($plainpass =~ /[a-z]/) {
3211: push(@brokerule,'lc');
3212: }
3213: }
3214: if ($rules{'num'}) {
3215: unless ($plainpass =~ /\d/) {
3216: push(@brokerule,'num');
3217: }
3218: }
3219: if ($rules{'spec'}) {
3220: unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) {
3221: push(@brokerule,'spec');
3222: }
3223: }
3224: }
3225: if (@brokerule) {
3226: my %rulenames = &Apache::lonlocal::texthash(
3227: uc => 'At least one upper case letter',
3228: lc => 'At least one lower case letter',
3229: num => 'At least one number',
3230: spec => 'At least one non-alphanumeric',
3231: );
3232: $rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
3233: $rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
3234: $rulenames{'num'} .= ': 0123456789';
3235: $rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~';
3236: $rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
3237: $rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
3238: $warning = &mt('Password did not satisfy the following:').'<ul>';
1.1075.2.143 raeburn 3239: foreach my $rule ('min','max','uc','lc','num','spec') {
1.1075.2.137 raeburn 3240: if (grep(/^$rule$/,@brokerule)) {
3241: $warning .= '<li>'.$rulenames{$rule}.'</li>';
3242: }
3243: }
3244: $warning .= '</ul>';
3245: }
3246: if (wantarray) {
3247: return @brokerule;
3248: }
3249: return $warning;
3250: }
3251:
1.80 albertel 3252: ###############################################################
3253: ## Get Kerberos Defaults for Domain ##
3254: ###############################################################
3255: ##
3256: ## Returns default kerberos version and an associated argument
3257: ## as listed in file domain.tab. If not listed, provides
3258: ## appropriate default domain and kerberos version.
3259: ##
3260: #-------------------------------------------
3261:
3262: =pod
3263:
1.648 raeburn 3264: =item * &get_kerberos_defaults()
1.80 albertel 3265:
3266: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 3267: version and domain. If not found, it defaults to version 4 and the
3268: domain of the server.
1.80 albertel 3269:
1.648 raeburn 3270: =over 4
3271:
1.80 albertel 3272: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
3273:
1.648 raeburn 3274: =back
3275:
3276: =back
3277:
1.80 albertel 3278: =cut
3279:
3280: #-------------------------------------------
3281: sub get_kerberos_defaults {
3282: my $domain=shift;
1.641 raeburn 3283: my ($krbdef,$krbdefdom);
3284: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
3285: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
3286: $krbdef = $domdefaults{'auth_def'};
3287: $krbdefdom = $domdefaults{'auth_arg_def'};
3288: } else {
1.80 albertel 3289: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
3290: my $krbdefdom=$1;
3291: $krbdefdom=~tr/a-z/A-Z/;
3292: $krbdef = "krb4";
3293: }
3294: return ($krbdef,$krbdefdom);
3295: }
1.112 bowersj2 3296:
1.32 matthew 3297:
1.46 matthew 3298: ###############################################################
3299: ## Thesaurus Functions ##
3300: ###############################################################
1.20 www 3301:
1.46 matthew 3302: =pod
1.20 www 3303:
1.112 bowersj2 3304: =head1 Thesaurus Functions
3305:
3306: =over 4
3307:
1.648 raeburn 3308: =item * &initialize_keywords()
1.46 matthew 3309:
3310: Initializes the package variable %Keywords if it is empty. Uses the
3311: package variable $thesaurus_db_file.
3312:
3313: =cut
3314:
3315: ###################################################
3316:
3317: sub initialize_keywords {
3318: return 1 if (scalar keys(%Keywords));
3319: # If we are here, %Keywords is empty, so fill it up
3320: # Make sure the file we need exists...
3321: if (! -e $thesaurus_db_file) {
3322: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
3323: " failed because it does not exist");
3324: return 0;
3325: }
3326: # Set up the hash as a database
3327: my %thesaurus_db;
3328: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3329: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3330: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3331: $thesaurus_db_file);
3332: return 0;
3333: }
3334: # Get the average number of appearances of a word.
3335: my $avecount = $thesaurus_db{'average.count'};
3336: # Put keywords (those that appear > average) into %Keywords
3337: while (my ($word,$data)=each (%thesaurus_db)) {
3338: my ($count,undef) = split /:/,$data;
3339: $Keywords{$word}++ if ($count > $avecount);
3340: }
3341: untie %thesaurus_db;
3342: # Remove special values from %Keywords.
1.356 albertel 3343: foreach my $value ('total.count','average.count') {
3344: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3345: }
1.46 matthew 3346: return 1;
3347: }
3348:
3349: ###################################################
3350:
3351: =pod
3352:
1.648 raeburn 3353: =item * &keyword($word)
1.46 matthew 3354:
3355: Returns true if $word is a keyword. A keyword is a word that appears more
3356: than the average number of times in the thesaurus database. Calls
3357: &initialize_keywords
3358:
3359: =cut
3360:
3361: ###################################################
1.20 www 3362:
3363: sub keyword {
1.46 matthew 3364: return if (!&initialize_keywords());
3365: my $word=lc(shift());
3366: $word=~s/\W//g;
3367: return exists($Keywords{$word});
1.20 www 3368: }
1.46 matthew 3369:
3370: ###############################################################
3371:
3372: =pod
1.20 www 3373:
1.648 raeburn 3374: =item * &get_related_words()
1.46 matthew 3375:
1.160 matthew 3376: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3377: an array of words. If the keyword is not in the thesaurus, an empty array
3378: will be returned. The order of the words returned is determined by the
3379: database which holds them.
3380:
3381: Uses global $thesaurus_db_file.
3382:
1.1057 foxr 3383:
1.46 matthew 3384: =cut
3385:
3386: ###############################################################
3387: sub get_related_words {
3388: my $keyword = shift;
3389: my %thesaurus_db;
3390: if (! -e $thesaurus_db_file) {
3391: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3392: "failed because the file does not exist");
3393: return ();
3394: }
3395: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3396: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3397: return ();
3398: }
3399: my @Words=();
1.429 www 3400: my $count=0;
1.46 matthew 3401: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3402: # The first element is the number of times
3403: # the word appears. We do not need it now.
1.429 www 3404: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3405: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3406: my $threshold=$mostfrequentcount/10;
3407: foreach my $possibleword (@RelatedWords) {
3408: my ($word,$wordcount)=split(/\,/,$possibleword);
3409: if ($wordcount>$threshold) {
3410: push(@Words,$word);
3411: $count++;
3412: if ($count>10) { last; }
3413: }
1.20 www 3414: }
3415: }
1.46 matthew 3416: untie %thesaurus_db;
3417: return @Words;
1.14 harris41 3418: }
1.46 matthew 3419:
1.112 bowersj2 3420: =pod
3421:
3422: =back
3423:
3424: =cut
1.61 www 3425:
3426: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3427: =pod
3428:
1.112 bowersj2 3429: =head1 User Name Functions
3430:
3431: =over 4
3432:
1.648 raeburn 3433: =item * &plainname($uname,$udom,$first)
1.81 albertel 3434:
1.112 bowersj2 3435: Takes a users logon name and returns it as a string in
1.226 albertel 3436: "first middle last generation" form
3437: if $first is set to 'lastname' then it returns it as
3438: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3439:
3440: =cut
1.61 www 3441:
1.295 www 3442:
1.81 albertel 3443: ###############################################################
1.61 www 3444: sub plainname {
1.226 albertel 3445: my ($uname,$udom,$first)=@_;
1.537 albertel 3446: return if (!defined($uname) || !defined($udom));
1.295 www 3447: my %names=&getnames($uname,$udom);
1.226 albertel 3448: my $name=&Apache::lonnet::format_name($names{'firstname'},
3449: $names{'middlename'},
3450: $names{'lastname'},
3451: $names{'generation'},$first);
3452: $name=~s/^\s+//;
1.62 www 3453: $name=~s/\s+$//;
3454: $name=~s/\s+/ /g;
1.353 albertel 3455: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3456: return $name;
1.61 www 3457: }
1.66 www 3458:
3459: # -------------------------------------------------------------------- Nickname
1.81 albertel 3460: =pod
3461:
1.648 raeburn 3462: =item * &nickname($uname,$udom)
1.81 albertel 3463:
3464: Gets a users name and returns it as a string as
3465:
3466: ""nickname""
1.66 www 3467:
1.81 albertel 3468: if the user has a nickname or
3469:
3470: "first middle last generation"
3471:
3472: if the user does not
3473:
3474: =cut
1.66 www 3475:
3476: sub nickname {
3477: my ($uname,$udom)=@_;
1.537 albertel 3478: return if (!defined($uname) || !defined($udom));
1.295 www 3479: my %names=&getnames($uname,$udom);
1.68 albertel 3480: my $name=$names{'nickname'};
1.66 www 3481: if ($name) {
3482: $name='"'.$name.'"';
3483: } else {
3484: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3485: $names{'lastname'}.' '.$names{'generation'};
3486: $name=~s/\s+$//;
3487: $name=~s/\s+/ /g;
3488: }
3489: return $name;
3490: }
3491:
1.295 www 3492: sub getnames {
3493: my ($uname,$udom)=@_;
1.537 albertel 3494: return if (!defined($uname) || !defined($udom));
1.433 albertel 3495: if ($udom eq 'public' && $uname eq 'public') {
3496: return ('lastname' => &mt('Public'));
3497: }
1.295 www 3498: my $id=$uname.':'.$udom;
3499: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3500: if ($cached) {
3501: return %{$names};
3502: } else {
3503: my %loadnames=&Apache::lonnet::get('environment',
3504: ['firstname','middlename','lastname','generation','nickname'],
3505: $udom,$uname);
3506: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3507: return %loadnames;
3508: }
3509: }
1.61 www 3510:
1.542 raeburn 3511: # -------------------------------------------------------------------- getemails
1.648 raeburn 3512:
1.542 raeburn 3513: =pod
3514:
1.648 raeburn 3515: =item * &getemails($uname,$udom)
1.542 raeburn 3516:
3517: Gets a user's email information and returns it as a hash with keys:
3518: notification, critnotification, permanentemail
3519:
3520: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3521: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3522:
1.648 raeburn 3523:
1.542 raeburn 3524: =cut
3525:
1.648 raeburn 3526:
1.466 albertel 3527: sub getemails {
3528: my ($uname,$udom)=@_;
3529: if ($udom eq 'public' && $uname eq 'public') {
3530: return;
3531: }
1.467 www 3532: if (!$udom) { $udom=$env{'user.domain'}; }
3533: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3534: my $id=$uname.':'.$udom;
3535: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3536: if ($cached) {
3537: return %{$names};
3538: } else {
3539: my %loadnames=&Apache::lonnet::get('environment',
3540: ['notification','critnotification',
3541: 'permanentemail'],
3542: $udom,$uname);
3543: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3544: return %loadnames;
3545: }
3546: }
3547:
1.551 albertel 3548: sub flush_email_cache {
3549: my ($uname,$udom)=@_;
3550: if (!$udom) { $udom =$env{'user.domain'}; }
3551: if (!$uname) { $uname=$env{'user.name'}; }
3552: return if ($udom eq 'public' && $uname eq 'public');
3553: my $id=$uname.':'.$udom;
3554: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3555: }
3556:
1.728 raeburn 3557: # -------------------------------------------------------------------- getlangs
3558:
3559: =pod
3560:
3561: =item * &getlangs($uname,$udom)
3562:
3563: Gets a user's language preference and returns it as a hash with key:
3564: language.
3565:
3566: =cut
3567:
3568:
3569: sub getlangs {
3570: my ($uname,$udom) = @_;
3571: if (!$udom) { $udom =$env{'user.domain'}; }
3572: if (!$uname) { $uname=$env{'user.name'}; }
3573: my $id=$uname.':'.$udom;
3574: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3575: if ($cached) {
3576: return %{$langs};
3577: } else {
3578: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3579: $udom,$uname);
3580: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3581: return %loadlangs;
3582: }
3583: }
3584:
3585: sub flush_langs_cache {
3586: my ($uname,$udom)=@_;
3587: if (!$udom) { $udom =$env{'user.domain'}; }
3588: if (!$uname) { $uname=$env{'user.name'}; }
3589: return if ($udom eq 'public' && $uname eq 'public');
3590: my $id=$uname.':'.$udom;
3591: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3592: }
3593:
1.61 www 3594: # ------------------------------------------------------------------ Screenname
1.81 albertel 3595:
3596: =pod
3597:
1.648 raeburn 3598: =item * &screenname($uname,$udom)
1.81 albertel 3599:
3600: Gets a users screenname and returns it as a string
3601:
3602: =cut
1.61 www 3603:
3604: sub screenname {
3605: my ($uname,$udom)=@_;
1.258 albertel 3606: if ($uname eq $env{'user.name'} &&
3607: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3608: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3609: return $names{'screenname'};
1.62 www 3610: }
3611:
1.212 albertel 3612:
1.802 bisitz 3613: # ------------------------------------------------------------- Confirm Wrapper
3614: =pod
3615:
1.1075.2.42 raeburn 3616: =item * &confirmwrapper($message)
1.802 bisitz 3617:
3618: Wrap messages about completion of operation in box
3619:
3620: =cut
3621:
3622: sub confirmwrapper {
3623: my ($message)=@_;
3624: if ($message) {
3625: return "\n".'<div class="LC_confirm_box">'."\n"
3626: .$message."\n"
3627: .'</div>'."\n";
3628: } else {
3629: return $message;
3630: }
3631: }
3632:
1.62 www 3633: # ------------------------------------------------------------- Message Wrapper
3634:
3635: sub messagewrapper {
1.369 www 3636: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3637: return
1.441 albertel 3638: '<a href="/adm/email?compose=individual&'.
3639: 'recname='.$username.'&recdom='.$domain.
3640: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3641: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3642: }
1.802 bisitz 3643:
1.74 www 3644: # --------------------------------------------------------------- Notes Wrapper
3645:
3646: sub noteswrapper {
3647: my ($link,$un,$do)=@_;
3648: return
1.896 amueller 3649: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3650: }
1.802 bisitz 3651:
1.62 www 3652: # ------------------------------------------------------------- Aboutme Wrapper
3653:
3654: sub aboutmewrapper {
1.1070 raeburn 3655: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3656: if (!defined($username) && !defined($domain)) {
3657: return;
3658: }
1.1075.2.15 raeburn 3659: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3660: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3661: }
3662:
3663: # ------------------------------------------------------------ Syllabus Wrapper
3664:
3665: sub syllabuswrapper {
1.707 bisitz 3666: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3667: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3668: }
1.14 harris41 3669:
1.802 bisitz 3670: # -----------------------------------------------------------------------------
3671:
1.1075.2.167 raeburn 3672: sub aboutme_on {
3673: my ($uname,$udom)=@_;
3674: unless ($uname) { $uname=$env{'user.name'}; }
3675: unless ($udom) { $udom=$env{'user.domain'}; }
3676: return if ($udom eq 'public' && $uname eq 'public');
3677: my $hashkey=$uname.':'.$udom;
3678: my ($aboutme,$cached)=&Apache::lonnet::is_cached_new('aboutme',$hashkey);
3679: if ($cached) {
3680: return $aboutme;
3681: }
3682: $aboutme = &Apache::lonnet::usertools_access($uname,$udom,'aboutme');
3683: &Apache::lonnet::do_cache_new('aboutme',$hashkey,$aboutme,3600);
3684: return $aboutme;
3685: }
3686:
3687: sub devalidate_aboutme_cache {
3688: my ($uname,$udom)=@_;
3689: if (!$udom) { $udom =$env{'user.domain'}; }
3690: if (!$uname) { $uname=$env{'user.name'}; }
3691: return if ($udom eq 'public' && $uname eq 'public');
3692: my $id=$uname.':'.$udom;
3693: &Apache::lonnet::devalidate_cache_new('aboutme',$id);
3694: }
3695:
1.208 matthew 3696: sub track_student_link {
1.887 raeburn 3697: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3698: my $link ="/adm/trackstudent?";
1.208 matthew 3699: my $title = 'View recent activity';
3700: if (defined($sname) && $sname !~ /^\s*$/ &&
3701: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3702: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3703: $title .= ' of this student';
1.268 albertel 3704: }
1.208 matthew 3705: if (defined($target) && $target !~ /^\s*$/) {
3706: $target = qq{target="$target"};
3707: } else {
3708: $target = '';
3709: }
1.268 albertel 3710: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3711: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3712: $title = &mt($title);
3713: $linktext = &mt($linktext);
1.448 albertel 3714: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3715: &help_open_topic('View_recent_activity');
1.208 matthew 3716: }
3717:
1.781 raeburn 3718: sub slot_reservations_link {
3719: my ($linktext,$sname,$sdom,$target) = @_;
3720: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3721: my $title = 'View slot reservation history';
3722: if (defined($sname) && $sname !~ /^\s*$/ &&
3723: defined($sdom) && $sdom !~ /^\s*$/) {
3724: $link .= "&uname=$sname&udom=$sdom";
3725: $title .= ' of this student';
3726: }
3727: if (defined($target) && $target !~ /^\s*$/) {
3728: $target = qq{target="$target"};
3729: } else {
3730: $target = '';
3731: }
3732: $title = &mt($title);
3733: $linktext = &mt($linktext);
3734: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3735: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3736:
3737: }
3738:
1.508 www 3739: # ===================================================== Display a student photo
3740:
3741:
1.509 albertel 3742: sub student_image_tag {
1.508 www 3743: my ($domain,$user)=@_;
3744: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3745: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3746: return '<img src="'.$imgsrc.'" align="right" />';
3747: } else {
3748: return '';
3749: }
3750: }
3751:
1.112 bowersj2 3752: =pod
3753:
3754: =back
3755:
3756: =head1 Access .tab File Data
3757:
3758: =over 4
3759:
1.648 raeburn 3760: =item * &languageids()
1.112 bowersj2 3761:
3762: returns list of all language ids
3763:
3764: =cut
3765:
1.14 harris41 3766: sub languageids {
1.16 harris41 3767: return sort(keys(%language));
1.14 harris41 3768: }
3769:
1.112 bowersj2 3770: =pod
3771:
1.648 raeburn 3772: =item * &languagedescription()
1.112 bowersj2 3773:
3774: returns description of a specified language id
3775:
3776: =cut
3777:
1.14 harris41 3778: sub languagedescription {
1.125 www 3779: my $code=shift;
3780: return ($supported_language{$code}?'* ':'').
3781: $language{$code}.
1.126 www 3782: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3783: }
3784:
1.1048 foxr 3785: =pod
3786:
3787: =item * &plainlanguagedescription
3788:
3789: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3790: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3791:
3792: =cut
3793:
1.145 www 3794: sub plainlanguagedescription {
3795: my $code=shift;
3796: return $language{$code};
3797: }
3798:
1.1048 foxr 3799: =pod
3800:
3801: =item * &supportedlanguagecode
3802:
3803: Returns the supported language code (e.g. sptutf maps to pt) given a language
3804: code.
3805:
3806: =cut
3807:
1.145 www 3808: sub supportedlanguagecode {
3809: my $code=shift;
3810: return $supported_language{$code};
1.97 www 3811: }
3812:
1.112 bowersj2 3813: =pod
3814:
1.1048 foxr 3815: =item * &latexlanguage()
3816:
3817: Given a language key code returns the correspondnig language to use
3818: to select the correct hyphenation on LaTeX printouts. This is undef if there
3819: is no supported hyphenation for the language code.
3820:
3821: =cut
3822:
3823: sub latexlanguage {
3824: my $code = shift;
3825: return $latex_language{$code};
3826: }
3827:
3828: =pod
3829:
3830: =item * &latexhyphenation()
3831:
3832: Same as above but what's supplied is the language as it might be stored
3833: in the metadata.
3834:
3835: =cut
3836:
3837: sub latexhyphenation {
3838: my $key = shift;
3839: return $latex_language_bykey{$key};
3840: }
3841:
3842: =pod
3843:
1.648 raeburn 3844: =item * ©rightids()
1.112 bowersj2 3845:
3846: returns list of all copyrights
3847:
3848: =cut
3849:
3850: sub copyrightids {
3851: return sort(keys(%cprtag));
3852: }
3853:
3854: =pod
3855:
1.648 raeburn 3856: =item * ©rightdescription()
1.112 bowersj2 3857:
3858: returns description of a specified copyright id
3859:
3860: =cut
3861:
3862: sub copyrightdescription {
1.166 www 3863: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3864: }
1.197 matthew 3865:
3866: =pod
3867:
1.648 raeburn 3868: =item * &source_copyrightids()
1.192 taceyjo1 3869:
3870: returns list of all source copyrights
3871:
3872: =cut
3873:
3874: sub source_copyrightids {
3875: return sort(keys(%scprtag));
3876: }
3877:
3878: =pod
3879:
1.648 raeburn 3880: =item * &source_copyrightdescription()
1.192 taceyjo1 3881:
3882: returns description of a specified source copyright id
3883:
3884: =cut
3885:
3886: sub source_copyrightdescription {
3887: return &mt($scprtag{shift(@_)});
3888: }
1.112 bowersj2 3889:
3890: =pod
3891:
1.648 raeburn 3892: =item * &filecategories()
1.112 bowersj2 3893:
3894: returns list of all file categories
3895:
3896: =cut
3897:
3898: sub filecategories {
3899: return sort(keys(%category_extensions));
3900: }
3901:
3902: =pod
3903:
1.648 raeburn 3904: =item * &filecategorytypes()
1.112 bowersj2 3905:
3906: returns list of file types belonging to a given file
3907: category
3908:
3909: =cut
3910:
3911: sub filecategorytypes {
1.356 albertel 3912: my ($cat) = @_;
3913: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3914: }
3915:
3916: =pod
3917:
1.648 raeburn 3918: =item * &fileembstyle()
1.112 bowersj2 3919:
3920: returns embedding style for a specified file type
3921:
3922: =cut
3923:
3924: sub fileembstyle {
3925: return $fe{lc(shift(@_))};
1.169 www 3926: }
3927:
1.351 www 3928: sub filemimetype {
3929: return $fm{lc(shift(@_))};
3930: }
3931:
1.169 www 3932:
3933: sub filecategoryselect {
3934: my ($name,$value)=@_;
1.189 matthew 3935: return &select_form($value,$name,
1.970 raeburn 3936: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3937: }
3938:
3939: =pod
3940:
1.648 raeburn 3941: =item * &filedescription()
1.112 bowersj2 3942:
3943: returns description for a specified file type
3944:
3945: =cut
3946:
3947: sub filedescription {
1.188 matthew 3948: my $file_description = $fd{lc(shift())};
3949: $file_description =~ s:([\[\]]):~$1:g;
3950: return &mt($file_description);
1.112 bowersj2 3951: }
3952:
3953: =pod
3954:
1.648 raeburn 3955: =item * &filedescriptionex()
1.112 bowersj2 3956:
3957: returns description for a specified file type with
3958: extra formatting
3959:
3960: =cut
3961:
3962: sub filedescriptionex {
3963: my $ex=shift;
1.188 matthew 3964: my $file_description = $fd{lc($ex)};
3965: $file_description =~ s:([\[\]]):~$1:g;
3966: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3967: }
3968:
3969: # End of .tab access
3970: =pod
3971:
3972: =back
3973:
3974: =cut
3975:
3976: # ------------------------------------------------------------------ File Types
3977: sub fileextensions {
3978: return sort(keys(%fe));
3979: }
3980:
1.97 www 3981: # ----------------------------------------------------------- Display Languages
3982: # returns a hash with all desired display languages
3983: #
3984:
3985: sub display_languages {
3986: my %languages=();
1.695 raeburn 3987: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3988: $languages{$lang}=1;
1.97 www 3989: }
3990: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3991: if ($env{'form.displaylanguage'}) {
1.356 albertel 3992: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3993: $languages{$lang}=1;
1.97 www 3994: }
3995: }
3996: return %languages;
1.14 harris41 3997: }
3998:
1.582 albertel 3999: sub languages {
4000: my ($possible_langs) = @_;
1.695 raeburn 4001: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 4002: if (!ref($possible_langs)) {
4003: if( wantarray ) {
4004: return @preferred_langs;
4005: } else {
4006: return $preferred_langs[0];
4007: }
4008: }
4009: my %possibilities = map { $_ => 1 } (@$possible_langs);
4010: my @preferred_possibilities;
4011: foreach my $preferred_lang (@preferred_langs) {
4012: if (exists($possibilities{$preferred_lang})) {
4013: push(@preferred_possibilities, $preferred_lang);
4014: }
4015: }
4016: if( wantarray ) {
4017: return @preferred_possibilities;
4018: }
4019: return $preferred_possibilities[0];
4020: }
4021:
1.742 raeburn 4022: sub user_lang {
4023: my ($touname,$toudom,$fromcid) = @_;
4024: my @userlangs;
4025: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
4026: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
4027: $env{'course.'.$fromcid.'.languages'}));
4028: } else {
4029: my %langhash = &getlangs($touname,$toudom);
4030: if ($langhash{'languages'} ne '') {
4031: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
4032: } else {
4033: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
4034: if ($domdefs{'lang_def'} ne '') {
4035: @userlangs = ($domdefs{'lang_def'});
4036: }
4037: }
4038: }
4039: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
4040: my $user_lh = Apache::localize->get_handle(@languages);
4041: return $user_lh;
4042: }
4043:
4044:
1.112 bowersj2 4045: ###############################################################
4046: ## Student Answer Attempts ##
4047: ###############################################################
4048:
4049: =pod
4050:
4051: =head1 Alternate Problem Views
4052:
4053: =over 4
4054:
1.648 raeburn 4055: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86 raeburn 4056: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 4057:
4058: Return string with previous attempt on problem. Arguments:
4059:
4060: =over 4
4061:
4062: =item * $symb: Problem, including path
4063:
4064: =item * $username: username of the desired student
4065:
4066: =item * $domain: domain of the desired student
1.14 harris41 4067:
1.112 bowersj2 4068: =item * $course: Course ID
1.14 harris41 4069:
1.112 bowersj2 4070: =item * $getattempt: Leave blank for all attempts, otherwise put
4071: something
1.14 harris41 4072:
1.112 bowersj2 4073: =item * $regexp: if string matches this regexp, the string will be
4074: sent to $gradesub
1.14 harris41 4075:
1.112 bowersj2 4076: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 4077:
1.1075.2.86 raeburn 4078: =item * $usec: section of the desired student
4079:
4080: =item * $identifier: counter for student (multiple students one problem) or
4081: problem (one student; whole sequence).
4082:
1.112 bowersj2 4083: =back
1.14 harris41 4084:
1.112 bowersj2 4085: The output string is a table containing all desired attempts, if any.
1.16 harris41 4086:
1.112 bowersj2 4087: =cut
1.1 albertel 4088:
4089: sub get_previous_attempt {
1.1075.2.86 raeburn 4090: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 4091: my $prevattempts='';
1.43 ng 4092: no strict 'refs';
1.1 albertel 4093: if ($symb) {
1.3 albertel 4094: my (%returnhash)=
4095: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 4096: if ($returnhash{'version'}) {
4097: my %lasthash=();
4098: my $version;
4099: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91 raeburn 4100: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
4101: if ($key =~ /\.rawrndseed$/) {
4102: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
4103: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
4104: } else {
4105: $lasthash{$key}=$returnhash{$version.':'.$key};
4106: }
1.19 harris41 4107: }
1.1 albertel 4108: }
1.596 albertel 4109: $prevattempts=&start_data_table().&start_data_table_header_row();
4110: $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86 raeburn 4111: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 4112: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 4113: foreach my $key (sort(keys(%lasthash))) {
4114: my ($ign,@parts) = split(/\./,$key);
1.41 ng 4115: if ($#parts > 0) {
1.31 albertel 4116: my $data=$parts[-1];
1.989 raeburn 4117: next if ($data eq 'foilorder');
1.31 albertel 4118: pop(@parts);
1.1010 www 4119: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 4120: if ($data eq 'type') {
4121: unless ($showsurv) {
4122: my $id = join(',',@parts);
4123: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 4124: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
4125: $lasthidden{$ign.'.'.$id} = 1;
4126: }
1.945 raeburn 4127: }
1.1075.2.86 raeburn 4128: if ($identifier ne '') {
4129: my $id = join(',',@parts);
4130: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
4131: $domain,$username,$usec,undef,$course) =~ /^no/) {
4132: $hidestatus{$ign.'.'.$id} = 1;
4133: }
4134: }
4135: } elsif ($data eq 'regrader') {
4136: if (($identifier ne '') && (@parts)) {
4137: my $id = join(',',@parts);
4138: $regraded{$ign.'.'.$id} = 1;
4139: }
1.1010 www 4140: }
1.31 albertel 4141: } else {
1.41 ng 4142: if ($#parts == 0) {
4143: $prevattempts.='<th>'.$parts[0].'</th>';
4144: } else {
4145: $prevattempts.='<th>'.$ign.'</th>';
4146: }
1.31 albertel 4147: }
1.16 harris41 4148: }
1.596 albertel 4149: $prevattempts.=&end_data_table_header_row();
1.40 ng 4150: if ($getattempt eq '') {
1.1075.2.86 raeburn 4151: my (%solved,%resets,%probstatus);
4152: if (($identifier ne '') && (keys(%regraded) > 0)) {
4153: for ($version=1;$version<=$returnhash{'version'};$version++) {
4154: foreach my $id (keys(%regraded)) {
4155: if (($returnhash{$version.':'.$id.'.regrader'}) &&
4156: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
4157: ($returnhash{$version.':'.$id.'.award'} eq '')) {
4158: push(@{$resets{$id}},$version);
4159: }
4160: }
4161: }
4162: }
1.40 ng 4163: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86 raeburn 4164: my (@hidden,@unsolved);
1.945 raeburn 4165: if (%typeparts) {
4166: foreach my $id (keys(%typeparts)) {
1.1075.2.86 raeburn 4167: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
4168: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 4169: push(@hidden,$id);
1.1075.2.86 raeburn 4170: } elsif ($identifier ne '') {
4171: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
4172: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
4173: ($hidestatus{$id})) {
4174: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
4175: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
4176: push(@{$solved{$id}},$version);
4177: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
4178: (ref($solved{$id}) eq 'ARRAY')) {
4179: my $skip;
4180: if (ref($resets{$id}) eq 'ARRAY') {
4181: foreach my $reset (@{$resets{$id}}) {
4182: if ($reset > $solved{$id}[-1]) {
4183: $skip=1;
4184: last;
4185: }
4186: }
4187: }
4188: unless ($skip) {
4189: my ($ign,$partslist) = split(/\./,$id,2);
4190: push(@unsolved,$partslist);
4191: }
4192: }
4193: }
1.945 raeburn 4194: }
4195: }
4196: }
4197: $prevattempts.=&start_data_table_row().
1.1075.2.86 raeburn 4198: '<td>'.&mt('Transaction [_1]',$version);
4199: if (@unsolved) {
4200: $prevattempts .= '<span class="LC_nobreak"><label>'.
4201: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
4202: &mt('Hide').'</label></span>';
4203: }
4204: $prevattempts .= '</td>';
1.945 raeburn 4205: if (@hidden) {
4206: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4207: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4208: my $hide;
4209: foreach my $id (@hidden) {
4210: if ($key =~ /^\Q$id\E/) {
4211: $hide = 1;
4212: last;
4213: }
4214: }
4215: if ($hide) {
4216: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4217: if (($data eq 'award') || ($data eq 'awarddetail')) {
4218: my $value = &format_previous_attempt_value($key,
4219: $returnhash{$version.':'.$key});
4220: $prevattempts.='<td>'.$value.' </td>';
4221: } else {
4222: $prevattempts.='<td> </td>';
4223: }
4224: } else {
4225: if ($key =~ /\./) {
1.1075.2.91 raeburn 4226: my $value = $returnhash{$version.':'.$key};
4227: if ($key =~ /\.rndseed$/) {
4228: my ($id) = ($key =~ /^(.+)\.rndseed$/);
4229: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4230: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4231: }
4232: }
4233: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4234: ' </td>';
1.945 raeburn 4235: } else {
4236: $prevattempts.='<td> </td>';
4237: }
4238: }
4239: }
4240: } else {
4241: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4242: next if ($key =~ /\.foilorder$/);
1.1075.2.91 raeburn 4243: my $value = $returnhash{$version.':'.$key};
4244: if ($key =~ /\.rndseed$/) {
4245: my ($id) = ($key =~ /^(.+)\.rndseed$/);
4246: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
4247: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
4248: }
4249: }
4250: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
4251: ' </td>';
1.945 raeburn 4252: }
4253: }
4254: $prevattempts.=&end_data_table_row();
1.40 ng 4255: }
1.1 albertel 4256: }
1.945 raeburn 4257: my @currhidden = keys(%lasthidden);
1.596 albertel 4258: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 4259: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 4260: next if ($key =~ /\.foilorder$/);
1.945 raeburn 4261: if (%typeparts) {
4262: my $hidden;
4263: foreach my $id (@currhidden) {
4264: if ($key =~ /^\Q$id\E/) {
4265: $hidden = 1;
4266: last;
4267: }
4268: }
4269: if ($hidden) {
4270: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
4271: if (($data eq 'award') || ($data eq 'awarddetail')) {
4272: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4273: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4274: $value = &$gradesub($value);
4275: }
4276: $prevattempts.='<td>'.$value.' </td>';
4277: } else {
4278: $prevattempts.='<td> </td>';
4279: }
4280: } else {
4281: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4282: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4283: $value = &$gradesub($value);
4284: }
4285: $prevattempts.='<td>'.$value.' </td>';
4286: }
4287: } else {
4288: my $value = &format_previous_attempt_value($key,$lasthash{$key});
4289: if ($key =~/$regexp$/ && (defined &$gradesub)) {
4290: $value = &$gradesub($value);
4291: }
4292: $prevattempts.='<td>'.$value.' </td>';
4293: }
1.16 harris41 4294: }
1.596 albertel 4295: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 4296: } else {
1.596 albertel 4297: $prevattempts=
4298: &start_data_table().&start_data_table_row().
4299: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
4300: &end_data_table_row().&end_data_table();
1.1 albertel 4301: }
4302: } else {
1.596 albertel 4303: $prevattempts=
4304: &start_data_table().&start_data_table_row().
4305: '<td>'.&mt('No data.').'</td>'.
4306: &end_data_table_row().&end_data_table();
1.1 albertel 4307: }
1.10 albertel 4308: }
4309:
1.581 albertel 4310: sub format_previous_attempt_value {
4311: my ($key,$value) = @_;
1.1011 www 4312: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 4313: $value = &Apache::lonlocal::locallocaltime($value);
4314: } elsif (ref($value) eq 'ARRAY') {
4315: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 4316: } elsif ($key =~ /answerstring$/) {
4317: my %answers = &Apache::lonnet::str2hash($value);
4318: my @anskeys = sort(keys(%answers));
4319: if (@anskeys == 1) {
4320: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4321: if ($answer =~ m{\0}) {
4322: $answer =~ s{\0}{,}g;
1.988 raeburn 4323: }
4324: my $tag_internal_answer_name = 'INTERNAL';
4325: if ($anskeys[0] eq $tag_internal_answer_name) {
4326: $value = $answer;
4327: } else {
4328: $value = $anskeys[0].'='.$answer;
4329: }
4330: } else {
4331: foreach my $ans (@anskeys) {
4332: my $answer = $answers{$ans};
1.1001 raeburn 4333: if ($answer =~ m{\0}) {
4334: $answer =~ s{\0}{,}g;
1.988 raeburn 4335: }
4336: $value .= $ans.'='.$answer.'<br />';;
4337: }
4338: }
1.581 albertel 4339: } else {
4340: $value = &unescape($value);
4341: }
4342: return $value;
4343: }
4344:
4345:
1.107 albertel 4346: sub relative_to_absolute {
4347: my ($url,$output)=@_;
4348: my $parser=HTML::TokeParser->new(\$output);
4349: my $token;
4350: my $thisdir=$url;
4351: my @rlinks=();
4352: while ($token=$parser->get_token) {
4353: if ($token->[0] eq 'S') {
4354: if ($token->[1] eq 'a') {
4355: if ($token->[2]->{'href'}) {
4356: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4357: }
4358: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4359: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4360: } elsif ($token->[1] eq 'base') {
4361: $thisdir=$token->[2]->{'href'};
4362: }
4363: }
4364: }
4365: $thisdir=~s-/[^/]*$--;
1.356 albertel 4366: foreach my $link (@rlinks) {
1.726 raeburn 4367: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4368: ($link=~/^\//) ||
4369: ($link=~/^javascript:/i) ||
4370: ($link=~/^mailto:/i) ||
4371: ($link=~/^\#/)) {
4372: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4373: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4374: }
4375: }
4376: # -------------------------------------------------- Deal with Applet codebases
4377: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4378: return $output;
4379: }
4380:
1.112 bowersj2 4381: =pod
4382:
1.648 raeburn 4383: =item * &get_student_view()
1.112 bowersj2 4384:
4385: show a snapshot of what student was looking at
4386:
4387: =cut
4388:
1.10 albertel 4389: sub get_student_view {
1.186 albertel 4390: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4391: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4392: my (%form);
1.10 albertel 4393: my @elements=('symb','courseid','domain','username');
4394: foreach my $element (@elements) {
1.186 albertel 4395: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4396: }
1.186 albertel 4397: if (defined($moreenv)) {
4398: %form=(%form,%{$moreenv});
4399: }
1.236 albertel 4400: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4401: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4402: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4403: $userview=~s/\<body[^\>]*\>//gi;
4404: $userview=~s/\<\/body\>//gi;
4405: $userview=~s/\<html\>//gi;
4406: $userview=~s/\<\/html\>//gi;
4407: $userview=~s/\<head\>//gi;
4408: $userview=~s/\<\/head\>//gi;
4409: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4410: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4411: if (wantarray) {
4412: return ($userview,$response);
4413: } else {
4414: return $userview;
4415: }
4416: }
4417:
4418: sub get_student_view_with_retries {
4419: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4420:
4421: my $ok = 0; # True if we got a good response.
4422: my $content;
4423: my $response;
4424:
4425: # Try to get the student_view done. within the retries count:
4426:
4427: do {
4428: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4429: $ok = $response->is_success;
4430: if (!$ok) {
4431: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4432: }
4433: $retries--;
4434: } while (!$ok && ($retries > 0));
4435:
4436: if (!$ok) {
4437: $content = ''; # On error return an empty content.
4438: }
1.651 www 4439: if (wantarray) {
4440: return ($content, $response);
4441: } else {
4442: return $content;
4443: }
1.11 albertel 4444: }
4445:
1.1075.2.149 raeburn 4446: sub css_links {
4447: my ($currsymb,$level) = @_;
4448: my ($links,@symbs,%cssrefs,%httpref);
4449: if ($level eq 'map') {
4450: my $navmap = Apache::lonnavmaps::navmap->new();
4451: if (ref($navmap)) {
4452: my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
4453: my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
4454: foreach my $res (@resources) {
4455: if (ref($res) && $res->symb()) {
4456: push(@symbs,$res->symb());
4457: }
4458: }
4459: }
4460: } else {
4461: @symbs = ($currsymb);
4462: }
4463: foreach my $symb (@symbs) {
4464: my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
4465: if ($css_href =~ /\S/) {
4466: unless ($css_href =~ m{https?://}) {
4467: my $url = (&Apache::lonnet::decode_symb($symb))[-1];
4468: my $proburl = &Apache::lonnet::clutter($url);
4469: my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
4470: unless ($css_href =~ m{^/}) {
4471: $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
4472: }
4473: if ($css_href =~ m{^/(res|uploaded)/}) {
4474: unless (($httpref{'httpref.'.$css_href}) ||
4475: (&Apache::lonnet::is_on_map($css_href))) {
4476: my $thisurl = $proburl;
4477: if ($env{'httpref.'.$proburl}) {
4478: $thisurl = $env{'httpref.'.$proburl};
4479: }
4480: $httpref{'httpref.'.$css_href} = $thisurl;
4481: }
4482: }
4483: }
4484: $cssrefs{$css_href} = 1;
4485: }
4486: }
4487: if (keys(%httpref)) {
4488: &Apache::lonnet::appenv(\%httpref);
4489: }
4490: if (keys(%cssrefs)) {
4491: foreach my $css_href (keys(%cssrefs)) {
4492: next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
4493: $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
4494: }
4495: }
4496: return $links;
4497: }
4498:
1.112 bowersj2 4499: =pod
4500:
1.648 raeburn 4501: =item * &get_student_answers()
1.112 bowersj2 4502:
4503: show a snapshot of how student was answering problem
4504:
4505: =cut
4506:
1.11 albertel 4507: sub get_student_answers {
1.100 sakharuk 4508: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4509: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4510: my (%moreenv);
1.11 albertel 4511: my @elements=('symb','courseid','domain','username');
4512: foreach my $element (@elements) {
1.186 albertel 4513: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4514: }
1.186 albertel 4515: $moreenv{'grade_target'}='answer';
4516: %moreenv=(%form,%moreenv);
1.497 raeburn 4517: $feedurl = &Apache::lonnet::clutter($feedurl);
4518: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4519: return $userview;
1.1 albertel 4520: }
1.116 albertel 4521:
4522: =pod
4523:
4524: =item * &submlink()
4525:
1.242 albertel 4526: Inputs: $text $uname $udom $symb $target
1.116 albertel 4527:
4528: Returns: A link to grades.pm such as to see the SUBM view of a student
4529:
4530: =cut
4531:
4532: ###############################################
4533: sub submlink {
1.242 albertel 4534: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4535: if (!($uname && $udom)) {
4536: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4537: &Apache::lonnet::whichuser($symb);
1.116 albertel 4538: if (!$symb) { $symb=$cursymb; }
4539: }
1.254 matthew 4540: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4541: $symb=&escape($symb);
1.960 bisitz 4542: if ($target) { $target=" target=\"$target\""; }
4543: return
4544: '<a href="/adm/grades?command=submission'.
4545: '&symb='.$symb.
4546: '&student='.$uname.
4547: '&userdom='.$udom.'"'.
4548: $target.'>'.$text.'</a>';
1.242 albertel 4549: }
4550: ##############################################
4551:
4552: =pod
4553:
4554: =item * &pgrdlink()
4555:
4556: Inputs: $text $uname $udom $symb $target
4557:
4558: Returns: A link to grades.pm such as to see the PGRD view of a student
4559:
4560: =cut
4561:
4562: ###############################################
4563: sub pgrdlink {
4564: my $link=&submlink(@_);
4565: $link=~s/(&command=submission)/$1&showgrading=yes/;
4566: return $link;
4567: }
4568: ##############################################
4569:
4570: =pod
4571:
4572: =item * &pprmlink()
4573:
4574: Inputs: $text $uname $udom $symb $target
4575:
4576: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4577: student and a specific resource
1.242 albertel 4578:
4579: =cut
4580:
4581: ###############################################
4582: sub pprmlink {
4583: my ($text,$uname,$udom,$symb,$target)=@_;
4584: if (!($uname && $udom)) {
4585: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4586: &Apache::lonnet::whichuser($symb);
1.242 albertel 4587: if (!$symb) { $symb=$cursymb; }
4588: }
1.254 matthew 4589: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4590: $symb=&escape($symb);
1.242 albertel 4591: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4592: return '<a href="/adm/parmset?command=set&'.
4593: 'symb='.$symb.'&uname='.$uname.
4594: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4595: }
4596: ##############################################
1.37 matthew 4597:
1.112 bowersj2 4598: =pod
4599:
4600: =back
4601:
4602: =cut
4603:
1.37 matthew 4604: ###############################################
1.51 www 4605:
4606:
4607: sub timehash {
1.687 raeburn 4608: my ($thistime) = @_;
4609: my $timezone = &Apache::lonlocal::gettimezone();
4610: my $dt = DateTime->from_epoch(epoch => $thistime)
4611: ->set_time_zone($timezone);
4612: my $wday = $dt->day_of_week();
4613: if ($wday == 7) { $wday = 0; }
4614: return ( 'second' => $dt->second(),
4615: 'minute' => $dt->minute(),
4616: 'hour' => $dt->hour(),
4617: 'day' => $dt->day_of_month(),
4618: 'month' => $dt->month(),
4619: 'year' => $dt->year(),
4620: 'weekday' => $wday,
4621: 'dayyear' => $dt->day_of_year(),
4622: 'dlsav' => $dt->is_dst() );
1.51 www 4623: }
4624:
1.370 www 4625: sub utc_string {
4626: my ($date)=@_;
1.371 www 4627: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4628: }
4629:
1.51 www 4630: sub maketime {
4631: my %th=@_;
1.687 raeburn 4632: my ($epoch_time,$timezone,$dt);
4633: $timezone = &Apache::lonlocal::gettimezone();
4634: eval {
4635: $dt = DateTime->new( year => $th{'year'},
4636: month => $th{'month'},
4637: day => $th{'day'},
4638: hour => $th{'hour'},
4639: minute => $th{'minute'},
4640: second => $th{'second'},
4641: time_zone => $timezone,
4642: );
4643: };
4644: if (!$@) {
4645: $epoch_time = $dt->epoch;
4646: if ($epoch_time) {
4647: return $epoch_time;
4648: }
4649: }
1.51 www 4650: return POSIX::mktime(
4651: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4652: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4653: }
4654:
4655: #########################################
1.51 www 4656:
4657: sub findallcourses {
1.482 raeburn 4658: my ($roles,$uname,$udom) = @_;
1.355 albertel 4659: my %roles;
4660: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4661: my %courses;
1.51 www 4662: my $now=time;
1.482 raeburn 4663: if (!defined($uname)) {
4664: $uname = $env{'user.name'};
4665: }
4666: if (!defined($udom)) {
4667: $udom = $env{'user.domain'};
4668: }
4669: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4670: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4671: if (!%roles) {
4672: %roles = (
4673: cc => 1,
1.907 raeburn 4674: co => 1,
1.482 raeburn 4675: in => 1,
4676: ep => 1,
4677: ta => 1,
4678: cr => 1,
4679: st => 1,
4680: );
4681: }
4682: foreach my $entry (keys(%roleshash)) {
4683: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4684: if ($trole =~ /^cr/) {
4685: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4686: } else {
4687: next if (!exists($roles{$trole}));
4688: }
4689: if ($tend) {
4690: next if ($tend < $now);
4691: }
4692: if ($tstart) {
4693: next if ($tstart > $now);
4694: }
1.1058 raeburn 4695: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4696: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4697: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4698: if ($secpart eq '') {
4699: ($cnum,$role) = split(/_/,$cnumpart);
4700: $sec = 'none';
1.1058 raeburn 4701: $value .= $cnum.'/';
1.482 raeburn 4702: } else {
4703: $cnum = $cnumpart;
4704: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4705: $value .= $cnum.'/'.$sec;
4706: }
4707: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4708: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4709: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4710: }
4711: } else {
4712: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4713: }
1.482 raeburn 4714: }
4715: } else {
4716: foreach my $key (keys(%env)) {
1.483 albertel 4717: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4718: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4719: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4720: next if ($role eq 'ca' || $role eq 'aa');
4721: next if (%roles && !exists($roles{$role}));
4722: my ($starttime,$endtime)=split(/\./,$env{$key});
4723: my $active=1;
4724: if ($starttime) {
4725: if ($now<$starttime) { $active=0; }
4726: }
4727: if ($endtime) {
4728: if ($now>$endtime) { $active=0; }
4729: }
4730: if ($active) {
1.1058 raeburn 4731: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4732: if ($sec eq '') {
4733: $sec = 'none';
1.1058 raeburn 4734: } else {
4735: $value .= $sec;
4736: }
4737: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4738: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4739: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4740: }
4741: } else {
4742: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4743: }
1.474 raeburn 4744: }
4745: }
1.51 www 4746: }
4747: }
1.474 raeburn 4748: return %courses;
1.51 www 4749: }
1.37 matthew 4750:
1.54 www 4751: ###############################################
1.474 raeburn 4752:
4753: sub blockcheck {
1.1075.2.158 raeburn 4754: my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.490 raeburn 4755:
1.1075.2.158 raeburn 4756: unless ($activity eq 'docs') {
4757: my ($has_evb,$check_ipaccess);
4758: my $dom = $env{'user.domain'};
4759: if ($env{'request.course.id'}) {
4760: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
4761: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
4762: my $checkrole = "cm./$cdom/$cnum";
4763: my $sec = $env{'request.course.sec'};
4764: if ($sec ne '') {
4765: $checkrole .= "/$sec";
4766: }
4767: if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
4768: ($env{'request.role'} !~ /^st/)) {
4769: $has_evb = 1;
4770: }
4771: unless ($has_evb) {
4772: if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
4773: ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
4774: if ($udom eq $cdom) {
4775: $check_ipaccess = 1;
4776: }
4777: }
4778: }
1.1075.2.163 raeburn 4779: } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
4780: ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
4781: my $checkrole;
4782: if ($env{'request.role.domain'} eq '') {
4783: $checkrole = "cm./$env{'user.domain'}/";
4784: } else {
4785: $checkrole = "cm./$env{'request.role.domain'}/";
4786: }
4787: if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
4788: $has_evb = 1;
4789: }
1.1075.2.158 raeburn 4790: }
4791: unless ($has_evb || $check_ipaccess) {
4792: my @machinedoms = &Apache::lonnet::current_machine_domains();
4793: if (($dom eq 'public') && ($activity eq 'port')) {
4794: $dom = $udom;
4795: }
4796: if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
4797: $check_ipaccess = 1;
4798: } else {
4799: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
4800: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
4801: my $prim = &Apache::lonnet::domain($dom,'primary');
4802: my $intdom = &Apache::lonnet::internet_dom($prim);
4803: if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
4804: if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
4805: $check_ipaccess = 1;
4806: }
4807: }
4808: }
4809: }
4810: if ($check_ipaccess) {
4811: my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
4812: unless (defined($cached)) {
4813: my %domconfig =
4814: &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
4815: $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
4816: }
4817: if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
4818: foreach my $id (keys(%{$ipaccessref})) {
4819: if (ref($ipaccessref->{$id}) eq 'HASH') {
4820: my $range = $ipaccessref->{$id}->{'ip'};
4821: if ($range) {
4822: if (&Apache::lonnet::ip_match($clientip,$range)) {
4823: if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
4824: if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
4825: return ('','','',$id,$dom);
4826: last;
4827: }
4828: }
4829: }
4830: }
4831: }
4832: }
4833: }
4834: }
1.1075.2.164 raeburn 4835: if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
4836: return ();
4837: }
1.1075.2.158 raeburn 4838: }
1.1075.2.73 raeburn 4839: if (defined($udom) && defined($uname)) {
4840: # If uname and udom are for a course, check for blocks in the course.
4841: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4842: my ($startblock,$endblock,$triggerblock) =
1.1075.2.147 raeburn 4843: &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
1.1075.2.73 raeburn 4844: return ($startblock,$endblock,$triggerblock);
4845: }
4846: } else {
1.490 raeburn 4847: $udom = $env{'user.domain'};
4848: $uname = $env{'user.name'};
4849: }
4850:
1.502 raeburn 4851: my $startblock = 0;
4852: my $endblock = 0;
1.1062 raeburn 4853: my $triggerblock = '';
1.1075.2.160 raeburn 4854: my %live_courses;
4855: unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
4856: %live_courses = &findallcourses(undef,$uname,$udom);
4857: }
1.474 raeburn 4858:
1.490 raeburn 4859: # If uname is for a user, and activity is course-specific, i.e.,
4860: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4861:
1.490 raeburn 4862: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73 raeburn 4863: $activity eq 'groups' || $activity eq 'printout') &&
4864: ($env{'request.course.id'})) {
1.490 raeburn 4865: foreach my $key (keys(%live_courses)) {
4866: if ($key ne $env{'request.course.id'}) {
4867: delete($live_courses{$key});
4868: }
4869: }
4870: }
4871:
4872: my $otheruser = 0;
4873: my %own_courses;
4874: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4875: # Resource belongs to user other than current user.
4876: $otheruser = 1;
4877: # Gather courses for current user
4878: %own_courses =
4879: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4880: }
4881:
4882: # Gather active course roles - course coordinator, instructor,
4883: # exam proctor, ta, student, or custom role.
1.474 raeburn 4884:
4885: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4886: my ($cdom,$cnum);
4887: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4888: $cdom = $env{'course.'.$course.'.domain'};
4889: $cnum = $env{'course.'.$course.'.num'};
4890: } else {
1.490 raeburn 4891: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4892: }
4893: my $no_ownblock = 0;
4894: my $no_userblock = 0;
1.533 raeburn 4895: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4896: # Check if current user has 'evb' priv for this
4897: if (defined($own_courses{$course})) {
4898: foreach my $sec (keys(%{$own_courses{$course}})) {
4899: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4900: if ($sec ne 'none') {
4901: $checkrole .= '/'.$sec;
4902: }
4903: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4904: $no_ownblock = 1;
4905: last;
4906: }
4907: }
4908: }
4909: # if they have 'evb' priv and are currently not playing student
4910: next if (($no_ownblock) &&
4911: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4912: }
1.474 raeburn 4913: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4914: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4915: if ($sec ne 'none') {
1.482 raeburn 4916: $checkrole .= '/'.$sec;
1.474 raeburn 4917: }
1.490 raeburn 4918: if ($otheruser) {
4919: # Resource belongs to user other than current user.
4920: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4921: my (%allroles,%userroles);
4922: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4923: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4924: my ($trole,$tdom,$tnum,$tsec);
4925: if ($entry =~ /^cr/) {
4926: ($trole,$tdom,$tnum,$tsec) =
4927: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4928: } else {
4929: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4930: }
4931: my ($spec,$area,$trest);
4932: $area = '/'.$tdom.'/'.$tnum;
4933: $trest = $tnum;
4934: if ($tsec ne '') {
4935: $area .= '/'.$tsec;
4936: $trest .= '/'.$tsec;
4937: }
4938: $spec = $trole.'.'.$area;
4939: if ($trole =~ /^cr/) {
4940: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4941: $tdom,$spec,$trest,$area);
4942: } else {
4943: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4944: $tdom,$spec,$trest,$area);
4945: }
4946: }
1.1075.2.124 raeburn 4947: my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
1.1058 raeburn 4948: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4949: if ($1) {
4950: $no_userblock = 1;
4951: last;
4952: }
1.486 raeburn 4953: }
4954: }
1.490 raeburn 4955: } else {
4956: # Resource belongs to current user
4957: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4958: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4959: $no_ownblock = 1;
4960: last;
4961: }
1.474 raeburn 4962: }
4963: }
4964: # if they have the evb priv and are currently not playing student
1.482 raeburn 4965: next if (($no_ownblock) &&
1.491 albertel 4966: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4967: next if ($no_userblock);
1.474 raeburn 4968:
1.1075.2.128 raeburn 4969: # Retrieve blocking times and identity of blocker for course
1.490 raeburn 4970: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4971:
1.1062 raeburn 4972: my ($start,$end,$trigger) =
1.1075.2.147 raeburn 4973: &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
1.502 raeburn 4974: if (($start != 0) &&
4975: (($startblock == 0) || ($startblock > $start))) {
4976: $startblock = $start;
1.1062 raeburn 4977: if ($trigger ne '') {
4978: $triggerblock = $trigger;
4979: }
1.502 raeburn 4980: }
4981: if (($end != 0) &&
4982: (($endblock == 0) || ($endblock < $end))) {
4983: $endblock = $end;
1.1062 raeburn 4984: if ($trigger ne '') {
4985: $triggerblock = $trigger;
4986: }
1.502 raeburn 4987: }
1.490 raeburn 4988: }
1.1062 raeburn 4989: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4990: }
4991:
4992: sub get_blocks {
1.1075.2.147 raeburn 4993: my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
1.490 raeburn 4994: my $startblock = 0;
4995: my $endblock = 0;
1.1062 raeburn 4996: my $triggerblock = '';
1.490 raeburn 4997: my $course = $cdom.'_'.$cnum;
4998: $setters->{$course} = {};
4999: $setters->{$course}{'staff'} = [];
5000: $setters->{$course}{'times'} = [];
1.1062 raeburn 5001: $setters->{$course}{'triggers'} = [];
5002: my (@blockers,%triggered);
5003: my $now = time;
5004: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
5005: if ($activity eq 'docs') {
1.1075.2.148 raeburn 5006: my ($blocked,$nosymbcache,$noenccheck);
1.1075.2.147 raeburn 5007: if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
5008: $blocked = 1;
5009: $nosymbcache = 1;
1.1075.2.148 raeburn 5010: $noenccheck = 1;
1.1075.2.147 raeburn 5011: }
1.1075.2.148 raeburn 5012: @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
1.1062 raeburn 5013: foreach my $block (@blockers) {
5014: if ($block =~ /^firstaccess____(.+)$/) {
5015: my $item = $1;
5016: my $type = 'map';
5017: my $timersymb = $item;
5018: if ($item eq 'course') {
5019: $type = 'course';
5020: } elsif ($item =~ /___\d+___/) {
5021: $type = 'resource';
5022: } else {
5023: $timersymb = &Apache::lonnet::symbread($item);
5024: }
5025: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5026: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5027: $triggered{$block} = {
5028: start => $start,
5029: end => $end,
5030: type => $type,
5031: };
5032: }
5033: }
5034: } else {
5035: foreach my $block (keys(%commblocks)) {
5036: if ($block =~ m/^(\d+)____(\d+)$/) {
5037: my ($start,$end) = ($1,$2);
5038: if ($start <= time && $end >= time) {
5039: if (ref($commblocks{$block}) eq 'HASH') {
5040: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5041: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5042: unless(grep(/^\Q$block\E$/,@blockers)) {
5043: push(@blockers,$block);
5044: }
5045: }
5046: }
5047: }
5048: }
5049: } elsif ($block =~ /^firstaccess____(.+)$/) {
5050: my $item = $1;
5051: my $timersymb = $item;
5052: my $type = 'map';
5053: if ($item eq 'course') {
5054: $type = 'course';
5055: } elsif ($item =~ /___\d+___/) {
5056: $type = 'resource';
5057: } else {
5058: $timersymb = &Apache::lonnet::symbread($item);
5059: }
5060: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
5061: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
5062: if ($start && $end) {
5063: if (($start <= time) && ($end >= time)) {
1.1075.2.158 raeburn 5064: if (ref($commblocks{$block}) eq 'HASH') {
5065: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
5066: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
5067: unless(grep(/^\Q$block\E$/,@blockers)) {
5068: push(@blockers,$block);
5069: $triggered{$block} = {
5070: start => $start,
5071: end => $end,
5072: type => $type,
5073: };
5074: }
5075: }
5076: }
1.1062 raeburn 5077: }
5078: }
1.490 raeburn 5079: }
1.1062 raeburn 5080: }
5081: }
5082: }
5083: foreach my $blocker (@blockers) {
5084: my ($staff_name,$staff_dom,$title,$blocks) =
5085: &parse_block_record($commblocks{$blocker});
5086: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
5087: my ($start,$end,$triggertype);
5088: if ($blocker =~ m/^(\d+)____(\d+)$/) {
5089: ($start,$end) = ($1,$2);
5090: } elsif (ref($triggered{$blocker}) eq 'HASH') {
5091: $start = $triggered{$blocker}{'start'};
5092: $end = $triggered{$blocker}{'end'};
5093: $triggertype = $triggered{$blocker}{'type'};
5094: }
5095: if ($start) {
5096: push(@{$$setters{$course}{'times'}}, [$start,$end]);
5097: if ($triggertype) {
5098: push(@{$$setters{$course}{'triggers'}},$triggertype);
5099: } else {
5100: push(@{$$setters{$course}{'triggers'}},0);
5101: }
5102: if ( ($startblock == 0) || ($startblock > $start) ) {
5103: $startblock = $start;
5104: if ($triggertype) {
5105: $triggerblock = $blocker;
1.474 raeburn 5106: }
5107: }
1.1062 raeburn 5108: if ( ($endblock == 0) || ($endblock < $end) ) {
5109: $endblock = $end;
5110: if ($triggertype) {
5111: $triggerblock = $blocker;
5112: }
5113: }
1.474 raeburn 5114: }
5115: }
1.1062 raeburn 5116: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 5117: }
5118:
5119: sub parse_block_record {
5120: my ($record) = @_;
5121: my ($setuname,$setudom,$title,$blocks);
5122: if (ref($record) eq 'HASH') {
5123: ($setuname,$setudom) = split(/:/,$record->{'setter'});
5124: $title = &unescape($record->{'event'});
5125: $blocks = $record->{'blocks'};
5126: } else {
5127: my @data = split(/:/,$record,3);
5128: if (scalar(@data) eq 2) {
5129: $title = $data[1];
5130: ($setuname,$setudom) = split(/@/,$data[0]);
5131: } else {
5132: ($setuname,$setudom,$title) = @data;
5133: }
5134: $blocks = { 'com' => 'on' };
5135: }
5136: return ($setuname,$setudom,$title,$blocks);
5137: }
5138:
1.854 kalberla 5139: sub blocking_status {
1.1075.2.158 raeburn 5140: my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
1.1061 raeburn 5141: my %setters;
1.890 droeschl 5142:
1.1061 raeburn 5143: # check for active blocking
1.1075.2.158 raeburn 5144: if ($clientip eq '') {
5145: $clientip = &Apache::lonnet::get_requestor_ip();
5146: }
5147: my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
5148: &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
1.1062 raeburn 5149: my $blocked = 0;
1.1075.2.158 raeburn 5150: if (($startblock && $endblock) || ($by_ip)) {
1.1062 raeburn 5151: $blocked = 1;
5152: }
1.890 droeschl 5153:
1.1061 raeburn 5154: # caller just wants to know whether a block is active
5155: if (!wantarray) { return $blocked; }
5156:
5157: # build a link to a popup window containing the details
5158: my $querystring = "?activity=$activity";
1.1075.2.158 raeburn 5159: # $uname and $udom decide whose portfolio (or information page) the user is trying to look at
5160: if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
1.1075.2.97 raeburn 5161: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
5162: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 5163: } elsif ($activity eq 'docs') {
1.1075.2.147 raeburn 5164: my $showurl = &Apache::lonenc::check_encrypt($url);
5165: $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
5166: if ($symb) {
5167: my $showsymb = &Apache::lonenc::check_encrypt($symb);
5168: $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
5169: }
1.1062 raeburn 5170: }
1.1061 raeburn 5171:
5172: my $output .= <<'END_MYBLOCK';
5173: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
5174: var options = "width=" + w + ",height=" + h + ",";
5175: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
5176: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
5177: var newWin = window.open(url, wdwName, options);
5178: newWin.focus();
5179: }
1.890 droeschl 5180: END_MYBLOCK
1.854 kalberla 5181:
1.1061 raeburn 5182: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 5183:
1.1061 raeburn 5184: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 5185: my $text = &mt('Communication Blocked');
1.1075.2.93 raeburn 5186: my $class = 'LC_comblock';
1.1062 raeburn 5187: if ($activity eq 'docs') {
5188: $text = &mt('Content Access Blocked');
1.1075.2.93 raeburn 5189: $class = '';
1.1063 raeburn 5190: } elsif ($activity eq 'printout') {
5191: $text = &mt('Printing Blocked');
1.1075.2.97 raeburn 5192: } elsif ($activity eq 'passwd') {
5193: $text = &mt('Password Changing Blocked');
1.1075.2.158 raeburn 5194: } elsif ($activity eq 'grades') {
5195: $text = &mt('Gradebook Blocked');
5196: } elsif ($activity eq 'search') {
5197: $text = &mt('Search Blocked');
5198: } elsif ($activity eq 'about') {
5199: $text = &mt('Access to User Information Pages Blocked');
1.1075.2.160 raeburn 5200: } elsif ($activity eq 'wishlist') {
5201: $text = &mt('Access to Stored Links Blocked');
5202: } elsif ($activity eq 'annotate') {
5203: $text = &mt('Access to Annotations Blocked');
1.1062 raeburn 5204: }
1.1061 raeburn 5205: $output .= <<"END_BLOCK";
1.1075.2.93 raeburn 5206: <div class='$class'>
1.869 kalberla 5207: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5208: title='$text'>
5209: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 5210: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 5211: title='$text'>$text</a>
1.867 kalberla 5212: </div>
5213:
5214: END_BLOCK
1.474 raeburn 5215:
1.1061 raeburn 5216: return ($blocked, $output);
1.854 kalberla 5217: }
1.490 raeburn 5218:
1.60 matthew 5219: ###############################################
5220:
1.682 raeburn 5221: sub check_ip_acc {
1.1075.2.105 raeburn 5222: my ($acc,$clientip)=@_;
1.682 raeburn 5223: &Apache::lonxml::debug("acc is $acc");
5224: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
5225: return 1;
5226: }
5227: my $allowed=0;
1.1075.2.144 raeburn 5228: my $ip;
5229: if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
5230: ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
5231: $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
5232: } else {
1.1075.2.150 raeburn 5233: my $remote_ip = &Apache::lonnet::get_requestor_ip();
5234: $ip = $remote_ip || $env{'request.host'} || $clientip;
1.1075.2.144 raeburn 5235: }
1.682 raeburn 5236:
5237: my $name;
5238: foreach my $pattern (split(',',$acc)) {
5239: $pattern =~ s/^\s*//;
5240: $pattern =~ s/\s*$//;
5241: if ($pattern =~ /\*$/) {
5242: #35.8.*
5243: $pattern=~s/\*//;
5244: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
5245: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
5246: #35.8.3.[34-56]
5247: my $low=$2;
5248: my $high=$3;
5249: $pattern=$1;
5250: if ($ip =~ /^\Q$pattern\E/) {
5251: my $last=(split(/\./,$ip))[3];
5252: if ($last <=$high && $last >=$low) { $allowed=1; }
5253: }
5254: } elsif ($pattern =~ /^\*/) {
5255: #*.msu.edu
5256: $pattern=~s/\*//;
5257: if (!defined($name)) {
5258: use Socket;
5259: my $netaddr=inet_aton($ip);
5260: ($name)=gethostbyaddr($netaddr,AF_INET);
5261: }
5262: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
5263: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
5264: #127.0.0.1
5265: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
5266: } else {
5267: #some.name.com
5268: if (!defined($name)) {
5269: use Socket;
5270: my $netaddr=inet_aton($ip);
5271: ($name)=gethostbyaddr($netaddr,AF_INET);
5272: }
5273: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
5274: }
5275: if ($allowed) { last; }
5276: }
5277: return $allowed;
5278: }
5279:
5280: ###############################################
5281:
1.60 matthew 5282: =pod
5283:
1.112 bowersj2 5284: =head1 Domain Template Functions
5285:
5286: =over 4
5287:
5288: =item * &determinedomain()
1.60 matthew 5289:
5290: Inputs: $domain (usually will be undef)
5291:
1.63 www 5292: Returns: Determines which domain should be used for designs
1.60 matthew 5293:
5294: =cut
1.54 www 5295:
1.60 matthew 5296: ###############################################
1.63 www 5297: sub determinedomain {
5298: my $domain=shift;
1.531 albertel 5299: if (! $domain) {
1.60 matthew 5300: # Determine domain if we have not been given one
1.893 raeburn 5301: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 5302: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
5303: if ($env{'request.role.domain'}) {
5304: $domain=$env{'request.role.domain'};
1.60 matthew 5305: }
5306: }
1.63 www 5307: return $domain;
5308: }
5309: ###############################################
1.517 raeburn 5310:
1.518 albertel 5311: sub devalidate_domconfig_cache {
5312: my ($udom)=@_;
5313: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
5314: }
5315:
5316: # ---------------------- Get domain configuration for a domain
5317: sub get_domainconf {
5318: my ($udom) = @_;
5319: my $cachetime=1800;
5320: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
5321: if (defined($cached)) { return %{$result}; }
5322:
5323: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 5324: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 5325: my (%designhash,%legacy);
1.518 albertel 5326: if (keys(%domconfig) > 0) {
5327: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 5328: if (keys(%{$domconfig{'login'}})) {
5329: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 5330: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87 raeburn 5331: if (($key eq 'loginvia') || ($key eq 'headtag')) {
5332: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5333: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
5334: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
5335: if ($key eq 'loginvia') {
5336: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
5337: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
5338: $designhash{$udom.'.login.loginvia'} = $server;
5339: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
5340: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
5341: } else {
5342: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
5343: }
1.948 raeburn 5344: }
1.1075.2.87 raeburn 5345: } elsif ($key eq 'headtag') {
5346: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
5347: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 5348: }
1.946 raeburn 5349: }
1.1075.2.87 raeburn 5350: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
5351: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
5352: }
1.946 raeburn 5353: }
5354: }
5355: }
1.1075.2.158 raeburn 5356: } elsif ($key eq 'saml') {
5357: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
5358: foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
5359: if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
5360: $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
5361: foreach my $item ('text','img','alt','url','title','notsso') {
5362: $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
5363: }
5364: }
5365: }
5366: }
1.946 raeburn 5367: } else {
5368: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
5369: $designhash{$udom.'.login.'.$key.'_'.$img} =
5370: $domconfig{'login'}{$key}{$img};
5371: }
1.699 raeburn 5372: }
5373: } else {
5374: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
5375: }
1.632 raeburn 5376: }
5377: } else {
5378: $legacy{'login'} = 1;
1.518 albertel 5379: }
1.632 raeburn 5380: } else {
5381: $legacy{'login'} = 1;
1.518 albertel 5382: }
5383: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 5384: if (keys(%{$domconfig{'rolecolors'}})) {
5385: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
5386: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
5387: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
5388: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
5389: }
1.518 albertel 5390: }
5391: }
1.632 raeburn 5392: } else {
5393: $legacy{'rolecolors'} = 1;
1.518 albertel 5394: }
1.632 raeburn 5395: } else {
5396: $legacy{'rolecolors'} = 1;
1.518 albertel 5397: }
1.948 raeburn 5398: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
5399: if ($domconfig{'autoenroll'}{'co-owners'}) {
5400: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
5401: }
5402: }
1.632 raeburn 5403: if (keys(%legacy) > 0) {
5404: my %legacyhash = &get_legacy_domconf($udom);
5405: foreach my $item (keys(%legacyhash)) {
5406: if ($item =~ /^\Q$udom\E\.login/) {
5407: if ($legacy{'login'}) {
5408: $designhash{$item} = $legacyhash{$item};
5409: }
5410: } else {
5411: if ($legacy{'rolecolors'}) {
5412: $designhash{$item} = $legacyhash{$item};
5413: }
1.518 albertel 5414: }
5415: }
5416: }
1.632 raeburn 5417: } else {
5418: %designhash = &get_legacy_domconf($udom);
1.518 albertel 5419: }
5420: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
5421: $cachetime);
5422: return %designhash;
5423: }
5424:
1.632 raeburn 5425: sub get_legacy_domconf {
5426: my ($udom) = @_;
5427: my %legacyhash;
5428: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
5429: my $designfile = $designdir.'/'.$udom.'.tab';
5430: if (-e $designfile) {
1.1075.2.128 raeburn 5431: if ( open (my $fh,'<',$designfile) ) {
1.632 raeburn 5432: while (my $line = <$fh>) {
5433: next if ($line =~ /^\#/);
5434: chomp($line);
5435: my ($key,$val)=(split(/\=/,$line));
5436: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
5437: }
5438: close($fh);
5439: }
5440: }
1.1026 raeburn 5441: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 5442: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
5443: }
5444: return %legacyhash;
5445: }
5446:
1.63 www 5447: =pod
5448:
1.112 bowersj2 5449: =item * &domainlogo()
1.63 www 5450:
5451: Inputs: $domain (usually will be undef)
5452:
5453: Returns: A link to a domain logo, if the domain logo exists.
5454: If the domain logo does not exist, a description of the domain.
5455:
5456: =cut
1.112 bowersj2 5457:
1.63 www 5458: ###############################################
5459: sub domainlogo {
1.517 raeburn 5460: my $domain = &determinedomain(shift);
1.518 albertel 5461: my %designhash = &get_domainconf($domain);
1.517 raeburn 5462: # See if there is a logo
5463: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 5464: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 5465: if ($imgsrc =~ m{^/(adm|res)/}) {
5466: if ($imgsrc =~ m{^/res/}) {
5467: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
5468: &Apache::lonnet::repcopy($local_name);
5469: }
5470: $imgsrc = &lonhttpdurl($imgsrc);
1.1075.2.162 raeburn 5471: }
5472: my $alttext = $domain;
5473: if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
5474: $alttext = $designhash{$domain.'.login.alttext_domlogo'};
5475: }
5476: return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
1.514 albertel 5477: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
5478: return &Apache::lonnet::domain($domain,'description');
1.59 www 5479: } else {
1.60 matthew 5480: return '';
1.59 www 5481: }
5482: }
1.63 www 5483: ##############################################
5484:
5485: =pod
5486:
1.112 bowersj2 5487: =item * &designparm()
1.63 www 5488:
5489: Inputs: $which parameter; $domain (usually will be undef)
5490:
5491: Returns: value of designparamter $which
5492:
5493: =cut
1.112 bowersj2 5494:
1.397 albertel 5495:
1.400 albertel 5496: ##############################################
1.397 albertel 5497: sub designparm {
5498: my ($which,$domain)=@_;
5499: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 5500: return $env{'environment.color.'.$which};
1.96 www 5501: }
1.63 www 5502: $domain=&determinedomain($domain);
1.1016 raeburn 5503: my %domdesign;
5504: unless ($domain eq 'public') {
5505: %domdesign = &get_domainconf($domain);
5506: }
1.520 raeburn 5507: my $output;
1.517 raeburn 5508: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 5509: $output = $domdesign{$domain.'.'.$which};
1.63 www 5510: } else {
1.520 raeburn 5511: $output = $defaultdesign{$which};
5512: }
5513: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5514: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5515: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5516: if ($output =~ m{^/res/}) {
5517: my $local_name = &Apache::lonnet::filelocation('',$output);
5518: &Apache::lonnet::repcopy($local_name);
5519: }
1.520 raeburn 5520: $output = &lonhttpdurl($output);
5521: }
1.63 www 5522: }
1.520 raeburn 5523: return $output;
1.63 www 5524: }
1.59 www 5525:
1.822 bisitz 5526: ##############################################
5527: =pod
5528:
1.832 bisitz 5529: =item * &authorspace()
5530:
1.1028 raeburn 5531: Inputs: $url (usually will be undef).
1.832 bisitz 5532:
1.1075.2.40 raeburn 5533: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5534: directory being viewed (or for which action is being taken).
5535: If $url is provided, and begins /priv/<domain>/<uname>
5536: the path will be that portion of the $context argument.
5537: Otherwise the path will be for the author space of the current
5538: user when the current role is author, or for that of the
5539: co-author/assistant co-author space when the current role
5540: is co-author or assistant co-author.
1.832 bisitz 5541:
5542: =cut
5543:
5544: sub authorspace {
1.1028 raeburn 5545: my ($url) = @_;
5546: if ($url ne '') {
5547: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5548: return $1;
5549: }
5550: }
1.832 bisitz 5551: my $caname = '';
1.1024 www 5552: my $cadom = '';
1.1028 raeburn 5553: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5554: ($cadom,$caname) =
1.832 bisitz 5555: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5556: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5557: $caname = $env{'user.name'};
1.1024 www 5558: $cadom = $env{'user.domain'};
1.832 bisitz 5559: }
1.1028 raeburn 5560: if (($caname ne '') && ($cadom ne '')) {
5561: return "/priv/$cadom/$caname/";
5562: }
5563: return;
1.832 bisitz 5564: }
5565:
5566: ##############################################
5567: =pod
5568:
1.822 bisitz 5569: =item * &head_subbox()
5570:
5571: Inputs: $content (contains HTML code with page functions, etc.)
5572:
5573: Returns: HTML div with $content
5574: To be included in page header
5575:
5576: =cut
5577:
5578: sub head_subbox {
5579: my ($content)=@_;
5580: my $output =
1.993 raeburn 5581: '<div class="LC_head_subbox">'
1.822 bisitz 5582: .$content
5583: .'</div>'
5584: }
5585:
5586: ##############################################
5587: =pod
5588:
5589: =item * &CSTR_pageheader()
5590:
1.1026 raeburn 5591: Input: (optional) filename from which breadcrumb trail is built.
5592: In most cases no input as needed, as $env{'request.filename'}
5593: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5594:
5595: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 5596: To be included on Authoring Space pages
1.822 bisitz 5597:
5598: =cut
5599:
5600: sub CSTR_pageheader {
1.1026 raeburn 5601: my ($trailfile) = @_;
5602: if ($trailfile eq '') {
5603: $trailfile = $env{'request.filename'};
5604: }
5605:
5606: # this is for resources; directories have customtitle, and crumbs
5607: # and select recent are created in lonpubdir.pm
5608:
5609: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5610: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 5611: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5612: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5613: $formaction =~ s{/+}{/}g;
1.822 bisitz 5614:
5615: my $parentpath = '';
5616: my $lastitem = '';
5617: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5618: $parentpath = $1;
5619: $lastitem = $2;
5620: } else {
5621: $lastitem = $thisdisfn;
5622: }
1.921 bisitz 5623:
5624: my $output =
1.822 bisitz 5625: '<div>'
5626: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40 raeburn 5627: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5628: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5629: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5630: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5631:
5632: if ($lastitem) {
5633: $output .=
5634: '<span class="LC_filename">'
5635: .$lastitem
5636: .'</span>';
5637: }
5638: $output .=
5639: '<br />'
1.822 bisitz 5640: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5641: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5642: .'</form>'
5643: .&Apache::lonmenu::constspaceform()
5644: .'</div>';
1.921 bisitz 5645:
5646: return $output;
1.822 bisitz 5647: }
5648:
1.60 matthew 5649: ###############################################
5650: ###############################################
5651:
5652: =pod
5653:
1.112 bowersj2 5654: =back
5655:
1.549 albertel 5656: =head1 HTML Helpers
1.112 bowersj2 5657:
5658: =over 4
5659:
5660: =item * &bodytag()
1.60 matthew 5661:
5662: Returns a uniform header for LON-CAPA web pages.
5663:
5664: Inputs:
5665:
1.112 bowersj2 5666: =over 4
5667:
5668: =item * $title, A title to be displayed on the page.
5669:
5670: =item * $function, the current role (can be undef).
5671:
5672: =item * $addentries, extra parameters for the <body> tag.
5673:
5674: =item * $bodyonly, if defined, only return the <body> tag.
5675:
5676: =item * $domain, if defined, force a given domain.
5677:
5678: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5679: text interface only)
1.60 matthew 5680:
1.814 bisitz 5681: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5682: navigational links
1.317 albertel 5683:
1.338 albertel 5684: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5685:
1.1075.2.12 raeburn 5686: =item * $no_inline_link, if true and in remote mode, don't show the
5687: 'Switch To Inline Menu' link
5688:
1.460 albertel 5689: =item * $args, optional argument valid values are
5690: no_auto_mt_title -> prevents &mt()ing the title arg
1.1075.2.133 raeburn 5691: use_absolute -> for external resource or syllabus, this will
5692: contain https://<hostname> if server uses
5693: https (as per hosts.tab), but request is for http
5694: hostname -> hostname, from $r->hostname().
1.460 albertel 5695:
1.1075.2.15 raeburn 5696: =item * $advtoolsref, optional argument, ref to an array containing
5697: inlineremote items to be added in "Functions" menu below
5698: breadcrumbs.
5699:
1.112 bowersj2 5700: =back
5701:
1.60 matthew 5702: Returns: A uniform header for LON-CAPA web pages.
5703: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5704: If $bodyonly is undef or zero, an html string containing a <body> tag and
5705: other decorations will be returned.
5706:
5707: =cut
5708:
1.54 www 5709: sub bodytag {
1.831 bisitz 5710: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15 raeburn 5711: $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339 albertel 5712:
1.954 raeburn 5713: my $public;
5714: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5715: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5716: $public = 1;
5717: }
1.460 albertel 5718: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 5719: my $httphost = $args->{'use_absolute'};
1.1075.2.133 raeburn 5720: my $hostname = $args->{'hostname'};
1.339 albertel 5721:
1.183 matthew 5722: $function = &get_users_function() if (!$function);
1.339 albertel 5723: my $img = &designparm($function.'.img',$domain);
5724: my $font = &designparm($function.'.font',$domain);
5725: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5726:
1.803 bisitz 5727: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5728: 'bgcolor' => $pgbg,
1.339 albertel 5729: 'text' => $font,
5730: 'alink' => &designparm($function.'.alink',$domain),
5731: 'vlink' => &designparm($function.'.vlink',$domain),
5732: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5733: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5734:
1.63 www 5735: # role and realm
1.1075.2.68 raeburn 5736: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5737: if ($realm) {
5738: $realm = '/'.$realm;
5739: }
1.1075.2.159 raeburn 5740: if ($role eq 'ca') {
1.479 albertel 5741: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5742: $realm = &plainname($rname,$rdom);
1.378 raeburn 5743: }
1.55 www 5744: # realm
1.1075.2.158 raeburn 5745: my ($cid,$sec);
1.258 albertel 5746: if ($env{'request.course.id'}) {
1.1075.2.158 raeburn 5747: $cid = $env{'request.course.id'};
5748: if ($env{'request.course.sec'}) {
5749: $sec = $env{'request.course.sec'};
5750: }
5751: } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
5752: if (&Apache::lonnet::is_course($1,$2)) {
5753: $cid = $1.'_'.$2;
5754: $sec = $3;
5755: }
5756: }
5757: if ($cid) {
1.378 raeburn 5758: if ($env{'request.role'} !~ /^cr/) {
5759: $role = &Apache::lonnet::plaintext($role,&course_type());
1.1075.2.115 raeburn 5760: } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
1.1075.2.121 raeburn 5761: if ($env{'request.role.desc'}) {
5762: $role = $env{'request.role.desc'};
5763: } else {
5764: $role = &mt('Helpdesk[_1]',' '.$2);
5765: }
1.1075.2.115 raeburn 5766: } else {
5767: $role = (split(/\//,$role,4))[-1];
1.378 raeburn 5768: }
1.1075.2.158 raeburn 5769: if ($sec) {
5770: $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
1.898 raeburn 5771: }
1.1075.2.158 raeburn 5772: $realm = $env{'course.'.$cid.'.description'};
1.378 raeburn 5773: } else {
5774: $role = &Apache::lonnet::plaintext($role);
1.54 www 5775: }
1.433 albertel 5776:
1.359 albertel 5777: if (!$realm) { $realm=' '; }
1.330 albertel 5778:
1.438 albertel 5779: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5780:
1.101 www 5781: # construct main body tag
1.359 albertel 5782: my $bodytag = "<body $extra_body_attr>".
1.1075.2.100 raeburn 5783: &Apache::lontexconvert::init_math_support();
1.252 albertel 5784:
1.1075.2.38 raeburn 5785: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5786:
5787: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5788: return $bodytag;
1.1075.2.38 raeburn 5789: }
1.359 albertel 5790:
1.954 raeburn 5791: if ($public) {
1.433 albertel 5792: undef($role);
5793: }
1.1075.2.158 raeburn 5794:
1.762 bisitz 5795: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5796: #
5797: # Extra info if you are the DC
5798: my $dc_info = '';
1.1075.2.159 raeburn 5799: if (($env{'user.adv'}) && ($env{'request.course.id'}) &&
1.1075.2.158 raeburn 5800: (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
1.917 raeburn 5801: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5802: $dc_info =~ s/\s+$//;
1.359 albertel 5803: }
5804:
1.1075.2.108 raeburn 5805: $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'});
1.903 droeschl 5806:
1.1075.2.13 raeburn 5807: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5808:
1.1075.2.38 raeburn 5809:
5810:
1.1075.2.21 raeburn 5811: my $funclist;
5812: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.174 raeburn 5813: unless ($args->{'switchserver'}) {
5814: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
5815: Apache::lonmenu::serverform();
5816: my $forbodytag;
5817: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5818: $forcereg,$args->{'group'},
5819: $args->{'bread_crumbs'},
5820: $advtoolsref,'','',\$forbodytag);
5821: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5822: $funclist = $forbodytag;
5823: }
5824: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.1075.2.21 raeburn 5825: }
5826: } else {
1.903 droeschl 5827:
5828: # if ($env{'request.state'} eq 'construct') {
5829: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5830: # }
5831:
1.1075.2.172 raeburn 5832: my $need_endlcint;
5833: unless ($args->{'switchserver'}) {
5834: $bodytag .= Apache::lonhtmlcommon::scripttag(
5835: Apache::lonmenu::utilityfunctions($httphost), 'start');
5836: $need_endlcint = 1;
5837: }
1.359 albertel 5838:
1.1075.2.171 raeburn 5839: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} eq 'construct')) {
5840: unless ($env{'form.inhibitmenu'}) {
5841: $bodytag .= &inline_for_remote($public,$role,$realm,$dc_info,$no_inline_link);
5842: }
5843: } else {
5844: my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
1.1075.2.2 raeburn 5845:
1.1075.2.171 raeburn 5846: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
5847: if ($dc_info) {
5848: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5849: }
5850: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
5851: <em>$realm</em> $dc_info</div>|;
1.1075.2.172 raeburn 5852: if ($need_endlcint) {
5853: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5854: }
1.1075.2.171 raeburn 5855: return $bodytag;
1.1075.2.1 raeburn 5856: }
1.894 droeschl 5857:
1.1075.2.171 raeburn 5858: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
5859: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
5860: }
1.916 droeschl 5861:
1.1075.2.171 raeburn 5862: $bodytag .= $right;
1.852 droeschl 5863:
1.1075.2.171 raeburn 5864: if ($dc_info) {
5865: $dc_info = &dc_courseid_toggle($dc_info);
5866: }
5867: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.917 raeburn 5868: }
1.916 droeschl 5869:
1.1075.2.61 raeburn 5870: #if directed to not display the secondary menu, don't.
5871: if ($args->{'no_secondary_menu'}) {
1.1075.2.172 raeburn 5872: if ($need_endlcint) {
5873: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5874: }
1.1075.2.61 raeburn 5875: return $bodytag;
5876: }
1.903 droeschl 5877: #don't show menus for public users
1.954 raeburn 5878: if (!$public){
1.1075.2.171 raeburn 5879: unless (($env{'environment.remote'} eq 'on') &&
5880: ($env{'request.state'} eq 'construct')) {
5881: $bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'});
5882: }
1.903 droeschl 5883: $bodytag .= Apache::lonmenu::serverform();
1.1075.2.172 raeburn 5884: if ($need_endlcint) {
5885: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5886: }
1.920 raeburn 5887: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5888: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.1075.2.133 raeburn 5889: $args->{'bread_crumbs'},'','',$hostname);
1.1075.2.116 raeburn 5890: } elsif ($forcereg) {
1.1075.2.22 raeburn 5891: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
1.1075.2.116 raeburn 5892: $args->{'group'},
1.1075.2.161 raeburn 5893: $args->{'hide_buttons'},
5894: $hostname);
1.1075.2.15 raeburn 5895: } else {
1.1075.2.21 raeburn 5896: my $forbodytag;
5897: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5898: $forcereg,$args->{'group'},
5899: $args->{'bread_crumbs'},
1.1075.2.133 raeburn 5900: $advtoolsref,'',$hostname,
5901: \$forbodytag);
1.1075.2.21 raeburn 5902: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5903: $bodytag .= $forbodytag;
5904: }
1.920 raeburn 5905: }
1.1075.2.172 raeburn 5906: } else {
5907: # this is to separate menu from content when there's no secondary
1.903 droeschl 5908: # menu. Especially needed for public accessible ressources.
5909: $bodytag .= '<hr style="clear:both" />';
1.1075.2.172 raeburn 5910: if ($need_endlcint) {
5911: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5912: }
1.235 raeburn 5913: }
1.903 droeschl 5914:
1.235 raeburn 5915: return $bodytag;
1.1075.2.12 raeburn 5916: }
5917:
5918: #
5919: # Top frame rendering, Remote is up
5920: #
5921:
1.1075.2.173 raeburn 5922: my $linkattr;
5923: if ($args->{'links_disabled'}) {
5924: $linkattr = 'class="LCisDisabled" aria-disabled="true"';
5925: }
5926:
1.1075.2.60 raeburn 5927: my $help=($no_inline_link?''
1.1075.2.173 raeburn 5928: :&top_nav_help('Help',$linkattr));
1.1075.2.60 raeburn 5929:
1.1075.2.12 raeburn 5930: # Explicit link to get inline menu
5931: my $menu= ($no_inline_link?''
1.1075.2.173 raeburn 5932: :'<a href="/adm/remote?action=collapse" $linkattr target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
1.1075.2.12 raeburn 5933:
5934: if ($dc_info) {
5935: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5936: }
5937:
1.1075.2.38 raeburn 5938: my $name = &plainname($env{'user.name'},$env{'user.domain'});
5939: unless ($public) {
1.1075.2.173 raeburn 5940: my $class = 'LC_menubuttons_link';
5941: if ($args->{'links_disabled'}) {
5942: $class .= ' LCisDisabled';
5943: }
1.1075.2.38 raeburn 5944: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
1.1075.2.173 raeburn 5945: undef,$class);
1.1075.2.38 raeburn 5946: }
5947:
1.1075.2.12 raeburn 5948: unless ($env{'form.inhibitmenu'}) {
1.1075.2.171 raeburn 5949: $bodytag .= &inline_for_remote($public,$role,$realm,$dc_info,$no_inline_link);
1.1075.2.12 raeburn 5950: }
1.1075.2.21 raeburn 5951: return $bodytag."\n".$funclist;
1.182 matthew 5952: }
5953:
1.1075.2.171 raeburn 5954: sub inline_for_remote {
5955: my ($public,$role,$realm,$dc_info,$no_inline_link) = @_;
5956: my $help=($no_inline_link?''
5957: :&Apache::loncommon::top_nav_help('Help'));
5958:
5959: # Explicit link to get inline menu
5960: my $menu= ($no_inline_link?''
5961: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
5962:
5963: if ($dc_info) {
5964: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5965: }
5966:
5967: my $name = &plainname($env{'user.name'},$env{'user.domain'});
5968: unless ($public) {
5969: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5970: undef,'LC_menubuttons_link');
5971: }
5972:
5973: return qq|<div id="LC_nav_bar">$name $role</div>
5974: <ol class="LC_primary_menu LC_floatright LC_right">
5975: <li>$help</li>
5976: <li>$menu</li>
5977: </ol><div id="LC_realm"> $realm $dc_info</div>|;
5978: }
5979:
1.917 raeburn 5980: sub dc_courseid_toggle {
5981: my ($dc_info) = @_;
1.980 raeburn 5982: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5983: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5984: &mt('(More ...)').'</a></span>'.
5985: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5986: }
5987:
1.330 albertel 5988: sub make_attr_string {
5989: my ($register,$attr_ref) = @_;
5990:
5991: if ($attr_ref && !ref($attr_ref)) {
5992: die("addentries Must be a hash ref ".
5993: join(':',caller(1))." ".
5994: join(':',caller(0))." ");
5995: }
5996:
5997: if ($register) {
1.339 albertel 5998: my ($on_load,$on_unload);
5999: foreach my $key (keys(%{$attr_ref})) {
6000: if (lc($key) eq 'onload') {
6001: $on_load.=$attr_ref->{$key}.';';
6002: delete($attr_ref->{$key});
6003:
6004: } elsif (lc($key) eq 'onunload') {
6005: $on_unload.=$attr_ref->{$key}.';';
6006: delete($attr_ref->{$key});
6007: }
6008: }
1.1075.2.12 raeburn 6009: if ($env{'environment.remote'} eq 'on') {
6010: $attr_ref->{'onload'} =
6011: &Apache::lonmenu::loadevents(). $on_load;
6012: $attr_ref->{'onunload'}=
6013: &Apache::lonmenu::unloadevents().$on_unload;
6014: } else {
6015: $attr_ref->{'onload'} = $on_load;
6016: $attr_ref->{'onunload'}= $on_unload;
6017: }
1.330 albertel 6018: }
1.339 albertel 6019:
1.330 albertel 6020: my $attr_string;
1.1075.2.56 raeburn 6021: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 6022: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
6023: }
6024: return $attr_string;
6025: }
6026:
6027:
1.182 matthew 6028: ###############################################
1.251 albertel 6029: ###############################################
6030:
6031: =pod
6032:
6033: =item * &endbodytag()
6034:
6035: Returns a uniform footer for LON-CAPA web pages.
6036:
1.635 raeburn 6037: Inputs: 1 - optional reference to an args hash
6038: If in the hash, key for noredirectlink has a value which evaluates to true,
6039: a 'Continue' link is not displayed if the page contains an
6040: internal redirect in the <head></head> section,
6041: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 6042:
6043: =cut
6044:
6045: sub endbodytag {
1.635 raeburn 6046: my ($args) = @_;
1.1075.2.6 raeburn 6047: my $endbodytag;
6048: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
6049: $endbodytag='</body>';
6050: }
1.315 albertel 6051: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 6052: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
6053: $endbodytag=
6054: "<br /><a href=\"$env{'internal.head.redirect'}\">".
6055: &mt('Continue').'</a>'.
6056: $endbodytag;
6057: }
1.315 albertel 6058: }
1.1075.2.165 raeburn 6059: if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
6060: $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
6061: }
1.251 albertel 6062: return $endbodytag;
6063: }
6064:
1.352 albertel 6065: =pod
6066:
6067: =item * &standard_css()
6068:
6069: Returns a style sheet
6070:
6071: Inputs: (all optional)
6072: domain -> force to color decorate a page for a specific
6073: domain
6074: function -> force usage of a specific rolish color scheme
6075: bgcolor -> override the default page bgcolor
6076:
6077: =cut
6078:
1.343 albertel 6079: sub standard_css {
1.345 albertel 6080: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 6081: $function = &get_users_function() if (!$function);
6082: my $img = &designparm($function.'.img', $domain);
6083: my $tabbg = &designparm($function.'.tabbg', $domain);
6084: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 6085: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 6086: #second colour for later usage
1.345 albertel 6087: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 6088: my $pgbg_or_bgcolor =
6089: $bgcolor ||
1.352 albertel 6090: &designparm($function.'.pgbg', $domain);
1.382 albertel 6091: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 6092: my $alink = &designparm($function.'.alink', $domain);
6093: my $vlink = &designparm($function.'.vlink', $domain);
6094: my $link = &designparm($function.'.link', $domain);
6095:
1.602 albertel 6096: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 6097: my $mono = 'monospace';
1.850 bisitz 6098: my $data_table_head = $sidebg;
6099: my $data_table_light = '#FAFAFA';
1.1060 bisitz 6100: my $data_table_dark = '#E0E0E0';
1.470 banghart 6101: my $data_table_darker = '#CCCCCC';
1.349 albertel 6102: my $data_table_highlight = '#FFFF00';
1.352 albertel 6103: my $mail_new = '#FFBB77';
6104: my $mail_new_hover = '#DD9955';
6105: my $mail_read = '#BBBB77';
6106: my $mail_read_hover = '#999944';
6107: my $mail_replied = '#AAAA88';
6108: my $mail_replied_hover = '#888855';
6109: my $mail_other = '#99BBBB';
6110: my $mail_other_hover = '#669999';
1.391 albertel 6111: my $table_header = '#DDDDDD';
1.489 raeburn 6112: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 6113: my $lg_border_color = '#C8C8C8';
1.952 onken 6114: my $button_hover = '#BF2317';
1.392 albertel 6115:
1.608 albertel 6116: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 6117: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
6118: : '0 3px 0 4px';
1.448 albertel 6119:
1.523 albertel 6120:
1.343 albertel 6121: return <<END;
1.947 droeschl 6122:
6123: /* needed for iframe to allow 100% height in FF */
6124: body, html {
6125: margin: 0;
6126: padding: 0 0.5%;
6127: height: 99%; /* to avoid scrollbars */
6128: }
6129:
1.795 www 6130: body {
1.911 bisitz 6131: font-family: $sans;
6132: line-height:130%;
6133: font-size:0.83em;
6134: color:$font;
1.1075.2.176! raeburn 6135: background-color: $pgbg_or_bgcolor;
1.795 www 6136: }
6137:
1.959 onken 6138: a:focus,
6139: a:focus img {
1.795 www 6140: color: red;
6141: }
1.698 harmsja 6142:
1.911 bisitz 6143: form, .inline {
6144: display: inline;
1.795 www 6145: }
1.721 harmsja 6146:
1.795 www 6147: .LC_right {
1.911 bisitz 6148: text-align:right;
1.795 www 6149: }
6150:
6151: .LC_middle {
1.911 bisitz 6152: vertical-align:middle;
1.795 www 6153: }
1.721 harmsja 6154:
1.1075.2.38 raeburn 6155: .LC_floatleft {
6156: float: left;
6157: }
6158:
6159: .LC_floatright {
6160: float: right;
6161: }
6162:
1.911 bisitz 6163: .LC_400Box {
6164: width:400px;
6165: }
1.721 harmsja 6166:
1.947 droeschl 6167: .LC_iframecontainer {
6168: width: 98%;
6169: margin: 0;
6170: position: fixed;
6171: top: 8.5em;
6172: bottom: 0;
6173: }
6174:
6175: .LC_iframecontainer iframe{
6176: border: none;
6177: width: 100%;
6178: height: 100%;
6179: }
6180:
1.778 bisitz 6181: .LC_filename {
6182: font-family: $mono;
6183: white-space:pre;
1.921 bisitz 6184: font-size: 120%;
1.778 bisitz 6185: }
6186:
6187: .LC_fileicon {
6188: border: none;
6189: height: 1.3em;
6190: vertical-align: text-bottom;
6191: margin-right: 0.3em;
6192: text-decoration:none;
6193: }
6194:
1.1008 www 6195: .LC_setting {
6196: text-decoration:underline;
6197: }
6198:
1.350 albertel 6199: .LC_error {
6200: color: red;
6201: }
1.795 www 6202:
1.1075.2.15 raeburn 6203: .LC_warning {
6204: color: darkorange;
6205: }
6206:
1.457 albertel 6207: .LC_diff_removed {
1.733 bisitz 6208: color: red;
1.394 albertel 6209: }
1.532 albertel 6210:
6211: .LC_info,
1.457 albertel 6212: .LC_success,
6213: .LC_diff_added {
1.350 albertel 6214: color: green;
6215: }
1.795 www 6216:
1.802 bisitz 6217: div.LC_confirm_box {
6218: background-color: #FAFAFA;
6219: border: 1px solid $lg_border_color;
6220: margin-right: 0;
6221: padding: 5px;
6222: }
6223:
6224: div.LC_confirm_box .LC_error img,
6225: div.LC_confirm_box .LC_success img {
6226: vertical-align: middle;
6227: }
6228:
1.1075.2.108 raeburn 6229: .LC_maxwidth {
6230: max-width: 100%;
6231: height: auto;
6232: }
6233:
6234: .LC_textsize_mobile {
6235: \@media only screen and (max-device-width: 480px) {
6236: -webkit-text-size-adjust:100%; -moz-text-size-adjust:100%; -ms-text-size-adjust:100%;
6237: }
6238: }
6239:
1.440 albertel 6240: .LC_icon {
1.771 droeschl 6241: border: none;
1.790 droeschl 6242: vertical-align: middle;
1.771 droeschl 6243: }
6244:
1.543 albertel 6245: .LC_docs_spacer {
6246: width: 25px;
6247: height: 1px;
1.771 droeschl 6248: border: none;
1.543 albertel 6249: }
1.346 albertel 6250:
1.532 albertel 6251: .LC_internal_info {
1.735 bisitz 6252: color: #999999;
1.532 albertel 6253: }
6254:
1.794 www 6255: .LC_discussion {
1.1050 www 6256: background: $data_table_dark;
1.911 bisitz 6257: border: 1px solid black;
6258: margin: 2px;
1.794 www 6259: }
6260:
6261: .LC_disc_action_left {
1.1050 www 6262: background: $sidebg;
1.911 bisitz 6263: text-align: left;
1.1050 www 6264: padding: 4px;
6265: margin: 2px;
1.794 www 6266: }
6267:
6268: .LC_disc_action_right {
1.1050 www 6269: background: $sidebg;
1.911 bisitz 6270: text-align: right;
1.1050 www 6271: padding: 4px;
6272: margin: 2px;
1.794 www 6273: }
6274:
6275: .LC_disc_new_item {
1.911 bisitz 6276: background: white;
6277: border: 2px solid red;
1.1050 www 6278: margin: 4px;
6279: padding: 4px;
1.794 www 6280: }
6281:
6282: .LC_disc_old_item {
1.911 bisitz 6283: background: white;
1.1050 www 6284: margin: 4px;
6285: padding: 4px;
1.794 www 6286: }
6287:
1.458 albertel 6288: table.LC_pastsubmission {
6289: border: 1px solid black;
6290: margin: 2px;
6291: }
6292:
1.924 bisitz 6293: table#LC_menubuttons {
1.345 albertel 6294: width: 100%;
6295: background: $pgbg;
1.392 albertel 6296: border: 2px;
1.402 albertel 6297: border-collapse: separate;
1.803 bisitz 6298: padding: 0;
1.345 albertel 6299: }
1.392 albertel 6300:
1.801 tempelho 6301: table#LC_title_bar a {
6302: color: $fontmenu;
6303: }
1.836 bisitz 6304:
1.807 droeschl 6305: table#LC_title_bar {
1.819 tempelho 6306: clear: both;
1.836 bisitz 6307: display: none;
1.807 droeschl 6308: }
6309:
1.795 www 6310: table#LC_title_bar,
1.933 droeschl 6311: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 6312: table#LC_title_bar.LC_with_remote {
1.359 albertel 6313: width: 100%;
1.392 albertel 6314: border-color: $pgbg;
6315: border-style: solid;
6316: border-width: $border;
1.379 albertel 6317: background: $pgbg;
1.801 tempelho 6318: color: $fontmenu;
1.392 albertel 6319: border-collapse: collapse;
1.803 bisitz 6320: padding: 0;
1.819 tempelho 6321: margin: 0;
1.359 albertel 6322: }
1.795 www 6323:
1.933 droeschl 6324: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 6325: margin: 0;
6326: padding: 0;
1.933 droeschl 6327: position: relative;
6328: list-style: none;
1.913 droeschl 6329: }
1.933 droeschl 6330: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 6331: display: inline;
6332: }
1.933 droeschl 6333:
6334: .LC_breadcrumb_tools_navigation {
1.913 droeschl 6335: padding: 0;
1.933 droeschl 6336: margin: 0;
6337: float: left;
1.913 droeschl 6338: }
1.933 droeschl 6339: .LC_breadcrumb_tools_tools {
6340: padding: 0;
6341: margin: 0;
1.913 droeschl 6342: float: right;
6343: }
6344:
1.359 albertel 6345: table#LC_title_bar td {
6346: background: $tabbg;
6347: }
1.795 www 6348:
1.911 bisitz 6349: table#LC_menubuttons img {
1.803 bisitz 6350: border: none;
1.346 albertel 6351: }
1.795 www 6352:
1.842 droeschl 6353: .LC_breadcrumbs_component {
1.911 bisitz 6354: float: right;
6355: margin: 0 1em;
1.357 albertel 6356: }
1.842 droeschl 6357: .LC_breadcrumbs_component img {
1.911 bisitz 6358: vertical-align: middle;
1.777 tempelho 6359: }
1.795 www 6360:
1.1075.2.108 raeburn 6361: .LC_breadcrumbs_hoverable {
6362: background: $sidebg;
6363: }
6364:
1.383 albertel 6365: td.LC_table_cell_checkbox {
6366: text-align: center;
6367: }
1.795 www 6368:
6369: .LC_fontsize_small {
1.911 bisitz 6370: font-size: 70%;
1.705 tempelho 6371: }
6372:
1.844 bisitz 6373: #LC_breadcrumbs {
1.911 bisitz 6374: clear:both;
6375: background: $sidebg;
6376: border-bottom: 1px solid $lg_border_color;
6377: line-height: 2.5em;
1.933 droeschl 6378: overflow: hidden;
1.911 bisitz 6379: margin: 0;
6380: padding: 0;
1.995 raeburn 6381: text-align: left;
1.819 tempelho 6382: }
1.862 bisitz 6383:
1.1075.2.16 raeburn 6384: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 6385: clear:both;
6386: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 6387: border: 1px solid $sidebg;
1.1075.2.16 raeburn 6388: margin: 0 0 10px 0;
1.966 bisitz 6389: padding: 3px;
1.995 raeburn 6390: text-align: left;
1.822 bisitz 6391: }
6392:
1.795 www 6393: .LC_fontsize_medium {
1.911 bisitz 6394: font-size: 85%;
1.705 tempelho 6395: }
6396:
1.795 www 6397: .LC_fontsize_large {
1.911 bisitz 6398: font-size: 120%;
1.705 tempelho 6399: }
6400:
1.346 albertel 6401: .LC_menubuttons_inline_text {
6402: color: $font;
1.698 harmsja 6403: font-size: 90%;
1.701 harmsja 6404: padding-left:3px;
1.346 albertel 6405: }
6406:
1.934 droeschl 6407: .LC_menubuttons_inline_text img{
6408: vertical-align: middle;
6409: }
6410:
1.1051 www 6411: li.LC_menubuttons_inline_text img {
1.951 onken 6412: cursor:pointer;
1.1002 droeschl 6413: text-decoration: none;
1.951 onken 6414: }
6415:
1.526 www 6416: .LC_menubuttons_link {
6417: text-decoration: none;
6418: }
1.795 www 6419:
1.522 albertel 6420: .LC_menubuttons_category {
1.521 www 6421: color: $font;
1.526 www 6422: background: $pgbg;
1.521 www 6423: font-size: larger;
6424: font-weight: bold;
6425: }
6426:
1.346 albertel 6427: td.LC_menubuttons_text {
1.911 bisitz 6428: color: $font;
1.346 albertel 6429: }
1.706 harmsja 6430:
1.346 albertel 6431: .LC_current_location {
6432: background: $tabbg;
6433: }
1.795 www 6434:
1.1075.2.134 raeburn 6435: td.LC_zero_height {
6436: line-height: 0;
6437: cellpadding: 0;
6438: }
6439:
1.938 bisitz 6440: table.LC_data_table {
1.347 albertel 6441: border: 1px solid #000000;
1.402 albertel 6442: border-collapse: separate;
1.426 albertel 6443: border-spacing: 1px;
1.610 albertel 6444: background: $pgbg;
1.347 albertel 6445: }
1.795 www 6446:
1.422 albertel 6447: .LC_data_table_dense {
6448: font-size: small;
6449: }
1.795 www 6450:
1.507 raeburn 6451: table.LC_nested_outer {
6452: border: 1px solid #000000;
1.589 raeburn 6453: border-collapse: collapse;
1.803 bisitz 6454: border-spacing: 0;
1.507 raeburn 6455: width: 100%;
6456: }
1.795 www 6457:
1.879 raeburn 6458: table.LC_innerpickbox,
1.507 raeburn 6459: table.LC_nested {
1.803 bisitz 6460: border: none;
1.589 raeburn 6461: border-collapse: collapse;
1.803 bisitz 6462: border-spacing: 0;
1.507 raeburn 6463: width: 100%;
6464: }
1.795 www 6465:
1.911 bisitz 6466: table.LC_data_table tr th,
6467: table.LC_calendar tr th,
1.879 raeburn 6468: table.LC_prior_tries tr th,
6469: table.LC_innerpickbox tr th {
1.349 albertel 6470: font-weight: bold;
6471: background-color: $data_table_head;
1.801 tempelho 6472: color:$fontmenu;
1.701 harmsja 6473: font-size:90%;
1.347 albertel 6474: }
1.795 www 6475:
1.879 raeburn 6476: table.LC_innerpickbox tr th,
6477: table.LC_innerpickbox tr td {
6478: vertical-align: top;
6479: }
6480:
1.711 raeburn 6481: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 6482: background-color: #CCCCCC;
1.711 raeburn 6483: font-weight: bold;
6484: text-align: left;
6485: }
1.795 www 6486:
1.912 bisitz 6487: table.LC_data_table tr.LC_odd_row > td {
6488: background-color: $data_table_light;
6489: padding: 2px;
6490: vertical-align: top;
6491: }
6492:
1.809 bisitz 6493: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 6494: background-color: $data_table_light;
1.912 bisitz 6495: vertical-align: top;
6496: }
6497:
6498: table.LC_data_table tr.LC_even_row > td {
6499: background-color: $data_table_dark;
1.425 albertel 6500: padding: 2px;
1.900 bisitz 6501: vertical-align: top;
1.347 albertel 6502: }
1.795 www 6503:
1.809 bisitz 6504: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 6505: background-color: $data_table_dark;
1.900 bisitz 6506: vertical-align: top;
1.347 albertel 6507: }
1.795 www 6508:
1.425 albertel 6509: table.LC_data_table tr.LC_data_table_highlight td {
6510: background-color: $data_table_darker;
6511: }
1.795 www 6512:
1.639 raeburn 6513: table.LC_data_table tr td.LC_leftcol_header {
6514: background-color: $data_table_head;
6515: font-weight: bold;
6516: }
1.795 www 6517:
1.451 albertel 6518: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 6519: table.LC_nested tr.LC_empty_row td {
1.421 albertel 6520: font-weight: bold;
6521: font-style: italic;
6522: text-align: center;
6523: padding: 8px;
1.347 albertel 6524: }
1.795 www 6525:
1.1075.2.30 raeburn 6526: table.LC_data_table tr.LC_empty_row td,
6527: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 6528: background-color: $sidebg;
6529: }
6530:
6531: table.LC_nested tr.LC_empty_row td {
6532: background-color: #FFFFFF;
6533: }
6534:
1.890 droeschl 6535: table.LC_caption {
6536: }
6537:
1.507 raeburn 6538: table.LC_nested tr.LC_empty_row td {
1.465 albertel 6539: padding: 4ex
6540: }
1.795 www 6541:
1.507 raeburn 6542: table.LC_nested_outer tr th {
6543: font-weight: bold;
1.801 tempelho 6544: color:$fontmenu;
1.507 raeburn 6545: background-color: $data_table_head;
1.701 harmsja 6546: font-size: small;
1.507 raeburn 6547: border-bottom: 1px solid #000000;
6548: }
1.795 www 6549:
1.507 raeburn 6550: table.LC_nested_outer tr td.LC_subheader {
6551: background-color: $data_table_head;
6552: font-weight: bold;
6553: font-size: small;
6554: border-bottom: 1px solid #000000;
6555: text-align: right;
1.451 albertel 6556: }
1.795 www 6557:
1.507 raeburn 6558: table.LC_nested tr.LC_info_row td {
1.735 bisitz 6559: background-color: #CCCCCC;
1.451 albertel 6560: font-weight: bold;
6561: font-size: small;
1.507 raeburn 6562: text-align: center;
6563: }
1.795 www 6564:
1.589 raeburn 6565: table.LC_nested tr.LC_info_row td.LC_left_item,
6566: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 6567: text-align: left;
1.451 albertel 6568: }
1.795 www 6569:
1.507 raeburn 6570: table.LC_nested td {
1.735 bisitz 6571: background-color: #FFFFFF;
1.451 albertel 6572: font-size: small;
1.507 raeburn 6573: }
1.795 www 6574:
1.507 raeburn 6575: table.LC_nested_outer tr th.LC_right_item,
6576: table.LC_nested tr.LC_info_row td.LC_right_item,
6577: table.LC_nested tr.LC_odd_row td.LC_right_item,
6578: table.LC_nested tr td.LC_right_item {
1.451 albertel 6579: text-align: right;
6580: }
6581:
1.507 raeburn 6582: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 6583: background-color: #EEEEEE;
1.451 albertel 6584: }
6585:
1.473 raeburn 6586: table.LC_createuser {
6587: }
6588:
6589: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 6590: font-size: small;
1.473 raeburn 6591: }
6592:
6593: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 6594: background-color: #CCCCCC;
1.473 raeburn 6595: font-weight: bold;
6596: text-align: center;
6597: }
6598:
1.349 albertel 6599: table.LC_calendar {
6600: border: 1px solid #000000;
6601: border-collapse: collapse;
1.917 raeburn 6602: width: 98%;
1.349 albertel 6603: }
1.795 www 6604:
1.349 albertel 6605: table.LC_calendar_pickdate {
6606: font-size: xx-small;
6607: }
1.795 www 6608:
1.349 albertel 6609: table.LC_calendar tr td {
6610: border: 1px solid #000000;
6611: vertical-align: top;
1.917 raeburn 6612: width: 14%;
1.349 albertel 6613: }
1.795 www 6614:
1.349 albertel 6615: table.LC_calendar tr td.LC_calendar_day_empty {
6616: background-color: $data_table_dark;
6617: }
1.795 www 6618:
1.779 bisitz 6619: table.LC_calendar tr td.LC_calendar_day_current {
6620: background-color: $data_table_highlight;
1.777 tempelho 6621: }
1.795 www 6622:
1.938 bisitz 6623: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 6624: background-color: $mail_new;
6625: }
1.795 www 6626:
1.938 bisitz 6627: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 6628: background-color: $mail_new_hover;
6629: }
1.795 www 6630:
1.938 bisitz 6631: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 6632: background-color: $mail_read;
6633: }
1.795 www 6634:
1.938 bisitz 6635: /*
6636: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 6637: background-color: $mail_read_hover;
6638: }
1.938 bisitz 6639: */
1.795 www 6640:
1.938 bisitz 6641: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 6642: background-color: $mail_replied;
6643: }
1.795 www 6644:
1.938 bisitz 6645: /*
6646: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 6647: background-color: $mail_replied_hover;
6648: }
1.938 bisitz 6649: */
1.795 www 6650:
1.938 bisitz 6651: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6652: background-color: $mail_other;
6653: }
1.795 www 6654:
1.938 bisitz 6655: /*
6656: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6657: background-color: $mail_other_hover;
6658: }
1.938 bisitz 6659: */
1.494 raeburn 6660:
1.777 tempelho 6661: table.LC_data_table tr > td.LC_browser_file,
6662: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6663: background: #AAEE77;
1.389 albertel 6664: }
1.795 www 6665:
1.777 tempelho 6666: table.LC_data_table tr > td.LC_browser_file_locked,
6667: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6668: background: #FFAA99;
1.387 albertel 6669: }
1.795 www 6670:
1.777 tempelho 6671: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6672: background: #888888;
1.779 bisitz 6673: }
1.795 www 6674:
1.777 tempelho 6675: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6676: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6677: background: #F8F866;
1.777 tempelho 6678: }
1.795 www 6679:
1.696 bisitz 6680: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6681: background: #E0E8FF;
1.387 albertel 6682: }
1.696 bisitz 6683:
1.707 bisitz 6684: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6685: /* background: #77FF77; */
1.707 bisitz 6686: }
1.795 www 6687:
1.707 bisitz 6688: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6689: border-right: 8px solid #FFFF77;
1.707 bisitz 6690: }
1.795 www 6691:
1.707 bisitz 6692: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6693: border-right: 8px solid #FFAA77;
1.707 bisitz 6694: }
1.795 www 6695:
1.707 bisitz 6696: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6697: border-right: 8px solid #FF7777;
1.707 bisitz 6698: }
1.795 www 6699:
1.707 bisitz 6700: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6701: border-right: 8px solid #AAFF77;
1.707 bisitz 6702: }
1.795 www 6703:
1.707 bisitz 6704: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6705: border-right: 8px solid #11CC55;
1.707 bisitz 6706: }
6707:
1.388 albertel 6708: span.LC_current_location {
1.701 harmsja 6709: font-size:larger;
1.388 albertel 6710: background: $pgbg;
6711: }
1.387 albertel 6712:
1.1029 www 6713: span.LC_current_nav_location {
6714: font-weight:bold;
6715: background: $sidebg;
6716: }
6717:
1.395 albertel 6718: span.LC_parm_menu_item {
6719: font-size: larger;
6720: }
1.795 www 6721:
1.395 albertel 6722: span.LC_parm_scope_all {
6723: color: red;
6724: }
1.795 www 6725:
1.395 albertel 6726: span.LC_parm_scope_folder {
6727: color: green;
6728: }
1.795 www 6729:
1.395 albertel 6730: span.LC_parm_scope_resource {
6731: color: orange;
6732: }
1.795 www 6733:
1.395 albertel 6734: span.LC_parm_part {
6735: color: blue;
6736: }
1.795 www 6737:
1.911 bisitz 6738: span.LC_parm_folder,
6739: span.LC_parm_symb {
1.395 albertel 6740: font-size: x-small;
6741: font-family: $mono;
6742: color: #AAAAAA;
6743: }
6744:
1.977 bisitz 6745: ul.LC_parm_parmlist li {
6746: display: inline-block;
6747: padding: 0.3em 0.8em;
6748: vertical-align: top;
6749: width: 150px;
6750: border-top:1px solid $lg_border_color;
6751: }
6752:
1.795 www 6753: td.LC_parm_overview_level_menu,
6754: td.LC_parm_overview_map_menu,
6755: td.LC_parm_overview_parm_selectors,
6756: td.LC_parm_overview_restrictions {
1.396 albertel 6757: border: 1px solid black;
6758: border-collapse: collapse;
6759: }
1.795 www 6760:
1.396 albertel 6761: table.LC_parm_overview_restrictions td {
6762: border-width: 1px 4px 1px 4px;
6763: border-style: solid;
6764: border-color: $pgbg;
6765: text-align: center;
6766: }
1.795 www 6767:
1.396 albertel 6768: table.LC_parm_overview_restrictions th {
6769: background: $tabbg;
6770: border-width: 1px 4px 1px 4px;
6771: border-style: solid;
6772: border-color: $pgbg;
6773: }
1.795 www 6774:
1.398 albertel 6775: table#LC_helpmenu {
1.803 bisitz 6776: border: none;
1.398 albertel 6777: height: 55px;
1.803 bisitz 6778: border-spacing: 0;
1.398 albertel 6779: }
6780:
6781: table#LC_helpmenu fieldset legend {
6782: font-size: larger;
6783: }
1.795 www 6784:
1.397 albertel 6785: table#LC_helpmenu_links {
6786: width: 100%;
6787: border: 1px solid black;
6788: background: $pgbg;
1.803 bisitz 6789: padding: 0;
1.397 albertel 6790: border-spacing: 1px;
6791: }
1.795 www 6792:
1.397 albertel 6793: table#LC_helpmenu_links tr td {
6794: padding: 1px;
6795: background: $tabbg;
1.399 albertel 6796: text-align: center;
6797: font-weight: bold;
1.397 albertel 6798: }
1.396 albertel 6799:
1.795 www 6800: table#LC_helpmenu_links a:link,
6801: table#LC_helpmenu_links a:visited,
1.397 albertel 6802: table#LC_helpmenu_links a:active {
6803: text-decoration: none;
6804: color: $font;
6805: }
1.795 www 6806:
1.397 albertel 6807: table#LC_helpmenu_links a:hover {
6808: text-decoration: underline;
6809: color: $vlink;
6810: }
1.396 albertel 6811:
1.417 albertel 6812: .LC_chrt_popup_exists {
6813: border: 1px solid #339933;
6814: margin: -1px;
6815: }
1.795 www 6816:
1.417 albertel 6817: .LC_chrt_popup_up {
6818: border: 1px solid yellow;
6819: margin: -1px;
6820: }
1.795 www 6821:
1.417 albertel 6822: .LC_chrt_popup {
6823: border: 1px solid #8888FF;
6824: background: #CCCCFF;
6825: }
1.795 www 6826:
1.421 albertel 6827: table.LC_pick_box {
6828: border-collapse: separate;
6829: background: white;
6830: border: 1px solid black;
6831: border-spacing: 1px;
6832: }
1.795 www 6833:
1.421 albertel 6834: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6835: background: $sidebg;
1.421 albertel 6836: font-weight: bold;
1.900 bisitz 6837: text-align: left;
1.740 bisitz 6838: vertical-align: top;
1.421 albertel 6839: width: 184px;
6840: padding: 8px;
6841: }
1.795 www 6842:
1.579 raeburn 6843: table.LC_pick_box td.LC_pick_box_value {
6844: text-align: left;
6845: padding: 8px;
6846: }
1.795 www 6847:
1.579 raeburn 6848: table.LC_pick_box td.LC_pick_box_select {
6849: text-align: left;
6850: padding: 8px;
6851: }
1.795 www 6852:
1.424 albertel 6853: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6854: padding: 0;
1.421 albertel 6855: height: 1px;
6856: background: black;
6857: }
1.795 www 6858:
1.421 albertel 6859: table.LC_pick_box td.LC_pick_box_submit {
6860: text-align: right;
6861: }
1.795 www 6862:
1.579 raeburn 6863: table.LC_pick_box td.LC_evenrow_value {
6864: text-align: left;
6865: padding: 8px;
6866: background-color: $data_table_light;
6867: }
1.795 www 6868:
1.579 raeburn 6869: table.LC_pick_box td.LC_oddrow_value {
6870: text-align: left;
6871: padding: 8px;
6872: background-color: $data_table_light;
6873: }
1.795 www 6874:
1.579 raeburn 6875: span.LC_helpform_receipt_cat {
6876: font-weight: bold;
6877: }
1.795 www 6878:
1.424 albertel 6879: table.LC_group_priv_box {
6880: background: white;
6881: border: 1px solid black;
6882: border-spacing: 1px;
6883: }
1.795 www 6884:
1.424 albertel 6885: table.LC_group_priv_box td.LC_pick_box_title {
6886: background: $tabbg;
6887: font-weight: bold;
6888: text-align: right;
6889: width: 184px;
6890: }
1.795 www 6891:
1.424 albertel 6892: table.LC_group_priv_box td.LC_groups_fixed {
6893: background: $data_table_light;
6894: text-align: center;
6895: }
1.795 www 6896:
1.424 albertel 6897: table.LC_group_priv_box td.LC_groups_optional {
6898: background: $data_table_dark;
6899: text-align: center;
6900: }
1.795 www 6901:
1.424 albertel 6902: table.LC_group_priv_box td.LC_groups_functionality {
6903: background: $data_table_darker;
6904: text-align: center;
6905: font-weight: bold;
6906: }
1.795 www 6907:
1.424 albertel 6908: table.LC_group_priv td {
6909: text-align: left;
1.803 bisitz 6910: padding: 0;
1.424 albertel 6911: }
6912:
6913: .LC_navbuttons {
6914: margin: 2ex 0ex 2ex 0ex;
6915: }
1.795 www 6916:
1.423 albertel 6917: .LC_topic_bar {
6918: font-weight: bold;
6919: background: $tabbg;
1.918 wenzelju 6920: margin: 1em 0em 1em 2em;
1.805 bisitz 6921: padding: 3px;
1.918 wenzelju 6922: font-size: 1.2em;
1.423 albertel 6923: }
1.795 www 6924:
1.423 albertel 6925: .LC_topic_bar span {
1.918 wenzelju 6926: left: 0.5em;
6927: position: absolute;
1.423 albertel 6928: vertical-align: middle;
1.918 wenzelju 6929: font-size: 1.2em;
1.423 albertel 6930: }
1.795 www 6931:
1.423 albertel 6932: table.LC_course_group_status {
6933: margin: 20px;
6934: }
1.795 www 6935:
1.423 albertel 6936: table.LC_status_selector td {
6937: vertical-align: top;
6938: text-align: center;
1.424 albertel 6939: padding: 4px;
6940: }
1.795 www 6941:
1.599 albertel 6942: div.LC_feedback_link {
1.616 albertel 6943: clear: both;
1.829 kalberla 6944: background: $sidebg;
1.779 bisitz 6945: width: 100%;
1.829 kalberla 6946: padding-bottom: 10px;
6947: border: 1px $tabbg solid;
1.833 kalberla 6948: height: 22px;
6949: line-height: 22px;
6950: padding-top: 5px;
6951: }
6952:
6953: div.LC_feedback_link img {
6954: height: 22px;
1.867 kalberla 6955: vertical-align:middle;
1.829 kalberla 6956: }
6957:
1.911 bisitz 6958: div.LC_feedback_link a {
1.829 kalberla 6959: text-decoration: none;
1.489 raeburn 6960: }
1.795 www 6961:
1.867 kalberla 6962: div.LC_comblock {
1.911 bisitz 6963: display:inline;
1.867 kalberla 6964: color:$font;
6965: font-size:90%;
6966: }
6967:
6968: div.LC_feedback_link div.LC_comblock {
6969: padding-left:5px;
6970: }
6971:
6972: div.LC_feedback_link div.LC_comblock a {
6973: color:$font;
6974: }
6975:
1.489 raeburn 6976: span.LC_feedback_link {
1.858 bisitz 6977: /* background: $feedback_link_bg; */
1.599 albertel 6978: font-size: larger;
6979: }
1.795 www 6980:
1.599 albertel 6981: span.LC_message_link {
1.858 bisitz 6982: /* background: $feedback_link_bg; */
1.599 albertel 6983: font-size: larger;
6984: position: absolute;
6985: right: 1em;
1.489 raeburn 6986: }
1.421 albertel 6987:
1.515 albertel 6988: table.LC_prior_tries {
1.524 albertel 6989: border: 1px solid #000000;
6990: border-collapse: separate;
6991: border-spacing: 1px;
1.515 albertel 6992: }
1.523 albertel 6993:
1.515 albertel 6994: table.LC_prior_tries td {
1.524 albertel 6995: padding: 2px;
1.515 albertel 6996: }
1.523 albertel 6997:
6998: .LC_answer_correct {
1.795 www 6999: background: lightgreen;
7000: color: darkgreen;
7001: padding: 6px;
1.523 albertel 7002: }
1.795 www 7003:
1.523 albertel 7004: .LC_answer_charged_try {
1.797 www 7005: background: #FFAAAA;
1.795 www 7006: color: darkred;
7007: padding: 6px;
1.523 albertel 7008: }
1.795 www 7009:
1.779 bisitz 7010: .LC_answer_not_charged_try,
1.523 albertel 7011: .LC_answer_no_grade,
7012: .LC_answer_late {
1.795 www 7013: background: lightyellow;
1.523 albertel 7014: color: black;
1.795 www 7015: padding: 6px;
1.523 albertel 7016: }
1.795 www 7017:
1.523 albertel 7018: .LC_answer_previous {
1.795 www 7019: background: lightblue;
7020: color: darkblue;
7021: padding: 6px;
1.523 albertel 7022: }
1.795 www 7023:
1.779 bisitz 7024: .LC_answer_no_message {
1.777 tempelho 7025: background: #FFFFFF;
7026: color: black;
1.795 www 7027: padding: 6px;
1.779 bisitz 7028: }
1.795 www 7029:
1.1075.2.140 raeburn 7030: .LC_answer_unknown,
7031: .LC_answer_warning {
1.779 bisitz 7032: background: orange;
7033: color: black;
1.795 www 7034: padding: 6px;
1.777 tempelho 7035: }
1.795 www 7036:
1.529 albertel 7037: span.LC_prior_numerical,
7038: span.LC_prior_string,
7039: span.LC_prior_custom,
7040: span.LC_prior_reaction,
7041: span.LC_prior_math {
1.925 bisitz 7042: font-family: $mono;
1.523 albertel 7043: white-space: pre;
7044: }
7045:
1.525 albertel 7046: span.LC_prior_string {
1.925 bisitz 7047: font-family: $mono;
1.525 albertel 7048: white-space: pre;
7049: }
7050:
1.523 albertel 7051: table.LC_prior_option {
7052: width: 100%;
7053: border-collapse: collapse;
7054: }
1.795 www 7055:
1.911 bisitz 7056: table.LC_prior_rank,
1.795 www 7057: table.LC_prior_match {
1.528 albertel 7058: border-collapse: collapse;
7059: }
1.795 www 7060:
1.528 albertel 7061: table.LC_prior_option tr td,
7062: table.LC_prior_rank tr td,
7063: table.LC_prior_match tr td {
1.524 albertel 7064: border: 1px solid #000000;
1.515 albertel 7065: }
7066:
1.855 bisitz 7067: .LC_nobreak {
1.544 albertel 7068: white-space: nowrap;
1.519 raeburn 7069: }
7070:
1.576 raeburn 7071: span.LC_cusr_emph {
7072: font-style: italic;
7073: }
7074:
1.633 raeburn 7075: span.LC_cusr_subheading {
7076: font-weight: normal;
7077: font-size: 85%;
7078: }
7079:
1.861 bisitz 7080: div.LC_docs_entry_move {
1.859 bisitz 7081: border: 1px solid #BBBBBB;
1.545 albertel 7082: background: #DDDDDD;
1.861 bisitz 7083: width: 22px;
1.859 bisitz 7084: padding: 1px;
7085: margin: 0;
1.545 albertel 7086: }
7087:
1.861 bisitz 7088: table.LC_data_table tr > td.LC_docs_entry_commands,
7089: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 7090: font-size: x-small;
7091: }
1.795 www 7092:
1.861 bisitz 7093: .LC_docs_entry_parameter {
7094: white-space: nowrap;
7095: }
7096:
1.544 albertel 7097: .LC_docs_copy {
1.545 albertel 7098: color: #000099;
1.544 albertel 7099: }
1.795 www 7100:
1.544 albertel 7101: .LC_docs_cut {
1.545 albertel 7102: color: #550044;
1.544 albertel 7103: }
1.795 www 7104:
1.544 albertel 7105: .LC_docs_rename {
1.545 albertel 7106: color: #009900;
1.544 albertel 7107: }
1.795 www 7108:
1.544 albertel 7109: .LC_docs_remove {
1.545 albertel 7110: color: #990000;
7111: }
7112:
1.1075.2.134 raeburn 7113: .LC_domprefs_email,
1.547 albertel 7114: .LC_docs_reinit_warn,
7115: .LC_docs_ext_edit {
7116: font-size: x-small;
7117: }
7118:
1.545 albertel 7119: table.LC_docs_adddocs td,
7120: table.LC_docs_adddocs th {
7121: border: 1px solid #BBBBBB;
7122: padding: 4px;
7123: background: #DDDDDD;
1.543 albertel 7124: }
7125:
1.584 albertel 7126: table.LC_sty_begin {
7127: background: #BBFFBB;
7128: }
1.795 www 7129:
1.584 albertel 7130: table.LC_sty_end {
7131: background: #FFBBBB;
7132: }
7133:
1.589 raeburn 7134: table.LC_double_column {
1.803 bisitz 7135: border-width: 0;
1.589 raeburn 7136: border-collapse: collapse;
7137: width: 100%;
7138: padding: 2px;
7139: }
7140:
7141: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 7142: top: 2px;
1.589 raeburn 7143: left: 2px;
7144: width: 47%;
7145: vertical-align: top;
7146: }
7147:
7148: table.LC_double_column tr td.LC_right_col {
7149: top: 2px;
1.779 bisitz 7150: right: 2px;
1.589 raeburn 7151: width: 47%;
7152: vertical-align: top;
7153: }
7154:
1.591 raeburn 7155: div.LC_left_float {
7156: float: left;
7157: padding-right: 5%;
1.597 albertel 7158: padding-bottom: 4px;
1.591 raeburn 7159: }
7160:
7161: div.LC_clear_float_header {
1.597 albertel 7162: padding-bottom: 2px;
1.591 raeburn 7163: }
7164:
7165: div.LC_clear_float_footer {
1.597 albertel 7166: padding-top: 10px;
1.591 raeburn 7167: clear: both;
7168: }
7169:
1.597 albertel 7170: div.LC_grade_show_user {
1.941 bisitz 7171: /* border-left: 5px solid $sidebg; */
7172: border-top: 5px solid #000000;
7173: margin: 50px 0 0 0;
1.936 bisitz 7174: padding: 15px 0 5px 10px;
1.597 albertel 7175: }
1.795 www 7176:
1.936 bisitz 7177: div.LC_grade_show_user_odd_row {
1.941 bisitz 7178: /* border-left: 5px solid #000000; */
7179: }
7180:
7181: div.LC_grade_show_user div.LC_Box {
7182: margin-right: 50px;
1.597 albertel 7183: }
7184:
7185: div.LC_grade_submissions,
7186: div.LC_grade_message_center,
1.936 bisitz 7187: div.LC_grade_info_links {
1.597 albertel 7188: margin: 5px;
7189: width: 99%;
7190: background: #FFFFFF;
7191: }
1.795 www 7192:
1.597 albertel 7193: div.LC_grade_submissions_header,
1.936 bisitz 7194: div.LC_grade_message_center_header {
1.705 tempelho 7195: font-weight: bold;
7196: font-size: large;
1.597 albertel 7197: }
1.795 www 7198:
1.597 albertel 7199: div.LC_grade_submissions_body,
1.936 bisitz 7200: div.LC_grade_message_center_body {
1.597 albertel 7201: border: 1px solid black;
7202: width: 99%;
7203: background: #FFFFFF;
7204: }
1.795 www 7205:
1.613 albertel 7206: table.LC_scantron_action {
7207: width: 100%;
7208: }
1.795 www 7209:
1.613 albertel 7210: table.LC_scantron_action tr th {
1.698 harmsja 7211: font-weight:bold;
7212: font-style:normal;
1.613 albertel 7213: }
1.795 www 7214:
1.779 bisitz 7215: .LC_edit_problem_header,
1.614 albertel 7216: div.LC_edit_problem_footer {
1.705 tempelho 7217: font-weight: normal;
7218: font-size: medium;
1.602 albertel 7219: margin: 2px;
1.1060 bisitz 7220: background-color: $sidebg;
1.600 albertel 7221: }
1.795 www 7222:
1.600 albertel 7223: div.LC_edit_problem_header,
1.602 albertel 7224: div.LC_edit_problem_header div,
1.614 albertel 7225: div.LC_edit_problem_footer,
7226: div.LC_edit_problem_footer div,
1.602 albertel 7227: div.LC_edit_problem_editxml_header,
7228: div.LC_edit_problem_editxml_header div {
1.1075.2.112 raeburn 7229: z-index: 100;
1.600 albertel 7230: }
1.795 www 7231:
1.600 albertel 7232: div.LC_edit_problem_header_title {
1.705 tempelho 7233: font-weight: bold;
7234: font-size: larger;
1.602 albertel 7235: background: $tabbg;
7236: padding: 3px;
1.1060 bisitz 7237: margin: 0 0 5px 0;
1.602 albertel 7238: }
1.795 www 7239:
1.602 albertel 7240: table.LC_edit_problem_header_title {
7241: width: 100%;
1.600 albertel 7242: background: $tabbg;
1.602 albertel 7243: }
7244:
1.1075.2.112 raeburn 7245: div.LC_edit_actionbar {
7246: background-color: $sidebg;
7247: margin: 0;
7248: padding: 0;
7249: line-height: 200%;
1.602 albertel 7250: }
1.795 www 7251:
1.1075.2.112 raeburn 7252: div.LC_edit_actionbar div{
7253: padding: 0;
7254: margin: 0;
7255: display: inline-block;
1.600 albertel 7256: }
1.795 www 7257:
1.1075.2.34 raeburn 7258: .LC_edit_opt {
7259: padding-left: 1em;
7260: white-space: nowrap;
7261: }
7262:
1.1075.2.57 raeburn 7263: .LC_edit_problem_latexhelper{
7264: text-align: right;
7265: }
7266:
7267: #LC_edit_problem_colorful div{
7268: margin-left: 40px;
7269: }
7270:
1.1075.2.112 raeburn 7271: #LC_edit_problem_codemirror div{
7272: margin-left: 0px;
7273: }
7274:
1.911 bisitz 7275: img.stift {
1.803 bisitz 7276: border-width: 0;
7277: vertical-align: middle;
1.677 riegler 7278: }
1.680 riegler 7279:
1.923 bisitz 7280: table td.LC_mainmenu_col_fieldset {
1.680 riegler 7281: vertical-align: top;
1.777 tempelho 7282: }
1.795 www 7283:
1.716 raeburn 7284: div.LC_createcourse {
1.911 bisitz 7285: margin: 10px 10px 10px 10px;
1.716 raeburn 7286: }
7287:
1.917 raeburn 7288: .LC_dccid {
1.1075.2.38 raeburn 7289: float: right;
1.917 raeburn 7290: margin: 0.2em 0 0 0;
7291: padding: 0;
7292: font-size: 90%;
7293: display:none;
7294: }
7295:
1.897 wenzelju 7296: ol.LC_primary_menu a:hover,
1.721 harmsja 7297: ol#LC_MenuBreadcrumbs a:hover,
7298: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 7299: ul#LC_secondary_menu a:hover,
1.721 harmsja 7300: .LC_FormSectionClearButton input:hover
1.795 www 7301: ul.LC_TabContent li:hover a {
1.952 onken 7302: color:$button_hover;
1.911 bisitz 7303: text-decoration:none;
1.693 droeschl 7304: }
7305:
1.779 bisitz 7306: h1 {
1.911 bisitz 7307: padding: 0;
7308: line-height:130%;
1.693 droeschl 7309: }
1.698 harmsja 7310:
1.911 bisitz 7311: h2,
7312: h3,
7313: h4,
7314: h5,
7315: h6 {
7316: margin: 5px 0 5px 0;
7317: padding: 0;
7318: line-height:130%;
1.693 droeschl 7319: }
1.795 www 7320:
7321: .LC_hcell {
1.911 bisitz 7322: padding:3px 15px 3px 15px;
7323: margin: 0;
7324: background-color:$tabbg;
7325: color:$fontmenu;
7326: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 7327: }
1.795 www 7328:
1.840 bisitz 7329: .LC_Box > .LC_hcell {
1.911 bisitz 7330: margin: 0 -10px 10px -10px;
1.835 bisitz 7331: }
7332:
1.721 harmsja 7333: .LC_noBorder {
1.911 bisitz 7334: border: 0;
1.698 harmsja 7335: }
1.693 droeschl 7336:
1.721 harmsja 7337: .LC_FormSectionClearButton input {
1.911 bisitz 7338: background-color:transparent;
7339: border: none;
7340: cursor:pointer;
7341: text-decoration:underline;
1.693 droeschl 7342: }
1.763 bisitz 7343:
7344: .LC_help_open_topic {
1.911 bisitz 7345: color: #FFFFFF;
7346: background-color: #EEEEFF;
7347: margin: 1px;
7348: padding: 4px;
7349: border: 1px solid #000033;
7350: white-space: nowrap;
7351: /* vertical-align: middle; */
1.759 neumanie 7352: }
1.693 droeschl 7353:
1.911 bisitz 7354: dl,
7355: ul,
7356: div,
7357: fieldset {
7358: margin: 10px 10px 10px 0;
7359: /* overflow: hidden; */
1.693 droeschl 7360: }
1.795 www 7361:
1.1075.2.90 raeburn 7362: article.geogebraweb div {
7363: margin: 0;
7364: }
7365:
1.838 bisitz 7366: fieldset > legend {
1.911 bisitz 7367: font-weight: bold;
7368: padding: 0 5px 0 5px;
1.838 bisitz 7369: }
7370:
1.813 bisitz 7371: #LC_nav_bar {
1.911 bisitz 7372: float: left;
1.995 raeburn 7373: background-color: $pgbg_or_bgcolor;
1.966 bisitz 7374: margin: 0 0 2px 0;
1.807 droeschl 7375: }
7376:
1.916 droeschl 7377: #LC_realm {
7378: margin: 0.2em 0 0 0;
7379: padding: 0;
7380: font-weight: bold;
7381: text-align: center;
1.995 raeburn 7382: background-color: $pgbg_or_bgcolor;
1.916 droeschl 7383: }
7384:
1.911 bisitz 7385: #LC_nav_bar em {
7386: font-weight: bold;
7387: font-style: normal;
1.807 droeschl 7388: }
7389:
1.897 wenzelju 7390: ol.LC_primary_menu {
1.934 droeschl 7391: margin: 0;
1.1075.2.2 raeburn 7392: padding: 0;
1.807 droeschl 7393: }
7394:
1.852 droeschl 7395: ol#LC_PathBreadcrumbs {
1.911 bisitz 7396: margin: 0;
1.693 droeschl 7397: }
7398:
1.897 wenzelju 7399: ol.LC_primary_menu li {
1.1075.2.2 raeburn 7400: color: RGB(80, 80, 80);
7401: vertical-align: middle;
7402: text-align: left;
7403: list-style: none;
1.1075.2.112 raeburn 7404: position: relative;
1.1075.2.2 raeburn 7405: float: left;
1.1075.2.112 raeburn 7406: z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
7407: line-height: 1.5em;
1.1075.2.2 raeburn 7408: }
7409:
1.1075.2.113 raeburn 7410: ol.LC_primary_menu li a,
1.1075.2.112 raeburn 7411: ol.LC_primary_menu li p {
1.1075.2.2 raeburn 7412: display: block;
7413: margin: 0;
7414: padding: 0 5px 0 10px;
7415: text-decoration: none;
7416: }
7417:
1.1075.2.112 raeburn 7418: ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
7419: display: inline-block;
7420: width: 95%;
7421: text-align: left;
7422: }
7423:
7424: ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
7425: display: inline-block;
7426: width: 5%;
7427: float: right;
7428: text-align: right;
7429: font-size: 70%;
7430: }
7431:
7432: ol.LC_primary_menu ul {
1.1075.2.2 raeburn 7433: display: none;
1.1075.2.112 raeburn 7434: width: 15em;
1.1075.2.2 raeburn 7435: background-color: $data_table_light;
1.1075.2.112 raeburn 7436: position: absolute;
7437: top: 100%;
7438: }
7439:
7440: ol.LC_primary_menu ul ul {
7441: left: 100%;
7442: top: 0;
1.1075.2.2 raeburn 7443: }
7444:
1.1075.2.112 raeburn 7445: ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
1.1075.2.2 raeburn 7446: display: block;
7447: position: absolute;
7448: margin: 0;
7449: padding: 0;
1.1075.2.5 raeburn 7450: z-index: 2;
1.1075.2.2 raeburn 7451: }
7452:
7453: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
1.1075.2.112 raeburn 7454: /* First Submenu -> size should be smaller than the menu title of the whole menu */
1.1075.2.2 raeburn 7455: font-size: 90%;
1.911 bisitz 7456: vertical-align: top;
1.1075.2.2 raeburn 7457: float: none;
1.1075.2.5 raeburn 7458: border-left: 1px solid black;
7459: border-right: 1px solid black;
1.1075.2.112 raeburn 7460: /* A dark bottom border to visualize different menu options;
7461: overwritten in the create_submenu routine for the last border-bottom of the menu */
7462: border-bottom: 1px solid $data_table_dark;
1.1075.2.2 raeburn 7463: }
7464:
1.1075.2.112 raeburn 7465: ol.LC_primary_menu li li p:hover {
7466: color:$button_hover;
7467: text-decoration:none;
7468: background-color:$data_table_dark;
1.1075.2.2 raeburn 7469: }
7470:
7471: ol.LC_primary_menu li li a:hover {
7472: color:$button_hover;
7473: background-color:$data_table_dark;
1.693 droeschl 7474: }
7475:
1.1075.2.112 raeburn 7476: /* Font-size equal to the size of the predecessors*/
7477: ol.LC_primary_menu li:hover li li {
7478: font-size: 100%;
7479: }
7480:
1.897 wenzelju 7481: ol.LC_primary_menu li img {
1.911 bisitz 7482: vertical-align: bottom;
1.934 droeschl 7483: height: 1.1em;
1.1075.2.3 raeburn 7484: margin: 0.2em 0 0 0;
1.693 droeschl 7485: }
7486:
1.897 wenzelju 7487: ol.LC_primary_menu a {
1.911 bisitz 7488: color: RGB(80, 80, 80);
7489: text-decoration: none;
1.693 droeschl 7490: }
1.795 www 7491:
1.949 droeschl 7492: ol.LC_primary_menu a.LC_new_message {
7493: font-weight:bold;
7494: color: darkred;
7495: }
7496:
1.975 raeburn 7497: ol.LC_docs_parameters {
7498: margin-left: 0;
7499: padding: 0;
7500: list-style: none;
7501: }
7502:
7503: ol.LC_docs_parameters li {
7504: margin: 0;
7505: padding-right: 20px;
7506: display: inline;
7507: }
7508:
1.976 raeburn 7509: ol.LC_docs_parameters li:before {
7510: content: "\\002022 \\0020";
7511: }
7512:
7513: li.LC_docs_parameters_title {
7514: font-weight: bold;
7515: }
7516:
7517: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
7518: content: "";
7519: }
7520:
1.897 wenzelju 7521: ul#LC_secondary_menu {
1.1075.2.23 raeburn 7522: clear: right;
1.911 bisitz 7523: color: $fontmenu;
7524: background: $tabbg;
7525: list-style: none;
7526: padding: 0;
7527: margin: 0;
7528: width: 100%;
1.995 raeburn 7529: text-align: left;
1.1075.2.4 raeburn 7530: float: left;
1.808 droeschl 7531: }
7532:
1.897 wenzelju 7533: ul#LC_secondary_menu li {
1.911 bisitz 7534: font-weight: bold;
7535: line-height: 1.8em;
7536: border-right: 1px solid black;
1.1075.2.4 raeburn 7537: float: left;
7538: }
7539:
7540: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
7541: background-color: $data_table_light;
7542: }
7543:
7544: ul#LC_secondary_menu li a {
7545: padding: 0 0.8em;
7546: }
7547:
7548: ul#LC_secondary_menu li ul {
7549: display: none;
7550: }
7551:
7552: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
7553: display: block;
7554: position: absolute;
7555: margin: 0;
7556: padding: 0;
7557: list-style:none;
7558: float: none;
7559: background-color: $data_table_light;
1.1075.2.5 raeburn 7560: z-index: 2;
1.1075.2.10 raeburn 7561: margin-left: -1px;
1.1075.2.4 raeburn 7562: }
7563:
7564: ul#LC_secondary_menu li ul li {
7565: font-size: 90%;
7566: vertical-align: top;
7567: border-left: 1px solid black;
7568: border-right: 1px solid black;
1.1075.2.33 raeburn 7569: background-color: $data_table_light;
1.1075.2.4 raeburn 7570: list-style:none;
7571: float: none;
7572: }
7573:
7574: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
7575: background-color: $data_table_dark;
1.807 droeschl 7576: }
7577:
1.847 tempelho 7578: ul.LC_TabContent {
1.911 bisitz 7579: display:block;
7580: background: $sidebg;
7581: border-bottom: solid 1px $lg_border_color;
7582: list-style:none;
1.1020 raeburn 7583: margin: -1px -10px 0 -10px;
1.911 bisitz 7584: padding: 0;
1.693 droeschl 7585: }
7586:
1.795 www 7587: ul.LC_TabContent li,
7588: ul.LC_TabContentBigger li {
1.911 bisitz 7589: float:left;
1.741 harmsja 7590: }
1.795 www 7591:
1.897 wenzelju 7592: ul#LC_secondary_menu li a {
1.911 bisitz 7593: color: $fontmenu;
7594: text-decoration: none;
1.693 droeschl 7595: }
1.795 www 7596:
1.721 harmsja 7597: ul.LC_TabContent {
1.952 onken 7598: min-height:20px;
1.721 harmsja 7599: }
1.795 www 7600:
7601: ul.LC_TabContent li {
1.911 bisitz 7602: vertical-align:middle;
1.959 onken 7603: padding: 0 16px 0 10px;
1.911 bisitz 7604: background-color:$tabbg;
7605: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 7606: border-left: solid 1px $font;
1.721 harmsja 7607: }
1.795 www 7608:
1.847 tempelho 7609: ul.LC_TabContent .right {
1.911 bisitz 7610: float:right;
1.847 tempelho 7611: }
7612:
1.911 bisitz 7613: ul.LC_TabContent li a,
7614: ul.LC_TabContent li {
7615: color:rgb(47,47,47);
7616: text-decoration:none;
7617: font-size:95%;
7618: font-weight:bold;
1.952 onken 7619: min-height:20px;
7620: }
7621:
1.959 onken 7622: ul.LC_TabContent li a:hover,
7623: ul.LC_TabContent li a:focus {
1.952 onken 7624: color: $button_hover;
1.959 onken 7625: background:none;
7626: outline:none;
1.952 onken 7627: }
7628:
7629: ul.LC_TabContent li:hover {
7630: color: $button_hover;
7631: cursor:pointer;
1.721 harmsja 7632: }
1.795 www 7633:
1.911 bisitz 7634: ul.LC_TabContent li.active {
1.952 onken 7635: color: $font;
1.911 bisitz 7636: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 7637: border-bottom:solid 1px #FFFFFF;
7638: cursor: default;
1.744 ehlerst 7639: }
1.795 www 7640:
1.959 onken 7641: ul.LC_TabContent li.active a {
7642: color:$font;
7643: background:#FFFFFF;
7644: outline: none;
7645: }
1.1047 raeburn 7646:
7647: ul.LC_TabContent li.goback {
7648: float: left;
7649: border-left: none;
7650: }
7651:
1.870 tempelho 7652: #maincoursedoc {
1.911 bisitz 7653: clear:both;
1.870 tempelho 7654: }
7655:
7656: ul.LC_TabContentBigger {
1.911 bisitz 7657: display:block;
7658: list-style:none;
7659: padding: 0;
1.870 tempelho 7660: }
7661:
1.795 www 7662: ul.LC_TabContentBigger li {
1.911 bisitz 7663: vertical-align:bottom;
7664: height: 30px;
7665: font-size:110%;
7666: font-weight:bold;
7667: color: #737373;
1.841 tempelho 7668: }
7669:
1.957 onken 7670: ul.LC_TabContentBigger li.active {
7671: position: relative;
7672: top: 1px;
7673: }
7674:
1.870 tempelho 7675: ul.LC_TabContentBigger li a {
1.911 bisitz 7676: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
7677: height: 30px;
7678: line-height: 30px;
7679: text-align: center;
7680: display: block;
7681: text-decoration: none;
1.958 onken 7682: outline: none;
1.741 harmsja 7683: }
1.795 www 7684:
1.870 tempelho 7685: ul.LC_TabContentBigger li.active a {
1.911 bisitz 7686: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
7687: color:$font;
1.744 ehlerst 7688: }
1.795 www 7689:
1.870 tempelho 7690: ul.LC_TabContentBigger li b {
1.911 bisitz 7691: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7692: display: block;
7693: float: left;
7694: padding: 0 30px;
1.957 onken 7695: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7696: }
7697:
1.956 onken 7698: ul.LC_TabContentBigger li:hover b {
7699: color:$button_hover;
7700: }
7701:
1.870 tempelho 7702: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7703: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7704: color:$font;
1.957 onken 7705: border: 0;
1.741 harmsja 7706: }
1.693 droeschl 7707:
1.870 tempelho 7708:
1.862 bisitz 7709: ul.LC_CourseBreadcrumbs {
7710: background: $sidebg;
1.1020 raeburn 7711: height: 2em;
1.862 bisitz 7712: padding-left: 10px;
1.1020 raeburn 7713: margin: 0;
1.862 bisitz 7714: list-style-position: inside;
7715: }
7716:
1.911 bisitz 7717: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7718: ol#LC_PathBreadcrumbs {
1.911 bisitz 7719: padding-left: 10px;
7720: margin: 0;
1.933 droeschl 7721: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7722: }
7723:
1.911 bisitz 7724: ol#LC_MenuBreadcrumbs li,
7725: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7726: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7727: display: inline;
1.933 droeschl 7728: white-space: normal;
1.693 droeschl 7729: }
7730:
1.823 bisitz 7731: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7732: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7733: text-decoration: none;
7734: font-size:90%;
1.693 droeschl 7735: }
1.795 www 7736:
1.969 droeschl 7737: ol#LC_MenuBreadcrumbs h1 {
7738: display: inline;
7739: font-size: 90%;
7740: line-height: 2.5em;
7741: margin: 0;
7742: padding: 0;
7743: }
7744:
1.795 www 7745: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7746: text-decoration:none;
7747: font-size:100%;
7748: font-weight:bold;
1.693 droeschl 7749: }
1.795 www 7750:
1.840 bisitz 7751: .LC_Box {
1.911 bisitz 7752: border: solid 1px $lg_border_color;
7753: padding: 0 10px 10px 10px;
1.746 neumanie 7754: }
1.795 www 7755:
1.1020 raeburn 7756: .LC_DocsBox {
7757: border: solid 1px $lg_border_color;
7758: padding: 0 0 10px 10px;
7759: }
7760:
1.795 www 7761: .LC_AboutMe_Image {
1.911 bisitz 7762: float:left;
7763: margin-right:10px;
1.747 neumanie 7764: }
1.795 www 7765:
7766: .LC_Clear_AboutMe_Image {
1.911 bisitz 7767: clear:left;
1.747 neumanie 7768: }
1.795 www 7769:
1.721 harmsja 7770: dl.LC_ListStyleClean dt {
1.911 bisitz 7771: padding-right: 5px;
7772: display: table-header-group;
1.693 droeschl 7773: }
7774:
1.721 harmsja 7775: dl.LC_ListStyleClean dd {
1.911 bisitz 7776: display: table-row;
1.693 droeschl 7777: }
7778:
1.721 harmsja 7779: .LC_ListStyleClean,
7780: .LC_ListStyleSimple,
7781: .LC_ListStyleNormal,
1.795 www 7782: .LC_ListStyleSpecial {
1.911 bisitz 7783: /* display:block; */
7784: list-style-position: inside;
7785: list-style-type: none;
7786: overflow: hidden;
7787: padding: 0;
1.693 droeschl 7788: }
7789:
1.721 harmsja 7790: .LC_ListStyleSimple li,
7791: .LC_ListStyleSimple dd,
7792: .LC_ListStyleNormal li,
7793: .LC_ListStyleNormal dd,
7794: .LC_ListStyleSpecial li,
1.795 www 7795: .LC_ListStyleSpecial dd {
1.911 bisitz 7796: margin: 0;
7797: padding: 5px 5px 5px 10px;
7798: clear: both;
1.693 droeschl 7799: }
7800:
1.721 harmsja 7801: .LC_ListStyleClean li,
7802: .LC_ListStyleClean dd {
1.911 bisitz 7803: padding-top: 0;
7804: padding-bottom: 0;
1.693 droeschl 7805: }
7806:
1.721 harmsja 7807: .LC_ListStyleSimple dd,
1.795 www 7808: .LC_ListStyleSimple li {
1.911 bisitz 7809: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7810: }
7811:
1.721 harmsja 7812: .LC_ListStyleSpecial li,
7813: .LC_ListStyleSpecial dd {
1.911 bisitz 7814: list-style-type: none;
7815: background-color: RGB(220, 220, 220);
7816: margin-bottom: 4px;
1.693 droeschl 7817: }
7818:
1.721 harmsja 7819: table.LC_SimpleTable {
1.911 bisitz 7820: margin:5px;
7821: border:solid 1px $lg_border_color;
1.795 www 7822: }
1.693 droeschl 7823:
1.721 harmsja 7824: table.LC_SimpleTable tr {
1.911 bisitz 7825: padding: 0;
7826: border:solid 1px $lg_border_color;
1.693 droeschl 7827: }
1.795 www 7828:
7829: table.LC_SimpleTable thead {
1.911 bisitz 7830: background:rgb(220,220,220);
1.693 droeschl 7831: }
7832:
1.721 harmsja 7833: div.LC_columnSection {
1.911 bisitz 7834: display: block;
7835: clear: both;
7836: overflow: hidden;
7837: margin: 0;
1.693 droeschl 7838: }
7839:
1.721 harmsja 7840: div.LC_columnSection>* {
1.911 bisitz 7841: float: left;
7842: margin: 10px 20px 10px 0;
7843: overflow:hidden;
1.693 droeschl 7844: }
1.721 harmsja 7845:
1.795 www 7846: table em {
1.911 bisitz 7847: font-weight: bold;
7848: font-style: normal;
1.748 schulted 7849: }
1.795 www 7850:
1.779 bisitz 7851: table.LC_tableBrowseRes,
1.795 www 7852: table.LC_tableOfContent {
1.911 bisitz 7853: border:none;
7854: border-spacing: 1px;
7855: padding: 3px;
7856: background-color: #FFFFFF;
7857: font-size: 90%;
1.753 droeschl 7858: }
1.789 droeschl 7859:
1.911 bisitz 7860: table.LC_tableOfContent {
7861: border-collapse: collapse;
1.789 droeschl 7862: }
7863:
1.771 droeschl 7864: table.LC_tableBrowseRes a,
1.768 schulted 7865: table.LC_tableOfContent a {
1.911 bisitz 7866: background-color: transparent;
7867: text-decoration: none;
1.753 droeschl 7868: }
7869:
1.795 www 7870: table.LC_tableOfContent img {
1.911 bisitz 7871: border: none;
7872: height: 1.3em;
7873: vertical-align: text-bottom;
7874: margin-right: 0.3em;
1.753 droeschl 7875: }
1.757 schulted 7876:
1.795 www 7877: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7878: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7879: }
7880:
1.795 www 7881: a#LC_content_toolbar_everything {
1.911 bisitz 7882: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7883: }
7884:
1.795 www 7885: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7886: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7887: }
7888:
1.795 www 7889: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7890: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7891: }
7892:
1.795 www 7893: a#LC_content_toolbar_changefolder {
1.911 bisitz 7894: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7895: }
7896:
1.795 www 7897: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7898: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7899: }
7900:
1.1043 raeburn 7901: a#LC_content_toolbar_edittoplevel {
7902: background-image:url(/res/adm/pages/edittoplevel.gif);
7903: }
7904:
1.795 www 7905: ul#LC_toolbar li a:hover {
1.911 bisitz 7906: background-position: bottom center;
1.757 schulted 7907: }
7908:
1.795 www 7909: ul#LC_toolbar {
1.911 bisitz 7910: padding: 0;
7911: margin: 2px;
7912: list-style:none;
7913: position:relative;
7914: background-color:white;
1.1075.2.9 raeburn 7915: overflow: auto;
1.757 schulted 7916: }
7917:
1.795 www 7918: ul#LC_toolbar li {
1.911 bisitz 7919: border:1px solid white;
7920: padding: 0;
7921: margin: 0;
7922: float: left;
7923: display:inline;
7924: vertical-align:middle;
1.1075.2.9 raeburn 7925: white-space: nowrap;
1.911 bisitz 7926: }
1.757 schulted 7927:
1.783 amueller 7928:
1.795 www 7929: a.LC_toolbarItem {
1.911 bisitz 7930: display:block;
7931: padding: 0;
7932: margin: 0;
7933: height: 32px;
7934: width: 32px;
7935: color:white;
7936: border: none;
7937: background-repeat:no-repeat;
7938: background-color:transparent;
1.757 schulted 7939: }
7940:
1.915 droeschl 7941: ul.LC_funclist {
7942: margin: 0;
7943: padding: 0.5em 1em 0.5em 0;
7944: }
7945:
1.933 droeschl 7946: ul.LC_funclist > li:first-child {
7947: font-weight:bold;
7948: margin-left:0.8em;
7949: }
7950:
1.915 droeschl 7951: ul.LC_funclist + ul.LC_funclist {
7952: /*
7953: left border as a seperator if we have more than
7954: one list
7955: */
7956: border-left: 1px solid $sidebg;
7957: /*
7958: this hides the left border behind the border of the
7959: outer box if element is wrapped to the next 'line'
7960: */
7961: margin-left: -1px;
7962: }
7963:
1.843 bisitz 7964: ul.LC_funclist li {
1.915 droeschl 7965: display: inline;
1.782 bisitz 7966: white-space: nowrap;
1.915 droeschl 7967: margin: 0 0 0 25px;
7968: line-height: 150%;
1.782 bisitz 7969: }
7970:
1.974 wenzelju 7971: .LC_hidden {
7972: display: none;
7973: }
7974:
1.1030 www 7975: .LCmodal-overlay {
7976: position:fixed;
7977: top:0;
7978: right:0;
7979: bottom:0;
7980: left:0;
7981: height:100%;
7982: width:100%;
7983: margin:0;
7984: padding:0;
7985: background:#999;
7986: opacity:.75;
7987: filter: alpha(opacity=75);
7988: -moz-opacity: 0.75;
7989: z-index:101;
7990: }
7991:
7992: * html .LCmodal-overlay {
7993: position: absolute;
7994: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7995: }
7996:
7997: .LCmodal-window {
7998: position:fixed;
7999: top:50%;
8000: left:50%;
8001: margin:0;
8002: padding:0;
8003: z-index:102;
8004: }
8005:
8006: * html .LCmodal-window {
8007: position:absolute;
8008: }
8009:
8010: .LCclose-window {
8011: position:absolute;
8012: width:32px;
8013: height:32px;
8014: right:8px;
8015: top:8px;
8016: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
8017: text-indent:-99999px;
8018: overflow:hidden;
8019: cursor:pointer;
8020: }
8021:
1.1075.2.158 raeburn 8022: .LCisDisabled {
8023: cursor: not-allowed;
8024: opacity: 0.5;
8025: }
8026:
8027: a[aria-disabled="true"] {
8028: color: currentColor;
8029: display: inline-block; /* For IE11/ MS Edge bug */
8030: pointer-events: none;
8031: text-decoration: none;
8032: }
8033:
1.1075.2.141 raeburn 8034: pre.LC_wordwrap {
8035: white-space: pre-wrap;
8036: white-space: -moz-pre-wrap;
8037: white-space: -pre-wrap;
8038: white-space: -o-pre-wrap;
8039: word-wrap: break-word;
8040: }
8041:
1.1075.2.17 raeburn 8042: /*
8043: styles used by TTH when "Default set of options to pass to tth/m
8044: when converting TeX" in course settings has been set
8045:
8046: option passed: -t
8047:
8048: */
8049:
8050: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
8051: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
8052: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
8053: td div.norm {line-height:normal;}
8054:
8055: /*
8056: option passed -y3
8057: */
8058:
8059: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
8060: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
8061: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
8062:
1.1075.2.121 raeburn 8063: #LC_minitab_header {
8064: float:left;
8065: width:100%;
8066: background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
8067: font-size:93%;
8068: line-height:normal;
8069: margin: 0.5em 0 0.5em 0;
8070: }
8071: #LC_minitab_header ul {
8072: margin:0;
8073: padding:10px 10px 0;
8074: list-style:none;
8075: }
8076: #LC_minitab_header li {
8077: float:left;
8078: background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
8079: margin:0;
8080: padding:0 0 0 9px;
8081: }
8082: #LC_minitab_header a {
8083: display:block;
8084: background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
8085: padding:5px 15px 4px 6px;
8086: }
8087: #LC_minitab_header #LC_current_minitab {
8088: background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
8089: }
8090: #LC_minitab_header #LC_current_minitab a {
8091: background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
8092: padding-bottom:5px;
8093: }
8094:
8095:
1.343 albertel 8096: END
8097: }
8098:
1.306 albertel 8099: =pod
8100:
8101: =item * &headtag()
8102:
8103: Returns a uniform footer for LON-CAPA web pages.
8104:
1.307 albertel 8105: Inputs: $title - optional title for the head
8106: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 8107: $args - optional arguments
1.319 albertel 8108: force_register - if is true call registerurl so the remote is
8109: informed
1.415 albertel 8110: redirect -> array ref of
8111: 1- seconds before redirect occurs
8112: 2- url to redirect to
8113: 3- whether the side effect should occur
1.315 albertel 8114: (side effect of setting
8115: $env{'internal.head.redirect'} to the url
8116: redirected too)
1.1075.2.166 raeburn 8117: 4- whether encrypt check should be skipped
1.352 albertel 8118: domain -> force to color decorate a page for a specific
8119: domain
8120: function -> force usage of a specific rolish color scheme
8121: bgcolor -> override the default page bgcolor
1.460 albertel 8122: no_auto_mt_title
8123: -> prevent &mt()ing the title arg
1.464 albertel 8124:
1.306 albertel 8125: =cut
8126:
8127: sub headtag {
1.313 albertel 8128: my ($title,$head_extra,$args) = @_;
1.306 albertel 8129:
1.363 albertel 8130: my $function = $args->{'function'} || &get_users_function();
8131: my $domain = $args->{'domain'} || &determinedomain();
8132: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 8133: my $httphost = $args->{'use_absolute'};
1.418 albertel 8134: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 8135: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 8136: #time(),
1.418 albertel 8137: $env{'environment.color.timestamp'},
1.363 albertel 8138: $function,$domain,$bgcolor);
8139:
1.369 www 8140: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 8141:
1.308 albertel 8142: my $result =
8143: '<head>'.
1.1075.2.56 raeburn 8144: &font_settings($args);
1.319 albertel 8145:
1.1075.2.72 raeburn 8146: my $inhibitprint;
8147: if ($args->{'print_suppress'}) {
8148: $inhibitprint = &print_suppression();
8149: }
1.1064 raeburn 8150:
1.1075.2.172 raeburn 8151: if (!$args->{'frameset'} && !$args->{'switchserver'}) {
1.461 albertel 8152: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
8153: }
1.1075.2.12 raeburn 8154: if ($args->{'force_register'}) {
8155: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 8156: }
1.436 albertel 8157: if (!$args->{'no_nav_bar'}
8158: && !$args->{'only_body'}
1.1075.2.172 raeburn 8159: && !$args->{'frameset'}
8160: && !$args->{'switchserver'}) {
1.1075.2.52 raeburn 8161: $result .= &help_menu_js($httphost);
1.1032 www 8162: $result.=&modal_window();
1.1038 www 8163: $result.=&togglebox_script();
1.1034 www 8164: $result.=&wishlist_window();
1.1041 www 8165: $result.=&LCprogressbarUpdate_script();
1.1034 www 8166: } else {
8167: if ($args->{'add_modal'}) {
8168: $result.=&modal_window();
8169: }
8170: if ($args->{'add_wishlist'}) {
8171: $result.=&wishlist_window();
8172: }
1.1038 www 8173: if ($args->{'add_togglebox'}) {
8174: $result.=&togglebox_script();
8175: }
1.1041 www 8176: if ($args->{'add_progressbar'}) {
8177: $result.=&LCprogressbarUpdate_script();
8178: }
1.436 albertel 8179: }
1.314 albertel 8180: if (ref($args->{'redirect'})) {
1.1075.2.166 raeburn 8181: my ($time,$url,$inhibit_continue,$skip_enc_check) = @{$args->{'redirect'}};
8182: if (!$skip_enc_check) {
8183: $url = &Apache::lonenc::check_encrypt($url);
8184: }
1.414 albertel 8185: if (!$inhibit_continue) {
8186: $env{'internal.head.redirect'} = $url;
8187: }
1.313 albertel 8188: $result.=<<ADDMETA
8189: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 8190: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 8191: ADDMETA
1.1075.2.89 raeburn 8192: } else {
8193: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
8194: my $requrl = $env{'request.uri'};
8195: if ($requrl eq '') {
8196: $requrl = $ENV{'REQUEST_URI'};
8197: $requrl =~ s/\?.+$//;
8198: }
8199: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
8200: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
8201: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
8202: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
8203: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
8204: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
1.1075.2.145 raeburn 8205: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
1.1075.2.151 raeburn 8206: my ($offload,$offloadoth);
1.1075.2.89 raeburn 8207: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
8208: if ($domdefs{'offloadnow'}{$lonhost}) {
1.1075.2.145 raeburn 8209: $offload = 1;
1.1075.2.151 raeburn 8210: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8211: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8212: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8213: $offloadoth = 1;
8214: $dom_in_use = $env{'user.domain'};
8215: }
8216: }
1.1075.2.145 raeburn 8217: }
8218: }
8219: unless ($offload) {
8220: if (ref($domdefs{'offloadoth'}) eq 'HASH') {
8221: if ($domdefs{'offloadoth'}{$lonhost}) {
8222: if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
8223: (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
8224: unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
8225: $offload = 1;
1.1075.2.151 raeburn 8226: $offloadoth = 1;
1.1075.2.145 raeburn 8227: $dom_in_use = $env{'user.domain'};
8228: }
1.1075.2.89 raeburn 8229: }
1.1075.2.145 raeburn 8230: }
8231: }
8232: }
8233: if ($offload) {
1.1075.2.158 raeburn 8234: my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
1.1075.2.151 raeburn 8235: if (($newserver eq '') && ($offloadoth)) {
8236: my @domains = &Apache::lonnet::current_machine_domains();
8237: if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
8238: ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
8239: }
8240: }
1.1075.2.145 raeburn 8241: if (($newserver) && ($newserver ne $lonhost)) {
8242: my $numsec = 5;
8243: my $timeout = $numsec * 1000;
8244: my ($newurl,$locknum,%locks,$msg);
8245: if ($env{'request.role.adv'}) {
8246: ($locknum,%locks) = &Apache::lonnet::get_locks();
8247: }
8248: my $disable_submit = 0;
8249: if ($requrl =~ /$LONCAPA::assess_re/) {
8250: $disable_submit = 1;
8251: }
8252: if ($locknum) {
8253: my @lockinfo = sort(values(%locks));
1.1075.2.153 raeburn 8254: $msg = &mt('Once the following tasks are complete:')." \n".
1.1075.2.145 raeburn 8255: join(", ",sort(values(%locks)))."\n";
8256: if (&show_course()) {
8257: $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
1.1075.2.89 raeburn 8258: } else {
1.1075.2.145 raeburn 8259: $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
8260: }
8261: } else {
8262: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
8263: $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
8264: }
8265: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
8266: $newurl = '/adm/switchserver?otherserver='.$newserver;
8267: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
8268: $newurl .= '&role='.$env{'request.role'};
8269: }
8270: if ($env{'request.symb'}) {
8271: my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
8272: if ($shownsymb =~ m{^/enc/}) {
8273: my $reqdmajor = 2;
8274: my $reqdminor = 11;
8275: my $reqdsubminor = 3;
8276: my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
8277: my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
8278: my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
8279: if (($major eq '' && $minor eq '') ||
8280: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
8281: (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
8282: ($reqdsubminor > $subminor))))) {
8283: undef($shownsymb);
8284: }
1.1075.2.89 raeburn 8285: }
1.1075.2.145 raeburn 8286: if ($shownsymb) {
8287: &js_escape(\$shownsymb);
8288: $newurl .= '&symb='.$shownsymb;
1.1075.2.89 raeburn 8289: }
1.1075.2.145 raeburn 8290: } else {
8291: my $shownurl = &Apache::lonenc::check_encrypt($requrl);
8292: &js_escape(\$shownurl);
8293: $newurl .= '&origurl='.$shownurl;
1.1075.2.89 raeburn 8294: }
1.1075.2.145 raeburn 8295: }
8296: &js_escape(\$msg);
8297: $result.=<<OFFLOAD
1.1075.2.89 raeburn 8298: <meta http-equiv="pragma" content="no-cache" />
8299: <script type="text/javascript">
1.1075.2.92 raeburn 8300: // <![CDATA[
1.1075.2.89 raeburn 8301: function LC_Offload_Now() {
8302: var dest = "$newurl";
8303: if (dest != '') {
8304: window.location.href="$newurl";
8305: }
8306: }
1.1075.2.92 raeburn 8307: \$(document).ready(function () {
8308: window.alert('$msg');
8309: if ($disable_submit) {
1.1075.2.89 raeburn 8310: \$(".LC_hwk_submit").prop("disabled", true);
8311: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92 raeburn 8312: }
8313: setTimeout('LC_Offload_Now()', $timeout);
8314: });
8315: // ]]>
1.1075.2.89 raeburn 8316: </script>
8317: OFFLOAD
8318: }
8319: }
8320: }
8321: }
8322: }
1.313 albertel 8323: }
1.306 albertel 8324: if (!defined($title)) {
8325: $title = 'The LearningOnline Network with CAPA';
8326: }
1.460 albertel 8327: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.168 raeburn 8328: if ($title =~ /^LON-CAPA\s+/) {
8329: $result .= '<title> '.$title.'</title>';
8330: } else {
8331: $result .= '<title> LON-CAPA '.$title.'</title>';
8332: }
8333: $result .= "\n".'<link rel="stylesheet" type="text/css" href="'.$url.'"';
1.1075.2.61 raeburn 8334: if (!$args->{'frameset'}) {
8335: $result .= ' /';
8336: }
8337: $result .= '>'
1.1064 raeburn 8338: .$inhibitprint
1.414 albertel 8339: .$head_extra;
1.1075.2.108 raeburn 8340: my $clientmobile;
8341: if (($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
8342: (undef,undef,undef,undef,undef,undef,$clientmobile) = &decode_user_agent();
8343: } else {
8344: $clientmobile = $env{'browser.mobile'};
8345: }
8346: if ($clientmobile) {
1.1075.2.42 raeburn 8347: $result .= '
8348: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
8349: <meta name="apple-mobile-web-app-capable" content="yes" />';
8350: }
1.1075.2.126 raeburn 8351: $result .= '<meta name="google" content="notranslate" />'."\n";
1.962 droeschl 8352: return $result.'</head>';
1.306 albertel 8353: }
8354:
8355: =pod
8356:
1.340 albertel 8357: =item * &font_settings()
8358:
8359: Returns neccessary <meta> to set the proper encoding
8360:
1.1075.2.56 raeburn 8361: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 8362:
8363: =cut
8364:
8365: sub font_settings {
1.1075.2.56 raeburn 8366: my ($args) = @_;
1.340 albertel 8367: my $headerstring='';
1.1075.2.56 raeburn 8368: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
8369: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 8370: $headerstring.=
1.1075.2.61 raeburn 8371: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
8372: if (!$args->{'frameset'}) {
8373: $headerstring.= ' /';
8374: }
8375: $headerstring .= '>'."\n";
1.340 albertel 8376: }
8377: return $headerstring;
8378: }
8379:
1.341 albertel 8380: =pod
8381:
1.1064 raeburn 8382: =item * &print_suppression()
8383:
8384: In course context returns css which causes the body to be blank when media="print",
8385: if printout generation is unavailable for the current resource.
8386:
8387: This could be because:
8388:
8389: (a) printstartdate is in the future
8390:
8391: (b) printenddate is in the past
8392:
8393: (c) there is an active exam block with "printout"
8394: functionality blocked
8395:
8396: Users with pav, pfo or evb privileges are exempt.
8397:
8398: Inputs: none
8399:
8400: =cut
8401:
8402:
8403: sub print_suppression {
8404: my $noprint;
8405: if ($env{'request.course.id'}) {
8406: my $scope = $env{'request.course.id'};
8407: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8408: (&Apache::lonnet::allowed('pfo',$scope))) {
8409: return;
8410: }
8411: if ($env{'request.course.sec'} ne '') {
8412: $scope .= "/$env{'request.course.sec'}";
8413: if ((&Apache::lonnet::allowed('pav',$scope)) ||
8414: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 8415: return;
1.1064 raeburn 8416: }
8417: }
8418: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
8419: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.158 raeburn 8420: my $clientip = &Apache::lonnet::get_requestor_ip();
8421: my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
1.1064 raeburn 8422: if ($blocked) {
8423: my $checkrole = "cm./$cdom/$cnum";
8424: if ($env{'request.course.sec'} ne '') {
8425: $checkrole .= "/$env{'request.course.sec'}";
8426: }
8427: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
8428: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
8429: $noprint = 1;
8430: }
8431: }
8432: unless ($noprint) {
8433: my $symb = &Apache::lonnet::symbread();
8434: if ($symb ne '') {
8435: my $navmap = Apache::lonnavmaps::navmap->new();
8436: if (ref($navmap)) {
8437: my $res = $navmap->getBySymb($symb);
8438: if (ref($res)) {
8439: if (!$res->resprintable()) {
8440: $noprint = 1;
8441: }
8442: }
8443: }
8444: }
8445: }
8446: if ($noprint) {
8447: return <<"ENDSTYLE";
8448: <style type="text/css" media="print">
8449: body { display:none }
8450: </style>
8451: ENDSTYLE
8452: }
8453: }
8454: return;
8455: }
8456:
8457: =pod
8458:
1.341 albertel 8459: =item * &xml_begin()
8460:
8461: Returns the needed doctype and <html>
8462:
8463: Inputs: none
8464:
8465: =cut
8466:
8467: sub xml_begin {
1.1075.2.61 raeburn 8468: my ($is_frameset) = @_;
1.341 albertel 8469: my $output='';
8470:
8471: if ($env{'browser.mathml'}) {
8472: $output='<?xml version="1.0"?>'
8473: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
8474: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
8475:
8476: # .'<!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">] >'
8477: .'<!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">'
8478: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
8479: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 8480: } elsif ($is_frameset) {
8481: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
8482: '<html>'."\n";
1.341 albertel 8483: } else {
1.1075.2.61 raeburn 8484: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
8485: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 8486: }
8487: return $output;
8488: }
1.340 albertel 8489:
8490: =pod
8491:
1.306 albertel 8492: =item * &start_page()
8493:
8494: Returns a complete <html> .. <body> section for LON-CAPA web pages.
8495:
1.648 raeburn 8496: Inputs:
8497:
8498: =over 4
8499:
8500: $title - optional title for the page
8501:
8502: $head_extra - optional extra HTML to incude inside the <head>
8503:
8504: $args - additional optional args supported are:
8505:
8506: =over 8
8507:
8508: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 8509: arg on
1.814 bisitz 8510: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 8511: add_entries -> additional attributes to add to the <body>
8512: domain -> force to color decorate a page for a
1.317 albertel 8513: specific domain
1.648 raeburn 8514: function -> force usage of a specific rolish color
1.317 albertel 8515: scheme
1.648 raeburn 8516: redirect -> see &headtag()
8517: bgcolor -> override the default page bg color
8518: js_ready -> return a string ready for being used in
1.317 albertel 8519: a javascript writeln
1.648 raeburn 8520: html_encode -> return a string ready for being used in
1.320 albertel 8521: a html attribute
1.648 raeburn 8522: force_register -> if is true will turn on the &bodytag()
1.317 albertel 8523: $forcereg arg
1.648 raeburn 8524: frameset -> if true will start with a <frameset>
1.330 albertel 8525: rather than <body>
1.648 raeburn 8526: skip_phases -> hash ref of
1.338 albertel 8527: head -> skip the <html><head> generation
8528: body -> skip all <body> generation
1.1075.2.12 raeburn 8529: no_inline_link -> if true and in remote mode, don't show the
8530: 'Switch To Inline Menu' link
1.648 raeburn 8531: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 8532: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 8533: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.175 raeburn 8534: bread_crumbs_style -> breadcrumbs are contained within <div id="LC_breadcrumbs">,
8535: and &standard_css() contains CSS for #LC_breadcrumbs, if you want
8536: to override those values, or add to them, specify the value to
8537: include in the style attribute to include in the div tag by using
8538: bread_crumbs_style (e.g., overflow: visible)
1.1075.2.123 raeburn 8539: bread_crumbs_nomenu -> if true will pass false as the value of $menulink
8540: to lonhtmlcommon::breadcrumbs
1.1075.2.15 raeburn 8541: group -> includes the current group, if page is for a
8542: specific group
1.1075.2.133 raeburn 8543: use_absolute -> for request for external resource or syllabus, this
8544: will contain https://<hostname> if server uses
8545: https (as per hosts.tab), but request is for http
8546: hostname -> hostname, originally from $r->hostname(), (optional).
1.1075.2.158 raeburn 8547: links_disabled -> Links in primary and secondary menus are disabled
8548: (Can enable them once page has loaded - see lonroles.pm
8549: for an example).
1.361 albertel 8550:
1.648 raeburn 8551: =back
1.460 albertel 8552:
1.648 raeburn 8553: =back
1.562 albertel 8554:
1.306 albertel 8555: =cut
8556:
8557: sub start_page {
1.309 albertel 8558: my ($title,$head_extra,$args) = @_;
1.318 albertel 8559: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 8560:
1.315 albertel 8561: $env{'internal.start_page'}++;
1.1075.2.15 raeburn 8562: my ($result,@advtools);
1.964 droeschl 8563:
1.338 albertel 8564: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 8565: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 8566: }
8567:
8568: if (! exists($args->{'skip_phases'}{'body'}) ) {
8569: if ($args->{'frameset'}) {
8570: my $attr_string = &make_attr_string($args->{'force_register'},
8571: $args->{'add_entries'});
8572: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 8573: } else {
8574: $result .=
8575: &bodytag($title,
8576: $args->{'function'}, $args->{'add_entries'},
8577: $args->{'only_body'}, $args->{'domain'},
8578: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 8579: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.15 raeburn 8580: $args, \@advtools);
1.831 bisitz 8581: }
1.330 albertel 8582: }
1.338 albertel 8583:
1.315 albertel 8584: if ($args->{'js_ready'}) {
1.713 kaisler 8585: $result = &js_ready($result);
1.315 albertel 8586: }
1.320 albertel 8587: if ($args->{'html_encode'}) {
1.713 kaisler 8588: $result = &html_encode($result);
8589: }
8590:
1.813 bisitz 8591: # Preparation for new and consistent functionlist at top of screen
8592: # if ($args->{'functionlist'}) {
8593: # $result .= &build_functionlist();
8594: #}
8595:
1.964 droeschl 8596: # Don't add anything more if only_body wanted or in const space
8597: return $result if $args->{'only_body'}
8598: || $env{'request.state'} eq 'construct';
1.813 bisitz 8599:
8600: #Breadcrumbs
1.758 kaisler 8601: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
8602: &Apache::lonhtmlcommon::clear_breadcrumbs();
8603: #if any br links exists, add them to the breadcrumbs
8604: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
8605: foreach my $crumb (@{$args->{'bread_crumbs'}}){
8606: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
8607: }
8608: }
1.1075.2.19 raeburn 8609: # if @advtools array contains items add then to the breadcrumbs
8610: if (@advtools > 0) {
8611: &Apache::lonmenu::advtools_crumbs(@advtools);
8612: }
1.1075.2.123 raeburn 8613: my $menulink;
8614: # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
8615: if (exists($args->{'bread_crumbs_nomenu'})) {
8616: $menulink = 0;
8617: } else {
8618: undef($menulink);
8619: }
1.758 kaisler 8620: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
8621: if(exists($args->{'bread_crumbs_component'})){
1.1075.2.175 raeburn 8622: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},
8623: '',$menulink,'',
8624: $args->{'bread_crumbs_style'});
1.758 kaisler 8625: }else{
1.1075.2.175 raeburn 8626: $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink,'',
8627: $args->{'bread_crumbs_style'});
1.758 kaisler 8628: }
1.1075.2.24 raeburn 8629: } elsif (($env{'environment.remote'} eq 'on') &&
8630: ($env{'form.inhibitmenu'} ne 'yes') &&
8631: ($env{'request.noversionuri'} =~ m{^/res/}) &&
8632: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 8633: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 8634: }
1.315 albertel 8635: return $result;
1.306 albertel 8636: }
8637:
8638: sub end_page {
1.315 albertel 8639: my ($args) = @_;
8640: $env{'internal.end_page'}++;
1.330 albertel 8641: my $result;
1.335 albertel 8642: if ($args->{'discussion'}) {
8643: my ($target,$parser);
8644: if (ref($args->{'discussion'})) {
8645: ($target,$parser) =($args->{'discussion'}{'target'},
8646: $args->{'discussion'}{'parser'});
8647: }
8648: $result .= &Apache::lonxml::xmlend($target,$parser);
8649: }
1.330 albertel 8650: if ($args->{'frameset'}) {
8651: $result .= '</frameset>';
8652: } else {
1.635 raeburn 8653: $result .= &endbodytag($args);
1.330 albertel 8654: }
1.1075.2.6 raeburn 8655: unless ($args->{'notbody'}) {
8656: $result .= "\n</html>";
8657: }
1.330 albertel 8658:
1.315 albertel 8659: if ($args->{'js_ready'}) {
1.317 albertel 8660: $result = &js_ready($result);
1.315 albertel 8661: }
1.335 albertel 8662:
1.320 albertel 8663: if ($args->{'html_encode'}) {
8664: $result = &html_encode($result);
8665: }
1.335 albertel 8666:
1.315 albertel 8667: return $result;
8668: }
8669:
1.1034 www 8670: sub wishlist_window {
8671: return(<<'ENDWISHLIST');
1.1046 raeburn 8672: <script type="text/javascript">
1.1034 www 8673: // <![CDATA[
8674: // <!-- BEGIN LON-CAPA Internal
8675: function set_wishlistlink(title, path) {
8676: if (!title) {
8677: title = document.title;
8678: title = title.replace(/^LON-CAPA /,'');
8679: }
1.1075.2.65 raeburn 8680: title = encodeURIComponent(title);
1.1075.2.83 raeburn 8681: title = title.replace("'","\\\'");
1.1034 www 8682: if (!path) {
8683: path = location.pathname;
8684: }
1.1075.2.65 raeburn 8685: path = encodeURIComponent(path);
1.1075.2.83 raeburn 8686: path = path.replace("'","\\\'");
1.1034 www 8687: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
8688: 'wishlistNewLink','width=560,height=350,scrollbars=0');
8689: }
8690: // END LON-CAPA Internal -->
8691: // ]]>
8692: </script>
8693: ENDWISHLIST
8694: }
8695:
1.1030 www 8696: sub modal_window {
8697: return(<<'ENDMODAL');
1.1046 raeburn 8698: <script type="text/javascript">
1.1030 www 8699: // <![CDATA[
8700: // <!-- BEGIN LON-CAPA Internal
8701: var modalWindow = {
8702: parent:"body",
8703: windowId:null,
8704: content:null,
8705: width:null,
8706: height:null,
8707: close:function()
8708: {
8709: $(".LCmodal-window").remove();
8710: $(".LCmodal-overlay").remove();
8711: },
8712: open:function()
8713: {
8714: var modal = "";
8715: modal += "<div class=\"LCmodal-overlay\"></div>";
8716: 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;\">";
8717: modal += this.content;
8718: modal += "</div>";
8719:
8720: $(this.parent).append(modal);
8721:
8722: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
8723: $(".LCclose-window").click(function(){modalWindow.close();});
8724: $(".LCmodal-overlay").click(function(){modalWindow.close();});
8725: }
8726: };
1.1075.2.42 raeburn 8727: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 8728: {
1.1075.2.119 raeburn 8729: source = source.replace(/'/g,"'");
1.1030 www 8730: modalWindow.windowId = "myModal";
8731: modalWindow.width = width;
8732: modalWindow.height = height;
1.1075.2.80 raeburn 8733: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 8734: modalWindow.open();
1.1075.2.87 raeburn 8735: };
1.1030 www 8736: // END LON-CAPA Internal -->
8737: // ]]>
8738: </script>
8739: ENDMODAL
8740: }
8741:
8742: sub modal_link {
1.1075.2.42 raeburn 8743: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 8744: unless ($width) { $width=480; }
8745: unless ($height) { $height=400; }
1.1031 www 8746: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 8747: unless ($transparency) { $transparency='true'; }
8748:
1.1074 raeburn 8749: my $target_attr;
8750: if (defined($target)) {
8751: $target_attr = 'target="'.$target.'"';
8752: }
8753: return <<"ENDLINK";
1.1075.2.143 raeburn 8754: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a>
1.1074 raeburn 8755: ENDLINK
1.1030 www 8756: }
8757:
1.1032 www 8758: sub modal_adhoc_script {
1.1075.2.155 raeburn 8759: my ($funcname,$width,$height,$content,$possmathjax)=@_;
8760: my $mathjax;
8761: if ($possmathjax) {
8762: $mathjax = <<'ENDJAX';
8763: if (typeof MathJax == 'object') {
8764: MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
8765: }
8766: ENDJAX
8767: }
1.1032 www 8768: return (<<ENDADHOC);
1.1046 raeburn 8769: <script type="text/javascript">
1.1032 www 8770: // <![CDATA[
8771: var $funcname = function()
8772: {
8773: modalWindow.windowId = "myModal";
8774: modalWindow.width = $width;
8775: modalWindow.height = $height;
8776: modalWindow.content = '$content';
8777: modalWindow.open();
1.1075.2.155 raeburn 8778: $mathjax
1.1032 www 8779: };
8780: // ]]>
8781: </script>
8782: ENDADHOC
8783: }
8784:
1.1041 www 8785: sub modal_adhoc_inner {
1.1075.2.155 raeburn 8786: my ($funcname,$width,$height,$content,$possmathjax)=@_;
1.1041 www 8787: my $innerwidth=$width-20;
8788: $content=&js_ready(
1.1042 www 8789: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 8790: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
8791: $content.
1.1041 www 8792: &end_scrollbox().
1.1075.2.42 raeburn 8793: &end_page()
1.1041 www 8794: );
1.1075.2.155 raeburn 8795: return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
1.1041 www 8796: }
8797:
8798: sub modal_adhoc_window {
1.1075.2.155 raeburn 8799: my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
8800: return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
1.1041 www 8801: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
8802: }
8803:
8804: sub modal_adhoc_launch {
8805: my ($funcname,$width,$height,$content)=@_;
8806: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
8807: <script type="text/javascript">
8808: // <![CDATA[
8809: $funcname();
8810: // ]]>
8811: </script>
8812: ENDLAUNCH
8813: }
8814:
8815: sub modal_adhoc_close {
8816: return (<<ENDCLOSE);
8817: <script type="text/javascript">
8818: // <![CDATA[
8819: modalWindow.close();
8820: // ]]>
8821: </script>
8822: ENDCLOSE
8823: }
8824:
1.1038 www 8825: sub togglebox_script {
8826: return(<<ENDTOGGLE);
8827: <script type="text/javascript">
8828: // <![CDATA[
8829: function LCtoggleDisplay(id,hidetext,showtext) {
8830: link = document.getElementById(id + "link").childNodes[0];
8831: with (document.getElementById(id).style) {
8832: if (display == "none" ) {
8833: display = "inline";
8834: link.nodeValue = hidetext;
8835: } else {
8836: display = "none";
8837: link.nodeValue = showtext;
8838: }
8839: }
8840: }
8841: // ]]>
8842: </script>
8843: ENDTOGGLE
8844: }
8845:
1.1039 www 8846: sub start_togglebox {
8847: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8848: unless ($heading) { $heading=''; } else { $heading.=' '; }
8849: unless ($showtext) { $showtext=&mt('show'); }
8850: unless ($hidetext) { $hidetext=&mt('hide'); }
8851: unless ($headerbg) { $headerbg='#FFFFFF'; }
8852: return &start_data_table().
8853: &start_data_table_header_row().
8854: '<td bgcolor="'.$headerbg.'">'.$heading.
8855: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8856: $showtext.'\')">'.$showtext.'</a>]</td>'.
8857: &end_data_table_header_row().
8858: '<tr id="'.$id.'" style="display:none""><td>';
8859: }
8860:
8861: sub end_togglebox {
8862: return '</td></tr>'.&end_data_table();
8863: }
8864:
1.1041 www 8865: sub LCprogressbar_script {
1.1075.2.130 raeburn 8866: my ($id,$number_to_do)=@_;
8867: if ($number_to_do) {
8868: return(<<ENDPROGRESS);
1.1041 www 8869: <script type="text/javascript">
8870: // <![CDATA[
1.1045 www 8871: \$('#progressbar$id').progressbar({
1.1041 www 8872: value: 0,
8873: change: function(event, ui) {
8874: var newVal = \$(this).progressbar('option', 'value');
8875: \$('.pblabel', this).text(LCprogressTxt);
8876: }
8877: });
8878: // ]]>
8879: </script>
8880: ENDPROGRESS
1.1075.2.130 raeburn 8881: } else {
8882: return(<<ENDPROGRESS);
8883: <script type="text/javascript">
8884: // <![CDATA[
8885: \$('#progressbar$id').progressbar({
8886: value: false,
8887: create: function(event, ui) {
8888: \$('.ui-widget-header', this).css({'background':'#F0F0F0'});
8889: \$('.ui-progressbar-overlay', this).css({'margin':'0'});
8890: }
8891: });
8892: // ]]>
8893: </script>
8894: ENDPROGRESS
8895: }
1.1041 www 8896: }
8897:
8898: sub LCprogressbarUpdate_script {
8899: return(<<ENDPROGRESSUPDATE);
8900: <style type="text/css">
8901: .ui-progressbar { position:relative; }
1.1075.2.130 raeburn 8902: .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 8903: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8904: </style>
8905: <script type="text/javascript">
8906: // <![CDATA[
1.1045 www 8907: var LCprogressTxt='---';
8908:
1.1075.2.130 raeburn 8909: function LCupdateProgress(percent,progresstext,id,maxnum) {
1.1041 www 8910: LCprogressTxt=progresstext;
1.1075.2.130 raeburn 8911: if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) {
8912: \$('#progressbar'+id).find('.progress-label').text(LCprogressTxt);
8913: } else if (percent === \$('#progressbar'+id).progressbar( "value" )) {
8914: \$('#progressbar'+id).find('.pblabel').text(LCprogressTxt);
8915: } else {
8916: \$('#progressbar'+id).progressbar('value',percent);
8917: }
1.1041 www 8918: }
8919: // ]]>
8920: </script>
8921: ENDPROGRESSUPDATE
8922: }
8923:
1.1042 www 8924: my $LClastpercent;
1.1045 www 8925: my $LCidcnt;
8926: my $LCcurrentid;
1.1042 www 8927:
1.1041 www 8928: sub LCprogressbar {
1.1075.2.130 raeburn 8929: my ($r,$number_to_do,$preamble)=@_;
1.1042 www 8930: $LClastpercent=0;
1.1045 www 8931: $LCidcnt++;
8932: $LCcurrentid=$$.'_'.$LCidcnt;
1.1075.2.130 raeburn 8933: my ($starting,$content);
8934: if ($number_to_do) {
8935: $starting=&mt('Starting');
8936: $content=(<<ENDPROGBAR);
8937: $preamble
1.1045 www 8938: <div id="progressbar$LCcurrentid">
1.1041 www 8939: <span class="pblabel">$starting</span>
8940: </div>
8941: ENDPROGBAR
1.1075.2.130 raeburn 8942: } else {
8943: $starting=&mt('Loading...');
8944: $LClastpercent='false';
8945: $content=(<<ENDPROGBAR);
8946: $preamble
8947: <div id="progressbar$LCcurrentid">
8948: <div class="progress-label">$starting</div>
8949: </div>
8950: ENDPROGBAR
8951: }
8952: &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
1.1041 www 8953: }
8954:
8955: sub LCprogressbarUpdate {
1.1075.2.130 raeburn 8956: my ($r,$val,$text,$number_to_do)=@_;
8957: if ($number_to_do) {
8958: unless ($val) {
8959: if ($LClastpercent) {
8960: $val=$LClastpercent;
8961: } else {
8962: $val=0;
8963: }
8964: }
8965: if ($val<0) { $val=0; }
8966: if ($val>100) { $val=0; }
8967: $LClastpercent=$val;
8968: unless ($text) { $text=$val.'%'; }
8969: } else {
8970: $val = 'false';
1.1042 www 8971: }
1.1041 www 8972: $text=&js_ready($text);
1.1044 www 8973: &r_print($r,<<ENDUPDATE);
1.1041 www 8974: <script type="text/javascript">
8975: // <![CDATA[
1.1075.2.130 raeburn 8976: LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do');
1.1041 www 8977: // ]]>
8978: </script>
8979: ENDUPDATE
1.1035 www 8980: }
8981:
1.1042 www 8982: sub LCprogressbarClose {
8983: my ($r)=@_;
8984: $LClastpercent=0;
1.1044 www 8985: &r_print($r,<<ENDCLOSE);
1.1042 www 8986: <script type="text/javascript">
8987: // <![CDATA[
1.1045 www 8988: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8989: // ]]>
8990: </script>
8991: ENDCLOSE
1.1044 www 8992: }
8993:
8994: sub r_print {
8995: my ($r,$to_print)=@_;
8996: if ($r) {
8997: $r->print($to_print);
8998: $r->rflush();
8999: } else {
9000: print($to_print);
9001: }
1.1042 www 9002: }
9003:
1.320 albertel 9004: sub html_encode {
9005: my ($result) = @_;
9006:
1.322 albertel 9007: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 9008:
9009: return $result;
9010: }
1.1044 www 9011:
1.317 albertel 9012: sub js_ready {
9013: my ($result) = @_;
9014:
1.323 albertel 9015: $result =~ s/[\n\r]/ /xmsg;
9016: $result =~ s/\\/\\\\/xmsg;
9017: $result =~ s/'/\\'/xmsg;
1.372 albertel 9018: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 9019:
9020: return $result;
9021: }
9022:
1.315 albertel 9023: sub validate_page {
9024: if ( exists($env{'internal.start_page'})
1.316 albertel 9025: && $env{'internal.start_page'} > 1) {
9026: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 9027: $env{'internal.start_page'}.' '.
1.316 albertel 9028: $ENV{'request.filename'});
1.315 albertel 9029: }
9030: if ( exists($env{'internal.end_page'})
1.316 albertel 9031: && $env{'internal.end_page'} > 1) {
9032: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 9033: $env{'internal.end_page'}.' '.
1.316 albertel 9034: $env{'request.filename'});
1.315 albertel 9035: }
9036: if ( exists($env{'internal.start_page'})
9037: && ! exists($env{'internal.end_page'})) {
1.316 albertel 9038: &Apache::lonnet::logthis('start_page called without end_page '.
9039: $env{'request.filename'});
1.315 albertel 9040: }
9041: if ( ! exists($env{'internal.start_page'})
9042: && exists($env{'internal.end_page'})) {
1.316 albertel 9043: &Apache::lonnet::logthis('end_page called without start_page'.
9044: $env{'request.filename'});
1.315 albertel 9045: }
1.306 albertel 9046: }
1.315 albertel 9047:
1.996 www 9048:
9049: sub start_scrollbox {
1.1075.2.56 raeburn 9050: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 9051: unless ($outerwidth) { $outerwidth='520px'; }
9052: unless ($width) { $width='500px'; }
9053: unless ($height) { $height='200px'; }
1.1075 raeburn 9054: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 9055: if ($id ne '') {
1.1075.2.42 raeburn 9056: $table_id = ' id="table_'.$id.'"';
9057: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 9058: }
1.1075 raeburn 9059: if ($bgcolor ne '') {
9060: $tdcol = "background-color: $bgcolor;";
9061: }
1.1075.2.42 raeburn 9062: my $nicescroll_js;
9063: if ($env{'browser.mobile'}) {
9064: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
9065: }
1.1075 raeburn 9066: return <<"END";
1.1075.2.42 raeburn 9067: $nicescroll_js
9068:
9069: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 9070: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 9071: END
1.996 www 9072: }
9073:
9074: sub end_scrollbox {
1.1036 www 9075: return '</div></td></tr></table>';
1.996 www 9076: }
9077:
1.1075.2.42 raeburn 9078: sub nicescroll_javascript {
9079: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
9080: my %options;
9081: if (ref($cursor) eq 'HASH') {
9082: %options = %{$cursor};
9083: }
9084: unless ($options{'railalign'} =~ /^left|right$/) {
9085: $options{'railalign'} = 'left';
9086: }
9087: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9088: my $function = &get_users_function();
9089: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
9090: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
9091: $options{'cursorcolor'} = '#00F';
9092: }
9093: }
9094: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
9095: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
9096: $options{'cursoropacity'}='1.0';
9097: }
9098: } else {
9099: $options{'cursoropacity'}='1.0';
9100: }
9101: if ($options{'cursorfixedheight'} eq 'none') {
9102: delete($options{'cursorfixedheight'});
9103: } else {
9104: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
9105: }
9106: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
9107: delete($options{'railoffset'});
9108: }
9109: my @niceoptions;
9110: while (my($key,$value) = each(%options)) {
9111: if ($value =~ /^\{.+\}$/) {
9112: push(@niceoptions,$key.':'.$value);
9113: } else {
9114: push(@niceoptions,$key.':"'.$value.'"');
9115: }
9116: }
9117: my $nicescroll_js = '
9118: $(document).ready(
9119: function() {
9120: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
9121: }
9122: );
9123: ';
9124: if ($framecheck) {
9125: $nicescroll_js .= '
9126: function expand_div(caller) {
9127: if (top === self) {
9128: document.getElementById("'.$id.'").style.width = "auto";
9129: document.getElementById("'.$id.'").style.height = "auto";
9130: } else {
9131: try {
9132: if (parent.frames) {
9133: if (parent.frames.length > 1) {
9134: var framesrc = parent.frames[1].location.href;
9135: var currsrc = framesrc.replace(/\#.*$/,"");
9136: if ((caller == "search") || (currsrc == "'.$location.'")) {
9137: document.getElementById("'.$id.'").style.width = "auto";
9138: document.getElementById("'.$id.'").style.height = "auto";
9139: }
9140: }
9141: }
9142: } catch (e) {
9143: return;
9144: }
9145: }
9146: return;
9147: }
9148: ';
9149: }
9150: if ($needjsready) {
9151: $nicescroll_js = '
9152: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
9153: } else {
9154: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
9155: }
9156: return $nicescroll_js;
9157: }
9158:
1.318 albertel 9159: sub simple_error_page {
1.1075.2.49 raeburn 9160: my ($r,$title,$msg,$args) = @_;
9161: if (ref($args) eq 'HASH') {
9162: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
9163: } else {
9164: $msg = &mt($msg);
9165: }
9166:
1.318 albertel 9167: my $page =
9168: &Apache::loncommon::start_page($title).
1.1075.2.49 raeburn 9169: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 9170: &Apache::loncommon::end_page();
9171: if (ref($r)) {
9172: $r->print($page);
1.327 albertel 9173: return;
1.318 albertel 9174: }
9175: return $page;
9176: }
1.347 albertel 9177:
9178: {
1.610 albertel 9179: my @row_count;
1.961 onken 9180:
9181: sub start_data_table_count {
9182: unshift(@row_count, 0);
9183: return;
9184: }
9185:
9186: sub end_data_table_count {
9187: shift(@row_count);
9188: return;
9189: }
9190:
1.347 albertel 9191: sub start_data_table {
1.1018 raeburn 9192: my ($add_class,$id) = @_;
1.422 albertel 9193: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 9194: my $table_id;
9195: if (defined($id)) {
9196: $table_id = ' id="'.$id.'"';
9197: }
1.961 onken 9198: &start_data_table_count();
1.1018 raeburn 9199: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 9200: }
9201:
9202: sub end_data_table {
1.961 onken 9203: &end_data_table_count();
1.389 albertel 9204: return '</table>'."\n";;
1.347 albertel 9205: }
9206:
9207: sub start_data_table_row {
1.974 wenzelju 9208: my ($add_class, $id) = @_;
1.610 albertel 9209: $row_count[0]++;
9210: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 9211: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 9212: $id = (' id="'.$id.'"') unless ($id eq '');
9213: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 9214: }
1.471 banghart 9215:
9216: sub continue_data_table_row {
1.974 wenzelju 9217: my ($add_class, $id) = @_;
1.610 albertel 9218: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 9219: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
9220: $id = (' id="'.$id.'"') unless ($id eq '');
9221: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 9222: }
1.347 albertel 9223:
9224: sub end_data_table_row {
1.389 albertel 9225: return '</tr>'."\n";;
1.347 albertel 9226: }
1.367 www 9227:
1.421 albertel 9228: sub start_data_table_empty_row {
1.707 bisitz 9229: # $row_count[0]++;
1.421 albertel 9230: return '<tr class="LC_empty_row" >'."\n";;
9231: }
9232:
9233: sub end_data_table_empty_row {
9234: return '</tr>'."\n";;
9235: }
9236:
1.367 www 9237: sub start_data_table_header_row {
1.389 albertel 9238: return '<tr class="LC_header_row">'."\n";;
1.367 www 9239: }
9240:
9241: sub end_data_table_header_row {
1.389 albertel 9242: return '</tr>'."\n";;
1.367 www 9243: }
1.890 droeschl 9244:
9245: sub data_table_caption {
9246: my $caption = shift;
9247: return "<caption class=\"LC_caption\">$caption</caption>";
9248: }
1.347 albertel 9249: }
9250:
1.548 albertel 9251: =pod
9252:
9253: =item * &inhibit_menu_check($arg)
9254:
9255: Checks for a inhibitmenu state and generates output to preserve it
9256:
9257: Inputs: $arg - can be any of
9258: - undef - in which case the return value is a string
9259: to add into arguments list of a uri
9260: - 'input' - in which case the return value is a HTML
9261: <form> <input> field of type hidden to
9262: preserve the value
9263: - a url - in which case the return value is the url with
9264: the neccesary cgi args added to preserve the
9265: inhibitmenu state
9266: - a ref to a url - no return value, but the string is
9267: updated to include the neccessary cgi
9268: args to preserve the inhibitmenu state
9269:
9270: =cut
9271:
9272: sub inhibit_menu_check {
9273: my ($arg) = @_;
9274: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
9275: if ($arg eq 'input') {
9276: if ($env{'form.inhibitmenu'}) {
9277: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
9278: } else {
9279: return
9280: }
9281: }
9282: if ($env{'form.inhibitmenu'}) {
9283: if (ref($arg)) {
9284: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9285: } elsif ($arg eq '') {
9286: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
9287: } else {
9288: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
9289: }
9290: }
9291: if (!ref($arg)) {
9292: return $arg;
9293: }
9294: }
9295:
1.251 albertel 9296: ###############################################
1.182 matthew 9297:
9298: =pod
9299:
1.549 albertel 9300: =back
9301:
9302: =head1 User Information Routines
9303:
9304: =over 4
9305:
1.405 albertel 9306: =item * &get_users_function()
1.182 matthew 9307:
9308: Used by &bodytag to determine the current users primary role.
9309: Returns either 'student','coordinator','admin', or 'author'.
9310:
9311: =cut
9312:
9313: ###############################################
9314: sub get_users_function {
1.815 tempelho 9315: my $function = 'norole';
1.818 tempelho 9316: if ($env{'request.role'}=~/^(st)/) {
9317: $function='student';
9318: }
1.907 raeburn 9319: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 9320: $function='coordinator';
9321: }
1.258 albertel 9322: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 9323: $function='admin';
9324: }
1.826 bisitz 9325: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 9326: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 9327: $function='author';
9328: }
9329: return $function;
1.54 www 9330: }
1.99 www 9331:
9332: ###############################################
9333:
1.233 raeburn 9334: =pod
9335:
1.821 raeburn 9336: =item * &show_course()
9337:
9338: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
9339: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
9340:
9341: Inputs:
9342: None
9343:
9344: Outputs:
9345: Scalar: 1 if 'Course' to be used, 0 otherwise.
9346:
9347: =cut
9348:
9349: ###############################################
9350: sub show_course {
9351: my $course = !$env{'user.adv'};
9352: if (!$env{'user.adv'}) {
9353: foreach my $env (keys(%env)) {
9354: next if ($env !~ m/^user\.priv\./);
9355: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
9356: $course = 0;
9357: last;
9358: }
9359: }
9360: }
9361: return $course;
9362: }
9363:
9364: ###############################################
9365:
9366: =pod
9367:
1.542 raeburn 9368: =item * &check_user_status()
1.274 raeburn 9369:
9370: Determines current status of supplied role for a
9371: specific user. Roles can be active, previous or future.
9372:
9373: Inputs:
9374: user's domain, user's username, course's domain,
1.375 raeburn 9375: course's number, optional section ID.
1.274 raeburn 9376:
9377: Outputs:
9378: role status: active, previous or future.
9379:
9380: =cut
9381:
9382: sub check_user_status {
1.412 raeburn 9383: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 9384: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85 raeburn 9385: my @uroles = keys(%userinfo);
1.274 raeburn 9386: my $srchstr;
9387: my $active_chk = 'none';
1.412 raeburn 9388: my $now = time;
1.274 raeburn 9389: if (@uroles > 0) {
1.908 raeburn 9390: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 9391: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
9392: } else {
1.412 raeburn 9393: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
9394: }
9395: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 9396: my $role_end = 0;
9397: my $role_start = 0;
9398: $active_chk = 'active';
1.412 raeburn 9399: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
9400: $role_end = $1;
9401: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
9402: $role_start = $1;
1.274 raeburn 9403: }
9404: }
9405: if ($role_start > 0) {
1.412 raeburn 9406: if ($now < $role_start) {
1.274 raeburn 9407: $active_chk = 'future';
9408: }
9409: }
9410: if ($role_end > 0) {
1.412 raeburn 9411: if ($now > $role_end) {
1.274 raeburn 9412: $active_chk = 'previous';
9413: }
9414: }
9415: }
9416: }
9417: return $active_chk;
9418: }
9419:
9420: ###############################################
9421:
9422: =pod
9423:
1.405 albertel 9424: =item * &get_sections()
1.233 raeburn 9425:
9426: Determines all the sections for a course including
9427: sections with students and sections containing other roles.
1.419 raeburn 9428: Incoming parameters:
9429:
9430: 1. domain
9431: 2. course number
9432: 3. reference to array containing roles for which sections should
9433: be gathered (optional).
9434: 4. reference to array containing status types for which sections
9435: should be gathered (optional).
9436:
9437: If the third argument is undefined, sections are gathered for any role.
9438: If the fourth argument is undefined, sections are gathered for any status.
9439: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 9440:
1.374 raeburn 9441: Returns section hash (keys are section IDs, values are
9442: number of users in each section), subject to the
1.419 raeburn 9443: optional roles filter, optional status filter
1.233 raeburn 9444:
9445: =cut
9446:
9447: ###############################################
9448: sub get_sections {
1.419 raeburn 9449: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 9450: if (!defined($cdom) || !defined($cnum)) {
9451: my $cid = $env{'request.course.id'};
9452:
9453: return if (!defined($cid));
9454:
9455: $cdom = $env{'course.'.$cid.'.domain'};
9456: $cnum = $env{'course.'.$cid.'.num'};
9457: }
9458:
9459: my %sectioncount;
1.419 raeburn 9460: my $now = time;
1.240 albertel 9461:
1.1075.2.33 raeburn 9462: my $check_students = 1;
9463: my $only_students = 0;
9464: if (ref($possible_roles) eq 'ARRAY') {
9465: if (grep(/^st$/,@{$possible_roles})) {
9466: if (@{$possible_roles} == 1) {
9467: $only_students = 1;
9468: }
9469: } else {
9470: $check_students = 0;
9471: }
9472: }
9473:
9474: if ($check_students) {
1.276 albertel 9475: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 9476: my $sec_index = &Apache::loncoursedata::CL_SECTION();
9477: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 9478: my $start_index = &Apache::loncoursedata::CL_START();
9479: my $end_index = &Apache::loncoursedata::CL_END();
9480: my $status;
1.366 albertel 9481: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 9482: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
9483: $data->[$status_index],
9484: $data->[$start_index],
9485: $data->[$end_index]);
9486: if ($stu_status eq 'Active') {
9487: $status = 'active';
9488: } elsif ($end < $now) {
9489: $status = 'previous';
9490: } elsif ($start > $now) {
9491: $status = 'future';
9492: }
9493: if ($section ne '-1' && $section !~ /^\s*$/) {
9494: if ((!defined($possible_status)) || (($status ne '') &&
9495: (grep/^\Q$status\E$/,@{$possible_status}))) {
9496: $sectioncount{$section}++;
9497: }
1.240 albertel 9498: }
9499: }
9500: }
1.1075.2.33 raeburn 9501: if ($only_students) {
9502: return %sectioncount;
9503: }
1.240 albertel 9504: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9505: foreach my $user (sort(keys(%courseroles))) {
9506: if ($user !~ /^(\w{2})/) { next; }
9507: my ($role) = ($user =~ /^(\w{2})/);
9508: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 9509: my ($section,$status);
1.240 albertel 9510: if ($role eq 'cr' &&
9511: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
9512: $section=$1;
9513: }
9514: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
9515: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 9516: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
9517: if ($end == -1 && $start == -1) {
9518: next; #deleted role
9519: }
9520: if (!defined($possible_status)) {
9521: $sectioncount{$section}++;
9522: } else {
9523: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
9524: $status = 'active';
9525: } elsif ($end < $now) {
9526: $status = 'future';
9527: } elsif ($start > $now) {
9528: $status = 'previous';
9529: }
9530: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
9531: $sectioncount{$section}++;
9532: }
9533: }
1.233 raeburn 9534: }
1.366 albertel 9535: return %sectioncount;
1.233 raeburn 9536: }
9537:
1.274 raeburn 9538: ###############################################
1.294 raeburn 9539:
9540: =pod
1.405 albertel 9541:
9542: =item * &get_course_users()
9543:
1.275 raeburn 9544: Retrieves usernames:domains for users in the specified course
9545: with specific role(s), and access status.
9546:
9547: Incoming parameters:
1.277 albertel 9548: 1. course domain
9549: 2. course number
9550: 3. access status: users must have - either active,
1.275 raeburn 9551: previous, future, or all.
1.277 albertel 9552: 4. reference to array of permissible roles
1.288 raeburn 9553: 5. reference to array of section restrictions (optional)
9554: 6. reference to results object (hash of hashes).
9555: 7. reference to optional userdata hash
1.609 raeburn 9556: 8. reference to optional statushash
1.630 raeburn 9557: 9. flag if privileged users (except those set to unhide in
9558: course settings) should be excluded
1.609 raeburn 9559: Keys of top level results hash are roles.
1.275 raeburn 9560: Keys of inner hashes are username:domain, with
9561: values set to access type.
1.288 raeburn 9562: Optional userdata hash returns an array with arguments in the
9563: same order as loncoursedata::get_classlist() for student data.
9564:
1.609 raeburn 9565: Optional statushash returns
9566:
1.288 raeburn 9567: Entries for end, start, section and status are blank because
9568: of the possibility of multiple values for non-student roles.
9569:
1.275 raeburn 9570: =cut
1.405 albertel 9571:
1.275 raeburn 9572: ###############################################
1.405 albertel 9573:
1.275 raeburn 9574: sub get_course_users {
1.630 raeburn 9575: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 9576: my %idx = ();
1.419 raeburn 9577: my %seclists;
1.288 raeburn 9578:
9579: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
9580: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
9581: $idx{end} = &Apache::loncoursedata::CL_END();
9582: $idx{start} = &Apache::loncoursedata::CL_START();
9583: $idx{id} = &Apache::loncoursedata::CL_ID();
9584: $idx{section} = &Apache::loncoursedata::CL_SECTION();
9585: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
9586: $idx{status} = &Apache::loncoursedata::CL_STATUS();
9587:
1.290 albertel 9588: if (grep(/^st$/,@{$roles})) {
1.276 albertel 9589: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 9590: my $now = time;
1.277 albertel 9591: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 9592: my $match = 0;
1.412 raeburn 9593: my $secmatch = 0;
1.419 raeburn 9594: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 9595: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 9596: if ($section eq '') {
9597: $section = 'none';
9598: }
1.291 albertel 9599: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9600: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9601: $secmatch = 1;
9602: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 9603: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9604: $secmatch = 1;
9605: }
9606: } else {
1.419 raeburn 9607: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 9608: $secmatch = 1;
9609: }
1.290 albertel 9610: }
1.412 raeburn 9611: if (!$secmatch) {
9612: next;
9613: }
1.419 raeburn 9614: }
1.275 raeburn 9615: if (defined($$types{'active'})) {
1.288 raeburn 9616: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 9617: push(@{$$users{st}{$student}},'active');
1.288 raeburn 9618: $match = 1;
1.275 raeburn 9619: }
9620: }
9621: if (defined($$types{'previous'})) {
1.609 raeburn 9622: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 9623: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 9624: $match = 1;
1.275 raeburn 9625: }
9626: }
9627: if (defined($$types{'future'})) {
1.609 raeburn 9628: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 9629: push(@{$$users{st}{$student}},'future');
1.288 raeburn 9630: $match = 1;
1.275 raeburn 9631: }
9632: }
1.609 raeburn 9633: if ($match) {
9634: push(@{$seclists{$student}},$section);
9635: if (ref($userdata) eq 'HASH') {
9636: $$userdata{$student} = $$classlist{$student};
9637: }
9638: if (ref($statushash) eq 'HASH') {
9639: $statushash->{$student}{'st'}{$section} = $status;
9640: }
1.288 raeburn 9641: }
1.275 raeburn 9642: }
9643: }
1.412 raeburn 9644: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 9645: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9646: my $now = time;
1.609 raeburn 9647: my %displaystatus = ( previous => 'Expired',
9648: active => 'Active',
9649: future => 'Future',
9650: );
1.1075.2.36 raeburn 9651: my (%nothide,@possdoms);
1.630 raeburn 9652: if ($hidepriv) {
9653: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
9654: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
9655: if ($user !~ /:/) {
9656: $nothide{join(':',split(/[\@]/,$user))}=1;
9657: } else {
9658: $nothide{$user} = 1;
9659: }
9660: }
1.1075.2.36 raeburn 9661: my @possdoms = ($cdom);
9662: if ($coursehash{'checkforpriv'}) {
9663: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
9664: }
1.630 raeburn 9665: }
1.439 raeburn 9666: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 9667: my $match = 0;
1.412 raeburn 9668: my $secmatch = 0;
1.439 raeburn 9669: my $status;
1.412 raeburn 9670: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 9671: $user =~ s/:$//;
1.439 raeburn 9672: my ($end,$start) = split(/:/,$coursepersonnel{$person});
9673: if ($end == -1 || $start == -1) {
9674: next;
9675: }
9676: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
9677: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 9678: my ($uname,$udom) = split(/:/,$user);
9679: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 9680: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 9681: $secmatch = 1;
9682: } elsif ($usec eq '') {
1.420 albertel 9683: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 9684: $secmatch = 1;
9685: }
9686: } else {
9687: if (grep(/^\Q$usec\E$/,@{$sections})) {
9688: $secmatch = 1;
9689: }
9690: }
9691: if (!$secmatch) {
9692: next;
9693: }
1.288 raeburn 9694: }
1.419 raeburn 9695: if ($usec eq '') {
9696: $usec = 'none';
9697: }
1.275 raeburn 9698: if ($uname ne '' && $udom ne '') {
1.630 raeburn 9699: if ($hidepriv) {
1.1075.2.36 raeburn 9700: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 9701: (!$nothide{$uname.':'.$udom})) {
9702: next;
9703: }
9704: }
1.503 raeburn 9705: if ($end > 0 && $end < $now) {
1.439 raeburn 9706: $status = 'previous';
9707: } elsif ($start > $now) {
9708: $status = 'future';
9709: } else {
9710: $status = 'active';
9711: }
1.277 albertel 9712: foreach my $type (keys(%{$types})) {
1.275 raeburn 9713: if ($status eq $type) {
1.420 albertel 9714: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 9715: push(@{$$users{$role}{$user}},$type);
9716: }
1.288 raeburn 9717: $match = 1;
9718: }
9719: }
1.419 raeburn 9720: if (($match) && (ref($userdata) eq 'HASH')) {
9721: if (!exists($$userdata{$uname.':'.$udom})) {
9722: &get_user_info($udom,$uname,\%idx,$userdata);
9723: }
1.420 albertel 9724: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 9725: push(@{$seclists{$uname.':'.$udom}},$usec);
9726: }
1.609 raeburn 9727: if (ref($statushash) eq 'HASH') {
9728: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
9729: }
1.275 raeburn 9730: }
9731: }
9732: }
9733: }
1.290 albertel 9734: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 9735: if ((defined($cdom)) && (defined($cnum))) {
9736: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
9737: if ( defined($csettings{'internal.courseowner'}) ) {
9738: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 9739: next if ($owner eq '');
9740: my ($ownername,$ownerdom);
9741: if ($owner =~ /^([^:]+):([^:]+)$/) {
9742: $ownername = $1;
9743: $ownerdom = $2;
9744: } else {
9745: $ownername = $owner;
9746: $ownerdom = $cdom;
9747: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 9748: }
9749: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 9750: if (defined($userdata) &&
1.609 raeburn 9751: !exists($$userdata{$owner})) {
9752: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
9753: if (!grep(/^none$/,@{$seclists{$owner}})) {
9754: push(@{$seclists{$owner}},'none');
9755: }
9756: if (ref($statushash) eq 'HASH') {
9757: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 9758: }
1.290 albertel 9759: }
1.279 raeburn 9760: }
9761: }
9762: }
1.419 raeburn 9763: foreach my $user (keys(%seclists)) {
9764: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
9765: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
9766: }
1.275 raeburn 9767: }
9768: return;
9769: }
9770:
1.288 raeburn 9771: sub get_user_info {
9772: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 9773: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
9774: &plainname($uname,$udom,'lastname');
1.291 albertel 9775: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 9776: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 9777: my %idhash = &Apache::lonnet::idrget($udom,($uname));
9778: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 9779: return;
9780: }
1.275 raeburn 9781:
1.472 raeburn 9782: ###############################################
9783:
9784: =pod
9785:
9786: =item * &get_user_quota()
9787:
1.1075.2.41 raeburn 9788: Retrieves quota assigned for storage of user files.
9789: Default is to report quota for portfolio files.
1.472 raeburn 9790:
9791: Incoming parameters:
9792: 1. user's username
9793: 2. user's domain
1.1075.2.41 raeburn 9794: 3. quota name - portfolio, author, or course
9795: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 9796: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 9797: course
1.472 raeburn 9798:
9799: Returns:
1.1075.2.58 raeburn 9800: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 9801: 2. (Optional) Type of setting: custom or default
9802: (individually assigned or default for user's
9803: institutional status).
9804: 3. (Optional) - User's institutional status (e.g., faculty, staff
9805: or student - types as defined in localenroll::inst_usertypes
9806: for user's domain, which determines default quota for user.
9807: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 9808:
9809: If a value has been stored in the user's environment,
1.536 raeburn 9810: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 9811: defined for the user's institutional status(es) in the domain.
1.472 raeburn 9812:
9813: =cut
9814:
9815: ###############################################
9816:
9817:
9818: sub get_user_quota {
1.1075.2.42 raeburn 9819: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 9820: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 9821: if (!defined($udom)) {
9822: $udom = $env{'user.domain'};
9823: }
9824: if (!defined($uname)) {
9825: $uname = $env{'user.name'};
9826: }
9827: if (($udom eq '' || $uname eq '') ||
9828: ($udom eq 'public') && ($uname eq 'public')) {
9829: $quota = 0;
1.536 raeburn 9830: $quotatype = 'default';
9831: $defquota = 0;
1.472 raeburn 9832: } else {
1.536 raeburn 9833: my $inststatus;
1.1075.2.41 raeburn 9834: if ($quotaname eq 'course') {
9835: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
9836: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
9837: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
9838: } else {
9839: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
9840: $quota = $cenv{'internal.uploadquota'};
9841: }
1.536 raeburn 9842: } else {
1.1075.2.41 raeburn 9843: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
9844: if ($quotaname eq 'author') {
9845: $quota = $env{'environment.authorquota'};
9846: } else {
9847: $quota = $env{'environment.portfolioquota'};
9848: }
9849: $inststatus = $env{'environment.inststatus'};
9850: } else {
9851: my %userenv =
9852: &Apache::lonnet::get('environment',['portfolioquota',
9853: 'authorquota','inststatus'],$udom,$uname);
9854: my ($tmp) = keys(%userenv);
9855: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
9856: if ($quotaname eq 'author') {
9857: $quota = $userenv{'authorquota'};
9858: } else {
9859: $quota = $userenv{'portfolioquota'};
9860: }
9861: $inststatus = $userenv{'inststatus'};
9862: } else {
9863: undef(%userenv);
9864: }
9865: }
9866: }
9867: if ($quota eq '' || wantarray) {
9868: if ($quotaname eq 'course') {
9869: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 9870: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
9871: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 9872: $defquota = $domdefs{$crstype.'quota'};
9873: }
9874: if ($defquota eq '') {
9875: $defquota = 500;
9876: }
1.1075.2.41 raeburn 9877: } else {
9878: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
9879: }
9880: if ($quota eq '') {
9881: $quota = $defquota;
9882: $quotatype = 'default';
9883: } else {
9884: $quotatype = 'custom';
9885: }
1.472 raeburn 9886: }
9887: }
1.536 raeburn 9888: if (wantarray) {
9889: return ($quota,$quotatype,$settingstatus,$defquota);
9890: } else {
9891: return $quota;
9892: }
1.472 raeburn 9893: }
9894:
9895: ###############################################
9896:
9897: =pod
9898:
9899: =item * &default_quota()
9900:
1.536 raeburn 9901: Retrieves default quota assigned for storage of user portfolio files,
9902: given an (optional) user's institutional status.
1.472 raeburn 9903:
9904: Incoming parameters:
1.1075.2.42 raeburn 9905:
1.472 raeburn 9906: 1. domain
1.536 raeburn 9907: 2. (Optional) institutional status(es). This is a : separated list of
9908: status types (e.g., faculty, staff, student etc.)
9909: which apply to the user for whom the default is being retrieved.
9910: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 9911: default quota will be returned.
9912: 3. quota name - portfolio, author, or course
9913: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9914:
9915: Returns:
1.1075.2.42 raeburn 9916:
1.1075.2.58 raeburn 9917: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9918: 2. (Optional) institutional type which determined the value of the
9919: default quota.
1.472 raeburn 9920:
9921: If a value has been stored in the domain's configuration db,
9922: it will return that, otherwise it returns 20 (for backwards
9923: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 9924: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9925:
1.536 raeburn 9926: If the user's status includes multiple types (e.g., staff and student),
9927: the largest default quota which applies to the user determines the
9928: default quota returned.
9929:
1.472 raeburn 9930: =cut
9931:
9932: ###############################################
9933:
9934:
9935: sub default_quota {
1.1075.2.41 raeburn 9936: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9937: my ($defquota,$settingstatus);
9938: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9939: ['quotas'],$udom);
1.1075.2.41 raeburn 9940: my $key = 'defaultquota';
9941: if ($quotaname eq 'author') {
9942: $key = 'authorquota';
9943: }
1.622 raeburn 9944: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9945: if ($inststatus ne '') {
1.765 raeburn 9946: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9947: foreach my $item (@statuses) {
1.1075.2.41 raeburn 9948: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9949: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9950: if ($defquota eq '') {
1.1075.2.41 raeburn 9951: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9952: $settingstatus = $item;
1.1075.2.41 raeburn 9953: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9954: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9955: $settingstatus = $item;
9956: }
9957: }
1.1075.2.41 raeburn 9958: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9959: if ($quotahash{'quotas'}{$item} ne '') {
9960: if ($defquota eq '') {
9961: $defquota = $quotahash{'quotas'}{$item};
9962: $settingstatus = $item;
9963: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9964: $defquota = $quotahash{'quotas'}{$item};
9965: $settingstatus = $item;
9966: }
1.536 raeburn 9967: }
9968: }
9969: }
9970: }
9971: if ($defquota eq '') {
1.1075.2.41 raeburn 9972: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9973: $defquota = $quotahash{'quotas'}{$key}{'default'};
9974: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9975: $defquota = $quotahash{'quotas'}{'default'};
9976: }
1.536 raeburn 9977: $settingstatus = 'default';
1.1075.2.42 raeburn 9978: if ($defquota eq '') {
9979: if ($quotaname eq 'author') {
9980: $defquota = 500;
9981: }
9982: }
1.536 raeburn 9983: }
9984: } else {
9985: $settingstatus = 'default';
1.1075.2.41 raeburn 9986: if ($quotaname eq 'author') {
9987: $defquota = 500;
9988: } else {
9989: $defquota = 20;
9990: }
1.536 raeburn 9991: }
9992: if (wantarray) {
9993: return ($defquota,$settingstatus);
1.472 raeburn 9994: } else {
1.536 raeburn 9995: return $defquota;
1.472 raeburn 9996: }
9997: }
9998:
1.1075.2.41 raeburn 9999: ###############################################
10000:
10001: =pod
10002:
1.1075.2.42 raeburn 10003: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 10004:
10005: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 10006: of existing file within authoring space will cause quota for the authoring
10007: space to be exceeded.
10008:
10009: Same, if upload of a file directly to a course/community via Course Editor
10010: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 10011:
1.1075.2.61 raeburn 10012: Inputs: 7
1.1075.2.42 raeburn 10013: 1. username or coursenum
1.1075.2.41 raeburn 10014: 2. domain
1.1075.2.42 raeburn 10015: 3. context ('author' or 'course')
1.1075.2.41 raeburn 10016: 4. filename of file for which action is being requested
10017: 5. filesize (kB) of file
10018: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 10019: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 10020:
10021: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
10022: otherwise return null.
10023:
1.1075.2.42 raeburn 10024: =back
10025:
1.1075.2.41 raeburn 10026: =cut
10027:
1.1075.2.42 raeburn 10028: sub excess_filesize_warning {
1.1075.2.59 raeburn 10029: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 10030: my $current_disk_usage = 0;
1.1075.2.59 raeburn 10031: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 10032: if ($context eq 'author') {
10033: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
10034: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
10035: } else {
10036: foreach my $subdir ('docs','supplemental') {
10037: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
10038: }
10039: }
1.1075.2.41 raeburn 10040: $disk_quota = int($disk_quota * 1000);
10041: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69 raeburn 10042: return '<p class="LC_warning">'.
1.1075.2.41 raeburn 10043: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69 raeburn 10044: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
10045: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41 raeburn 10046: $disk_quota,$current_disk_usage).
10047: '</p>';
10048: }
10049: return;
10050: }
10051:
10052: ###############################################
10053:
10054:
1.384 raeburn 10055: sub get_secgrprole_info {
10056: my ($cdom,$cnum,$needroles,$type) = @_;
10057: my %sections_count = &get_sections($cdom,$cnum);
10058: my @sections = (sort {$a <=> $b} keys(%sections_count));
10059: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
10060: my @groups = sort(keys(%curr_groups));
10061: my $allroles = [];
10062: my $rolehash;
10063: my $accesshash = {
10064: active => 'Currently has access',
10065: future => 'Will have future access',
10066: previous => 'Previously had access',
10067: };
10068: if ($needroles) {
10069: $rolehash = {'all' => 'all'};
1.385 albertel 10070: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
10071: if (&Apache::lonnet::error(%user_roles)) {
10072: undef(%user_roles);
10073: }
10074: foreach my $item (keys(%user_roles)) {
1.384 raeburn 10075: my ($role)=split(/\:/,$item,2);
10076: if ($role eq 'cr') { next; }
10077: if ($role =~ /^cr/) {
10078: $$rolehash{$role} = (split('/',$role))[3];
10079: } else {
10080: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
10081: }
10082: }
10083: foreach my $key (sort(keys(%{$rolehash}))) {
10084: push(@{$allroles},$key);
10085: }
10086: push (@{$allroles},'st');
10087: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
10088: }
10089: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
10090: }
10091:
1.555 raeburn 10092: sub user_picker {
1.1075.2.127 raeburn 10093: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
1.555 raeburn 10094: my $currdom = $dom;
1.1075.2.114 raeburn 10095: my @alldoms = &Apache::lonnet::all_domains();
10096: if (@alldoms == 1) {
10097: my %domsrch = &Apache::lonnet::get_dom('configuration',
10098: ['directorysrch'],$alldoms[0]);
10099: my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
10100: my $showdom = $domdesc;
10101: if ($showdom eq '') {
10102: $showdom = $dom;
10103: }
10104: if (ref($domsrch{'directorysrch'}) eq 'HASH') {
10105: if ((!$domsrch{'directorysrch'}{'available'}) &&
10106: ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
10107: return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
10108: }
10109: }
10110: }
1.555 raeburn 10111: my %curr_selected = (
10112: srchin => 'dom',
1.580 raeburn 10113: srchby => 'lastname',
1.555 raeburn 10114: );
10115: my $srchterm;
1.625 raeburn 10116: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 10117: if ($srch->{'srchby'} ne '') {
10118: $curr_selected{'srchby'} = $srch->{'srchby'};
10119: }
10120: if ($srch->{'srchin'} ne '') {
10121: $curr_selected{'srchin'} = $srch->{'srchin'};
10122: }
10123: if ($srch->{'srchtype'} ne '') {
10124: $curr_selected{'srchtype'} = $srch->{'srchtype'};
10125: }
10126: if ($srch->{'srchdomain'} ne '') {
10127: $currdom = $srch->{'srchdomain'};
10128: }
10129: $srchterm = $srch->{'srchterm'};
10130: }
1.1075.2.98 raeburn 10131: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 10132: 'usr' => 'Search criteria',
1.563 raeburn 10133: 'doma' => 'Domain/institution to search',
1.558 albertel 10134: 'uname' => 'username',
10135: 'lastname' => 'last name',
1.555 raeburn 10136: 'lastfirst' => 'last name, first name',
1.558 albertel 10137: 'crs' => 'in this course',
1.576 raeburn 10138: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 10139: 'alc' => 'all LON-CAPA',
1.573 raeburn 10140: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 10141: 'exact' => 'is',
10142: 'contains' => 'contains',
1.569 raeburn 10143: 'begins' => 'begins with',
1.1075.2.98 raeburn 10144: );
10145: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 10146: 'youm' => "You must include some text to search for.",
10147: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
10148: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
10149: 'yomc' => "You must choose a domain when using an institutional directory search.",
10150: 'ymcd' => "You must choose a domain when using a domain search.",
10151: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
10152: 'whse' => "When searching by last,first you must include at least one character in the first name.",
10153: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 10154: );
1.1075.2.98 raeburn 10155: &html_escape(\%html_lt);
10156: &js_escape(\%js_lt);
1.1075.2.115 raeburn 10157: my $domform;
1.1075.2.126 raeburn 10158: my $allow_blank = 1;
1.1075.2.115 raeburn 10159: if ($fixeddom) {
1.1075.2.126 raeburn 10160: $allow_blank = 0;
10161: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
1.1075.2.115 raeburn 10162: } else {
1.1075.2.126 raeburn 10163: $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
1.1075.2.115 raeburn 10164: }
1.563 raeburn 10165: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 10166:
10167: my @srchins = ('crs','dom','alc','instd');
10168:
10169: foreach my $option (@srchins) {
10170: # FIXME 'alc' option unavailable until
10171: # loncreateuser::print_user_query_page()
10172: # has been completed.
10173: next if ($option eq 'alc');
1.880 raeburn 10174: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 10175: next if ($option eq 'crs' && !$env{'request.course.id'});
1.1075.2.127 raeburn 10176: next if (($option eq 'instd') && ($noinstd));
1.563 raeburn 10177: if ($curr_selected{'srchin'} eq $option) {
10178: $srchinsel .= '
1.1075.2.98 raeburn 10179: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 10180: } else {
10181: $srchinsel .= '
1.1075.2.98 raeburn 10182: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 10183: }
1.555 raeburn 10184: }
1.563 raeburn 10185: $srchinsel .= "\n </select>\n";
1.555 raeburn 10186:
10187: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 10188: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 10189: if ($curr_selected{'srchby'} eq $option) {
10190: $srchbysel .= '
1.1075.2.98 raeburn 10191: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10192: } else {
10193: $srchbysel .= '
1.1075.2.98 raeburn 10194: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10195: }
10196: }
10197: $srchbysel .= "\n </select>\n";
10198:
10199: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 10200: foreach my $option ('begins','contains','exact') {
1.555 raeburn 10201: if ($curr_selected{'srchtype'} eq $option) {
10202: $srchtypesel .= '
1.1075.2.98 raeburn 10203: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 10204: } else {
10205: $srchtypesel .= '
1.1075.2.98 raeburn 10206: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 10207: }
10208: }
10209: $srchtypesel .= "\n </select>\n";
10210:
1.558 albertel 10211: my ($newuserscript,$new_user_create);
1.994 raeburn 10212: my $context_dom = $env{'request.role.domain'};
10213: if ($context eq 'requestcrs') {
10214: if ($env{'form.coursedom'} ne '') {
10215: $context_dom = $env{'form.coursedom'};
10216: }
10217: }
1.556 raeburn 10218: if ($forcenewuser) {
1.576 raeburn 10219: if (ref($srch) eq 'HASH') {
1.994 raeburn 10220: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 10221: if ($cancreate) {
10222: $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>';
10223: } else {
1.799 bisitz 10224: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 10225: my %usertypetext = (
10226: official => 'institutional',
10227: unofficial => 'non-institutional',
10228: );
1.799 bisitz 10229: $new_user_create = '<p class="LC_warning">'
10230: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
10231: .' '
10232: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
10233: ,'<a href="'.$helplink.'">','</a>')
10234: .'</p><br />';
1.627 raeburn 10235: }
1.576 raeburn 10236: }
10237: }
10238:
1.556 raeburn 10239: $newuserscript = <<"ENDSCRIPT";
10240:
1.570 raeburn 10241: function setSearch(createnew,callingForm) {
1.556 raeburn 10242: if (createnew == 1) {
1.570 raeburn 10243: for (var i=0; i<callingForm.srchby.length; i++) {
10244: if (callingForm.srchby.options[i].value == 'uname') {
10245: callingForm.srchby.selectedIndex = i;
1.556 raeburn 10246: }
10247: }
1.570 raeburn 10248: for (var i=0; i<callingForm.srchin.length; i++) {
10249: if ( callingForm.srchin.options[i].value == 'dom') {
10250: callingForm.srchin.selectedIndex = i;
1.556 raeburn 10251: }
10252: }
1.570 raeburn 10253: for (var i=0; i<callingForm.srchtype.length; i++) {
10254: if (callingForm.srchtype.options[i].value == 'exact') {
10255: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 10256: }
10257: }
1.570 raeburn 10258: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 10259: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 10260: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 10261: }
10262: }
10263: }
10264: }
10265: ENDSCRIPT
1.558 albertel 10266:
1.556 raeburn 10267: }
10268:
1.555 raeburn 10269: my $output = <<"END_BLOCK";
1.556 raeburn 10270: <script type="text/javascript">
1.824 bisitz 10271: // <![CDATA[
1.570 raeburn 10272: function validateEntry(callingForm) {
1.558 albertel 10273:
1.556 raeburn 10274: var checkok = 1;
1.558 albertel 10275: var srchin;
1.570 raeburn 10276: for (var i=0; i<callingForm.srchin.length; i++) {
10277: if ( callingForm.srchin[i].checked ) {
10278: srchin = callingForm.srchin[i].value;
1.558 albertel 10279: }
10280: }
10281:
1.570 raeburn 10282: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
10283: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
10284: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
10285: var srchterm = callingForm.srchterm.value;
10286: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 10287: var msg = "";
10288:
10289: if (srchterm == "") {
10290: checkok = 0;
1.1075.2.98 raeburn 10291: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 10292: }
10293:
1.569 raeburn 10294: if (srchtype== 'begins') {
10295: if (srchterm.length < 2) {
10296: checkok = 0;
1.1075.2.98 raeburn 10297: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 10298: }
10299: }
10300:
1.556 raeburn 10301: if (srchtype== 'contains') {
10302: if (srchterm.length < 3) {
10303: checkok = 0;
1.1075.2.98 raeburn 10304: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 10305: }
10306: }
10307: if (srchin == 'instd') {
10308: if (srchdomain == '') {
10309: checkok = 0;
1.1075.2.98 raeburn 10310: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 10311: }
10312: }
10313: if (srchin == 'dom') {
10314: if (srchdomain == '') {
10315: checkok = 0;
1.1075.2.98 raeburn 10316: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 10317: }
10318: }
10319: if (srchby == 'lastfirst') {
10320: if (srchterm.indexOf(",") == -1) {
10321: checkok = 0;
1.1075.2.98 raeburn 10322: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 10323: }
10324: if (srchterm.indexOf(",") == srchterm.length -1) {
10325: checkok = 0;
1.1075.2.98 raeburn 10326: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 10327: }
10328: }
10329: if (checkok == 0) {
1.1075.2.98 raeburn 10330: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 10331: return;
10332: }
10333: if (checkok == 1) {
1.570 raeburn 10334: callingForm.submit();
1.556 raeburn 10335: }
10336: }
10337:
10338: $newuserscript
10339:
1.824 bisitz 10340: // ]]>
1.556 raeburn 10341: </script>
1.558 albertel 10342:
10343: $new_user_create
10344:
1.555 raeburn 10345: END_BLOCK
1.558 albertel 10346:
1.876 raeburn 10347: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98 raeburn 10348: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 10349: $domform.
10350: &Apache::lonhtmlcommon::row_closure().
1.1075.2.98 raeburn 10351: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 10352: $srchbysel.
10353: $srchtypesel.
10354: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
10355: $srchinsel.
10356: &Apache::lonhtmlcommon::row_closure(1).
10357: &Apache::lonhtmlcommon::end_pick_box().
10358: '<br />';
1.1075.2.114 raeburn 10359: return ($output,1);
1.555 raeburn 10360: }
10361:
1.612 raeburn 10362: sub user_rule_check {
1.615 raeburn 10363: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99 raeburn 10364: my ($response,%inst_response);
1.612 raeburn 10365: if (ref($usershash) eq 'HASH') {
1.1075.2.99 raeburn 10366: if (keys(%{$usershash}) > 1) {
10367: my (%by_username,%by_id,%userdoms);
10368: my $checkid;
1.612 raeburn 10369: if (ref($checks) eq 'HASH') {
1.1075.2.99 raeburn 10370: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
10371: $checkid = 1;
10372: }
10373: }
10374: foreach my $user (keys(%{$usershash})) {
10375: my ($uname,$udom) = split(/:/,$user);
10376: if ($checkid) {
10377: if (ref($usershash->{$user}) eq 'HASH') {
10378: if ($usershash->{$user}->{'id'} ne '') {
10379: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
10380: $userdoms{$udom} = 1;
10381: if (ref($inst_results) eq 'HASH') {
10382: $inst_results->{$uname.':'.$udom} = {};
10383: }
10384: }
10385: }
10386: } else {
10387: $by_username{$udom}{$uname} = 1;
10388: $userdoms{$udom} = 1;
10389: if (ref($inst_results) eq 'HASH') {
10390: $inst_results->{$uname.':'.$udom} = {};
10391: }
10392: }
10393: }
10394: foreach my $udom (keys(%userdoms)) {
10395: if (!$got_rules->{$udom}) {
10396: my %domconfig = &Apache::lonnet::get_dom('configuration',
10397: ['usercreation'],$udom);
10398: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10399: foreach my $item ('username','id') {
10400: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10401: $$curr_rules{$udom}{$item} =
10402: $domconfig{'usercreation'}{$item.'_rule'};
10403: }
10404: }
10405: }
10406: $got_rules->{$udom} = 1;
10407: }
10408: }
10409: if ($checkid) {
10410: foreach my $udom (keys(%by_id)) {
10411: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
10412: if ($outcome eq 'ok') {
10413: foreach my $id (keys(%{$by_id{$udom}})) {
10414: my $uname = $by_id{$udom}{$id};
10415: $inst_response{$uname.':'.$udom} = $outcome;
10416: }
10417: if (ref($results) eq 'HASH') {
10418: foreach my $uname (keys(%{$results})) {
10419: if (exists($inst_response{$uname.':'.$udom})) {
10420: $inst_response{$uname.':'.$udom} = $outcome;
10421: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10422: }
10423: }
10424: }
10425: }
1.612 raeburn 10426: }
1.615 raeburn 10427: } else {
1.1075.2.99 raeburn 10428: foreach my $udom (keys(%by_username)) {
10429: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
10430: if ($outcome eq 'ok') {
10431: foreach my $uname (keys(%{$by_username{$udom}})) {
10432: $inst_response{$uname.':'.$udom} = $outcome;
10433: }
10434: if (ref($results) eq 'HASH') {
10435: foreach my $uname (keys(%{$results})) {
10436: $inst_results->{$uname.':'.$udom} = $results->{$uname};
10437: }
10438: }
10439: }
10440: }
1.612 raeburn 10441: }
1.1075.2.99 raeburn 10442: } elsif (keys(%{$usershash}) == 1) {
10443: my $user = (keys(%{$usershash}))[0];
10444: my ($uname,$udom) = split(/:/,$user);
10445: if (($udom ne '') && ($uname ne '')) {
10446: if (ref($usershash->{$user}) eq 'HASH') {
10447: if (ref($checks) eq 'HASH') {
10448: if (defined($checks->{'username'})) {
10449: ($inst_response{$user},%{$inst_results->{$user}}) =
10450: &Apache::lonnet::get_instuser($udom,$uname);
10451: } elsif (defined($checks->{'id'})) {
10452: if ($usershash->{$user}->{'id'} ne '') {
10453: ($inst_response{$user},%{$inst_results->{$user}}) =
10454: &Apache::lonnet::get_instuser($udom,undef,
10455: $usershash->{$user}->{'id'});
10456: } else {
10457: ($inst_response{$user},%{$inst_results->{$user}}) =
10458: &Apache::lonnet::get_instuser($udom,$uname);
10459: }
10460: }
10461: } else {
10462: ($inst_response{$user},%{$inst_results->{$user}}) =
10463: &Apache::lonnet::get_instuser($udom,$uname);
10464: return;
10465: }
10466: if (!$got_rules->{$udom}) {
10467: my %domconfig = &Apache::lonnet::get_dom('configuration',
10468: ['usercreation'],$udom);
10469: if (ref($domconfig{'usercreation'}) eq 'HASH') {
10470: foreach my $item ('username','id') {
10471: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
10472: $$curr_rules{$udom}{$item} =
10473: $domconfig{'usercreation'}{$item.'_rule'};
10474: }
10475: }
1.585 raeburn 10476: }
1.1075.2.99 raeburn 10477: $got_rules->{$udom} = 1;
1.585 raeburn 10478: }
10479: }
1.1075.2.99 raeburn 10480: } else {
10481: return;
10482: }
10483: } else {
10484: return;
10485: }
10486: foreach my $user (keys(%{$usershash})) {
10487: my ($uname,$udom) = split(/:/,$user);
10488: next if (($udom eq '') || ($uname eq ''));
10489: my $id;
10490: if (ref($inst_results) eq 'HASH') {
10491: if (ref($inst_results->{$user}) eq 'HASH') {
10492: $id = $inst_results->{$user}->{'id'};
10493: }
10494: }
10495: if ($id eq '') {
10496: if (ref($usershash->{$user})) {
10497: $id = $usershash->{$user}->{'id'};
10498: }
1.585 raeburn 10499: }
1.612 raeburn 10500: foreach my $item (keys(%{$checks})) {
10501: if (ref($$curr_rules{$udom}) eq 'HASH') {
10502: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
10503: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99 raeburn 10504: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
10505: $$curr_rules{$udom}{$item});
1.612 raeburn 10506: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
10507: if ($rule_check{$rule}) {
10508: $$rulematch{$user}{$item} = $rule;
1.1075.2.99 raeburn 10509: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 10510: if (ref($inst_results) eq 'HASH') {
10511: if (ref($inst_results->{$user}) eq 'HASH') {
10512: if (keys(%{$inst_results->{$user}}) == 0) {
10513: $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99 raeburn 10514: } elsif ($item eq 'id') {
10515: if ($inst_results->{$user}->{'id'} eq '') {
10516: $$alerts{$item}{$udom}{$uname} = 1;
10517: }
1.615 raeburn 10518: }
1.612 raeburn 10519: }
10520: }
1.615 raeburn 10521: }
10522: last;
1.585 raeburn 10523: }
10524: }
10525: }
10526: }
10527: }
10528: }
10529: }
10530: }
1.612 raeburn 10531: return;
10532: }
10533:
10534: sub user_rule_formats {
10535: my ($domain,$domdesc,$curr_rules,$check) = @_;
10536: my %text = (
10537: 'username' => 'Usernames',
10538: 'id' => 'IDs',
10539: );
10540: my $output;
10541: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
10542: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
10543: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 10544: $output = '<br />'.
10545: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
10546: '<span class="LC_cusr_emph">','</span>',$domdesc).
10547: ' <ul>';
1.612 raeburn 10548: foreach my $rule (@{$ruleorder}) {
10549: if (ref($curr_rules) eq 'ARRAY') {
10550: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
10551: if (ref($rules->{$rule}) eq 'HASH') {
10552: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
10553: $rules->{$rule}{'desc'}.'</li>';
10554: }
10555: }
10556: }
10557: }
10558: $output .= '</ul>';
10559: }
10560: }
10561: return $output;
10562: }
10563:
10564: sub instrule_disallow_msg {
1.615 raeburn 10565: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 10566: my $response;
10567: my %text = (
10568: item => 'username',
10569: items => 'usernames',
10570: match => 'matches',
10571: do => 'does',
10572: action => 'a username',
10573: one => 'one',
10574: );
10575: if ($count > 1) {
10576: $text{'item'} = 'usernames';
10577: $text{'match'} ='match';
10578: $text{'do'} = 'do';
10579: $text{'action'} = 'usernames',
10580: $text{'one'} = 'ones';
10581: }
10582: if ($checkitem eq 'id') {
10583: $text{'items'} = 'IDs';
10584: $text{'item'} = 'ID';
10585: $text{'action'} = 'an ID';
1.615 raeburn 10586: if ($count > 1) {
10587: $text{'item'} = 'IDs';
10588: $text{'action'} = 'IDs';
10589: }
1.612 raeburn 10590: }
1.674 bisitz 10591: $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 10592: if ($mode eq 'upload') {
10593: if ($checkitem eq 'username') {
10594: $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'}.");
10595: } elsif ($checkitem eq 'id') {
1.674 bisitz 10596: $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 10597: }
1.669 raeburn 10598: } elsif ($mode eq 'selfcreate') {
10599: if ($checkitem eq 'id') {
10600: $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.");
10601: }
1.615 raeburn 10602: } else {
10603: if ($checkitem eq 'username') {
10604: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
10605: } elsif ($checkitem eq 'id') {
10606: $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.");
10607: }
1.612 raeburn 10608: }
10609: return $response;
1.585 raeburn 10610: }
10611:
1.624 raeburn 10612: sub personal_data_fieldtitles {
10613: my %fieldtitles = &Apache::lonlocal::texthash (
10614: id => 'Student/Employee ID',
10615: permanentemail => 'E-mail address',
10616: lastname => 'Last Name',
10617: firstname => 'First Name',
10618: middlename => 'Middle Name',
10619: generation => 'Generation',
10620: gen => 'Generation',
1.765 raeburn 10621: inststatus => 'Affiliation',
1.624 raeburn 10622: );
10623: return %fieldtitles;
10624: }
10625:
1.642 raeburn 10626: sub sorted_inst_types {
10627: my ($dom) = @_;
1.1075.2.70 raeburn 10628: my ($usertypes,$order);
10629: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
10630: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
10631: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
10632: $order = $domdefaults{'inststatus'}{'inststatusorder'};
10633: } else {
10634: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
10635: }
1.642 raeburn 10636: my $othertitle = &mt('All users');
10637: if ($env{'request.course.id'}) {
1.668 raeburn 10638: $othertitle = &mt('Any users');
1.642 raeburn 10639: }
10640: my @types;
10641: if (ref($order) eq 'ARRAY') {
10642: @types = @{$order};
10643: }
10644: if (@types == 0) {
10645: if (ref($usertypes) eq 'HASH') {
10646: @types = sort(keys(%{$usertypes}));
10647: }
10648: }
10649: if (keys(%{$usertypes}) > 0) {
10650: $othertitle = &mt('Other users');
10651: }
10652: return ($othertitle,$usertypes,\@types);
10653: }
10654:
1.645 raeburn 10655: sub get_institutional_codes {
1.1075.2.157 raeburn 10656: my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
1.645 raeburn 10657: # Get complete list of course sections to update
10658: my @currsections = ();
10659: my @currxlists = ();
1.1075.2.157 raeburn 10660: my (%unclutteredsec,%unclutteredlcsec);
1.645 raeburn 10661: my $coursecode = $$settings{'internal.coursecode'};
1.1075.2.157 raeburn 10662: my $crskey = $crs.':'.$coursecode;
10663: @{$unclutteredsec{$crskey}} = ();
10664: @{$unclutteredlcsec{$crskey}} = ();
1.645 raeburn 10665:
10666: if ($$settings{'internal.sectionnums'} ne '') {
10667: @currsections = split(/,/,$$settings{'internal.sectionnums'});
10668: }
10669:
10670: if ($$settings{'internal.crosslistings'} ne '') {
10671: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
10672: }
10673:
10674: if (@currxlists > 0) {
1.1075.2.157 raeburn 10675: foreach my $xl (@currxlists) {
10676: if ($xl =~ /^([^:]+):(\w*)$/) {
1.645 raeburn 10677: unless (grep/^$1$/,@{$allcourses}) {
1.1075.2.119 raeburn 10678: push(@{$allcourses},$1);
1.645 raeburn 10679: $$LC_code{$1} = $2;
10680: }
10681: }
10682: }
10683: }
1.1075.2.157 raeburn 10684:
1.645 raeburn 10685: if (@currsections > 0) {
1.1075.2.157 raeburn 10686: foreach my $sec (@currsections) {
10687: if ($sec =~ m/^(\w+):(\w*)$/ ) {
10688: my $instsec = $1;
1.645 raeburn 10689: my $lc_sec = $2;
1.1075.2.157 raeburn 10690: unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
10691: push(@{$unclutteredsec{$crskey}},$instsec);
10692: push(@{$unclutteredlcsec{$crskey}},$lc_sec);
10693: }
10694: }
10695: }
10696: }
10697:
10698: if (@{$unclutteredsec{$crskey}} > 0) {
10699: my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
10700: if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
10701: for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
10702: my $sec = $coursecode.$formattedsec{$crskey}[$i];
10703: unless (grep/^\Q$sec\E$/,@{$allcourses}) {
1.1075.2.119 raeburn 10704: push(@{$allcourses},$sec);
1.1075.2.157 raeburn 10705: $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
1.645 raeburn 10706: }
10707: }
10708: }
10709: }
10710: return;
10711: }
10712:
1.971 raeburn 10713: sub get_standard_codeitems {
10714: return ('Year','Semester','Department','Number','Section');
10715: }
10716:
1.112 bowersj2 10717: =pod
10718:
1.780 raeburn 10719: =head1 Slot Helpers
10720:
10721: =over 4
10722:
10723: =item * sorted_slots()
10724:
1.1040 raeburn 10725: Sorts an array of slot names in order of an optional sort key,
10726: default sort is by slot start time (earliest first).
1.780 raeburn 10727:
10728: Inputs:
10729:
10730: =over 4
10731:
10732: slotsarr - Reference to array of unsorted slot names.
10733:
10734: slots - Reference to hash of hash, where outer hash keys are slot names.
10735:
1.1040 raeburn 10736: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
10737:
1.549 albertel 10738: =back
10739:
1.780 raeburn 10740: Returns:
10741:
10742: =over 4
10743:
1.1040 raeburn 10744: sorted - An array of slot names sorted by a specified sort key
10745: (default sort key is start time of the slot).
1.780 raeburn 10746:
10747: =back
10748:
10749: =cut
10750:
10751:
10752: sub sorted_slots {
1.1040 raeburn 10753: my ($slotsarr,$slots,$sortkey) = @_;
10754: if ($sortkey eq '') {
10755: $sortkey = 'starttime';
10756: }
1.780 raeburn 10757: my @sorted;
10758: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
10759: @sorted =
10760: sort {
10761: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 10762: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 10763: }
10764: if (ref($slots->{$a})) { return -1;}
10765: if (ref($slots->{$b})) { return 1;}
10766: return 0;
10767: } @{$slotsarr};
10768: }
10769: return @sorted;
10770: }
10771:
1.1040 raeburn 10772: =pod
10773:
10774: =item * get_future_slots()
10775:
10776: Inputs:
10777:
10778: =over 4
10779:
10780: cnum - course number
10781:
10782: cdom - course domain
10783:
10784: now - current UNIX time
10785:
10786: symb - optional symb
10787:
10788: =back
10789:
10790: Returns:
10791:
10792: =over 4
10793:
10794: sorted_reservable - ref to array of student_schedulable slots currently
10795: reservable, ordered by end date of reservation period.
10796:
10797: reservable_now - ref to hash of student_schedulable slots currently
10798: reservable.
10799:
10800: Keys in inner hash are:
10801: (a) symb: either blank or symb to which slot use is restricted.
1.1075.2.104 raeburn 10802: (b) endreserve: end date of reservation period.
10803: (c) uniqueperiod: start,end dates when slot is to be uniquely
10804: selected.
1.1040 raeburn 10805:
10806: sorted_future - ref to array of student_schedulable slots reservable in
10807: the future, ordered by start date of reservation period.
10808:
10809: future_reservable - ref to hash of student_schedulable slots reservable
10810: in the future.
10811:
10812: Keys in inner hash are:
10813: (a) symb: either blank or symb to which slot use is restricted.
10814: (b) startreserve: start date of reservation period.
1.1075.2.104 raeburn 10815: (c) uniqueperiod: start,end dates when slot is to be uniquely
10816: selected.
1.1040 raeburn 10817:
10818: =back
10819:
10820: =cut
10821:
10822: sub get_future_slots {
10823: my ($cnum,$cdom,$now,$symb) = @_;
10824: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
10825: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
10826: foreach my $slot (keys(%slots)) {
10827: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
10828: if ($symb) {
10829: next if (($slots{$slot}->{'symb'} ne '') &&
10830: ($slots{$slot}->{'symb'} ne $symb));
10831: }
10832: if (($slots{$slot}->{'starttime'} > $now) &&
10833: ($slots{$slot}->{'endtime'} > $now)) {
10834: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
10835: my $userallowed = 0;
10836: if ($slots{$slot}->{'allowedsections'}) {
10837: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
10838: if (!defined($env{'request.role.sec'})
10839: && grep(/^No section assigned$/,@allowed_sec)) {
10840: $userallowed=1;
10841: } else {
10842: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
10843: $userallowed=1;
10844: }
10845: }
10846: unless ($userallowed) {
10847: if (defined($env{'request.course.groups'})) {
10848: my @groups = split(/:/,$env{'request.course.groups'});
10849: foreach my $group (@groups) {
10850: if (grep(/^\Q$group\E$/,@allowed_sec)) {
10851: $userallowed=1;
10852: last;
10853: }
10854: }
10855: }
10856: }
10857: }
10858: if ($slots{$slot}->{'allowedusers'}) {
10859: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
10860: my $user = $env{'user.name'}.':'.$env{'user.domain'};
10861: if (grep(/^\Q$user\E$/,@allowed_users)) {
10862: $userallowed = 1;
10863: }
10864: }
10865: next unless($userallowed);
10866: }
10867: my $startreserve = $slots{$slot}->{'startreserve'};
10868: my $endreserve = $slots{$slot}->{'endreserve'};
10869: my $symb = $slots{$slot}->{'symb'};
1.1075.2.104 raeburn 10870: my $uniqueperiod;
10871: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
10872: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
10873: }
1.1040 raeburn 10874: if (($startreserve < $now) &&
10875: (!$endreserve || $endreserve > $now)) {
10876: my $lastres = $endreserve;
10877: if (!$lastres) {
10878: $lastres = $slots{$slot}->{'starttime'};
10879: }
10880: $reservable_now{$slot} = {
10881: symb => $symb,
1.1075.2.104 raeburn 10882: endreserve => $lastres,
10883: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10884: };
10885: } elsif (($startreserve > $now) &&
10886: (!$endreserve || $endreserve > $startreserve)) {
10887: $future_reservable{$slot} = {
10888: symb => $symb,
1.1075.2.104 raeburn 10889: startreserve => $startreserve,
10890: uniqueperiod => $uniqueperiod,
1.1040 raeburn 10891: };
10892: }
10893: }
10894: }
10895: my @unsorted_reservable = keys(%reservable_now);
10896: if (@unsorted_reservable > 0) {
10897: @sorted_reservable =
10898: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
10899: }
10900: my @unsorted_future = keys(%future_reservable);
10901: if (@unsorted_future > 0) {
10902: @sorted_future =
10903: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
10904: }
10905: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
10906: }
1.780 raeburn 10907:
10908: =pod
10909:
1.1057 foxr 10910: =back
10911:
1.549 albertel 10912: =head1 HTTP Helpers
10913:
10914: =over 4
10915:
1.648 raeburn 10916: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 10917:
1.258 albertel 10918: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 10919: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 10920: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 10921:
10922: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
10923: $possible_names is an ref to an array of form element names. As an example:
10924: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 10925: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 10926:
10927: =cut
1.1 albertel 10928:
1.6 albertel 10929: sub get_unprocessed_cgi {
1.25 albertel 10930: my ($query,$possible_names)= @_;
1.26 matthew 10931: # $Apache::lonxml::debug=1;
1.356 albertel 10932: foreach my $pair (split(/&/,$query)) {
10933: my ($name, $value) = split(/=/,$pair);
1.369 www 10934: $name = &unescape($name);
1.25 albertel 10935: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10936: $value =~ tr/+/ /;
10937: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10938: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10939: }
1.16 harris41 10940: }
1.6 albertel 10941: }
10942:
1.112 bowersj2 10943: =pod
10944:
1.648 raeburn 10945: =item * &cacheheader()
1.112 bowersj2 10946:
10947: returns cache-controlling header code
10948:
10949: =cut
10950:
1.7 albertel 10951: sub cacheheader {
1.258 albertel 10952: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10953: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10954: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10955: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10956: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10957: return $output;
1.7 albertel 10958: }
10959:
1.112 bowersj2 10960: =pod
10961:
1.648 raeburn 10962: =item * &no_cache($r)
1.112 bowersj2 10963:
10964: specifies header code to not have cache
10965:
10966: =cut
10967:
1.9 albertel 10968: sub no_cache {
1.216 albertel 10969: my ($r) = @_;
10970: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10971: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10972: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10973: $r->no_cache(1);
10974: $r->header_out("Expires" => $date);
10975: $r->header_out("Pragma" => "no-cache");
1.123 www 10976: }
10977:
10978: sub content_type {
1.181 albertel 10979: my ($r,$type,$charset) = @_;
1.299 foxr 10980: if ($r) {
10981: # Note that printout.pl calls this with undef for $r.
10982: &no_cache($r);
10983: }
1.258 albertel 10984: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10985: unless ($charset) {
10986: $charset=&Apache::lonlocal::current_encoding;
10987: }
10988: if ($charset) { $type.='; charset='.$charset; }
10989: if ($r) {
10990: $r->content_type($type);
10991: } else {
10992: print("Content-type: $type\n\n");
10993: }
1.9 albertel 10994: }
1.25 albertel 10995:
1.112 bowersj2 10996: =pod
10997:
1.648 raeburn 10998: =item * &add_to_env($name,$value)
1.112 bowersj2 10999:
1.258 albertel 11000: adds $name to the %env hash with value
1.112 bowersj2 11001: $value, if $name already exists, the entry is converted to an array
11002: reference and $value is added to the array.
11003:
11004: =cut
11005:
1.25 albertel 11006: sub add_to_env {
11007: my ($name,$value)=@_;
1.258 albertel 11008: if (defined($env{$name})) {
11009: if (ref($env{$name})) {
1.25 albertel 11010: #already have multiple values
1.258 albertel 11011: push(@{ $env{$name} },$value);
1.25 albertel 11012: } else {
11013: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 11014: my $first=$env{$name};
11015: undef($env{$name});
11016: push(@{ $env{$name} },$first,$value);
1.25 albertel 11017: }
11018: } else {
1.258 albertel 11019: $env{$name}=$value;
1.25 albertel 11020: }
1.31 albertel 11021: }
1.149 albertel 11022:
11023: =pod
11024:
1.648 raeburn 11025: =item * &get_env_multiple($name)
1.149 albertel 11026:
1.258 albertel 11027: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 11028: values may be defined and end up as an array ref.
11029:
11030: returns an array of values
11031:
11032: =cut
11033:
11034: sub get_env_multiple {
11035: my ($name) = @_;
11036: my @values;
1.258 albertel 11037: if (defined($env{$name})) {
1.149 albertel 11038: # exists is it an array
1.258 albertel 11039: if (ref($env{$name})) {
11040: @values=@{ $env{$name} };
1.149 albertel 11041: } else {
1.258 albertel 11042: $values[0]=$env{$name};
1.149 albertel 11043: }
11044: }
11045: return(@values);
11046: }
11047:
1.660 raeburn 11048: sub ask_for_embedded_content {
11049: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 11050: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 11051: %currsubfile,%unused,$rem);
1.1071 raeburn 11052: my $counter = 0;
11053: my $numnew = 0;
1.987 raeburn 11054: my $numremref = 0;
11055: my $numinvalid = 0;
11056: my $numpathchg = 0;
11057: my $numexisting = 0;
1.1071 raeburn 11058: my $numunused = 0;
11059: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 11060: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 11061: my $heading = &mt('Upload embedded files');
11062: my $buttontext = &mt('Upload');
11063:
1.1075.2.11 raeburn 11064: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 11065: if ($actionurl eq '/adm/dependencies') {
11066: $navmap = Apache::lonnavmaps::navmap->new();
11067: }
11068: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
11069: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 11070: }
1.1075.2.35 raeburn 11071: if (($actionurl eq '/adm/portfolio') ||
11072: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 11073: my $current_path='/';
11074: if ($env{'form.currentpath'}) {
11075: $current_path = $env{'form.currentpath'};
11076: }
11077: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 11078: $udom = $cdom;
11079: $uname = $cnum;
1.984 raeburn 11080: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
11081: } else {
11082: $udom = $env{'user.domain'};
11083: $uname = $env{'user.name'};
11084: $url = '/userfiles/portfolio';
11085: }
1.987 raeburn 11086: $toplevel = $url.'/';
1.984 raeburn 11087: $url .= $current_path;
11088: $getpropath = 1;
1.987 raeburn 11089: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11090: ($actionurl eq '/adm/imsimport')) {
1.1022 www 11091: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 11092: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 11093: $toplevel = $url;
1.984 raeburn 11094: if ($rest ne '') {
1.987 raeburn 11095: $url .= $rest;
11096: }
11097: } elsif ($actionurl eq '/adm/coursedocs') {
11098: if (ref($args) eq 'HASH') {
1.1071 raeburn 11099: $url = $args->{'docs_url'};
11100: $toplevel = $url;
1.1075.2.11 raeburn 11101: if ($args->{'context'} eq 'paste') {
11102: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
11103: ($path) =
11104: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11105: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11106: $fileloc =~ s{^/}{};
11107: }
1.1071 raeburn 11108: }
11109: } elsif ($actionurl eq '/adm/dependencies') {
11110: if ($env{'request.course.id'} ne '') {
11111: if (ref($args) eq 'HASH') {
11112: $url = $args->{'docs_url'};
11113: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 11114: $toplevel = $url;
11115: unless ($toplevel =~ m{^/}) {
11116: $toplevel = "/$url";
11117: }
1.1075.2.11 raeburn 11118: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 11119: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
11120: $path = $1;
11121: } else {
11122: ($path) =
11123: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
11124: }
1.1075.2.79 raeburn 11125: if ($toplevel=~/^\/*(uploaded|editupload)/) {
11126: $fileloc = $toplevel;
11127: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
11128: my ($udom,$uname,$fname) =
11129: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
11130: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
11131: } else {
11132: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
11133: }
1.1071 raeburn 11134: $fileloc =~ s{^/}{};
11135: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
11136: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
11137: }
1.987 raeburn 11138: }
1.1075.2.35 raeburn 11139: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11140: $udom = $cdom;
11141: $uname = $cnum;
11142: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
11143: $toplevel = $url;
11144: $path = $url;
11145: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
11146: $fileloc =~ s{^/}{};
11147: }
11148: foreach my $file (keys(%{$allfiles})) {
11149: my $embed_file;
11150: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
11151: $embed_file = $1;
11152: } else {
11153: $embed_file = $file;
11154: }
1.1075.2.55 raeburn 11155: my ($absolutepath,$cleaned_file);
11156: if ($embed_file =~ m{^\w+://}) {
11157: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 11158: $newfiles{$cleaned_file} = 1;
11159: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11160: } else {
1.1075.2.55 raeburn 11161: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 11162: if ($embed_file =~ m{^/}) {
11163: $absolutepath = $embed_file;
11164: }
1.1075.2.47 raeburn 11165: if ($cleaned_file =~ m{/}) {
11166: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 11167: $path = &check_for_traversal($path,$url,$toplevel);
11168: my $item = $fname;
11169: if ($path ne '') {
11170: $item = $path.'/'.$fname;
11171: $subdependencies{$path}{$fname} = 1;
11172: } else {
11173: $dependencies{$item} = 1;
11174: }
11175: if ($absolutepath) {
11176: $mapping{$item} = $absolutepath;
11177: } else {
11178: $mapping{$item} = $embed_file;
11179: }
11180: } else {
11181: $dependencies{$embed_file} = 1;
11182: if ($absolutepath) {
1.1075.2.47 raeburn 11183: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 11184: } else {
1.1075.2.47 raeburn 11185: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 11186: }
11187: }
1.984 raeburn 11188: }
11189: }
1.1071 raeburn 11190: my $dirptr = 16384;
1.984 raeburn 11191: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 11192: $currsubfile{$path} = {};
1.1075.2.35 raeburn 11193: if (($actionurl eq '/adm/portfolio') ||
11194: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11195: my ($sublistref,$listerror) =
11196: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
11197: if (ref($sublistref) eq 'ARRAY') {
11198: foreach my $line (@{$sublistref}) {
11199: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 11200: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 11201: }
1.984 raeburn 11202: }
1.987 raeburn 11203: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11204: if (opendir(my $dir,$url.'/'.$path)) {
11205: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 11206: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
11207: }
1.1075.2.11 raeburn 11208: } elsif (($actionurl eq '/adm/dependencies') ||
11209: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 11210: ($args->{'context'} eq 'paste')) ||
11211: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11212: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 11213: my $dir;
11214: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
11215: $dir = $fileloc;
11216: } else {
11217: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11218: }
1.1071 raeburn 11219: if ($dir ne '') {
11220: my ($sublistref,$listerror) =
11221: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
11222: if (ref($sublistref) eq 'ARRAY') {
11223: foreach my $line (@{$sublistref}) {
11224: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
11225: undef,$mtime)=split(/\&/,$line,12);
11226: unless (($testdir&$dirptr) ||
11227: ($file_name =~ /^\.\.?$/)) {
11228: $currsubfile{$path}{$file_name} = [$size,$mtime];
11229: }
11230: }
11231: }
11232: }
1.984 raeburn 11233: }
11234: }
11235: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 11236: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 11237: my $item = $path.'/'.$file;
11238: unless ($mapping{$item} eq $item) {
11239: $pathchanges{$item} = 1;
11240: }
11241: $existing{$item} = 1;
11242: $numexisting ++;
11243: } else {
11244: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 11245: }
11246: }
1.1071 raeburn 11247: if ($actionurl eq '/adm/dependencies') {
11248: foreach my $path (keys(%currsubfile)) {
11249: if (ref($currsubfile{$path}) eq 'HASH') {
11250: foreach my $file (keys(%{$currsubfile{$path}})) {
11251: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 11252: next if (($rem ne '') &&
11253: (($env{"httpref.$rem"."$path/$file"} ne '') ||
11254: (ref($navmap) &&
11255: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
11256: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11257: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 11258: $unused{$path.'/'.$file} = 1;
11259: }
11260: }
11261: }
11262: }
11263: }
1.984 raeburn 11264: }
1.987 raeburn 11265: my %currfile;
1.1075.2.35 raeburn 11266: if (($actionurl eq '/adm/portfolio') ||
11267: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 11268: my ($dirlistref,$listerror) =
11269: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
11270: if (ref($dirlistref) eq 'ARRAY') {
11271: foreach my $line (@{$dirlistref}) {
11272: my ($file_name,$rest) = split(/\&/,$line,2);
11273: $currfile{$file_name} = 1;
11274: }
1.984 raeburn 11275: }
1.987 raeburn 11276: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 11277: if (opendir(my $dir,$url)) {
1.987 raeburn 11278: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 11279: map {$currfile{$_} = 1;} @dir_list;
11280: }
1.1075.2.11 raeburn 11281: } elsif (($actionurl eq '/adm/dependencies') ||
11282: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 11283: ($args->{'context'} eq 'paste')) ||
11284: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 11285: if ($env{'request.course.id'} ne '') {
11286: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
11287: if ($dir ne '') {
11288: my ($dirlistref,$listerror) =
11289: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
11290: if (ref($dirlistref) eq 'ARRAY') {
11291: foreach my $line (@{$dirlistref}) {
11292: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
11293: $size,undef,$mtime)=split(/\&/,$line,12);
11294: unless (($testdir&$dirptr) ||
11295: ($file_name =~ /^\.\.?$/)) {
11296: $currfile{$file_name} = [$size,$mtime];
11297: }
11298: }
11299: }
11300: }
11301: }
1.984 raeburn 11302: }
11303: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 11304: if (exists($currfile{$file})) {
1.987 raeburn 11305: unless ($mapping{$file} eq $file) {
11306: $pathchanges{$file} = 1;
11307: }
11308: $existing{$file} = 1;
11309: $numexisting ++;
11310: } else {
1.984 raeburn 11311: $newfiles{$file} = 1;
11312: }
11313: }
1.1071 raeburn 11314: foreach my $file (keys(%currfile)) {
11315: unless (($file eq $filename) ||
11316: ($file eq $filename.'.bak') ||
11317: ($dependencies{$file})) {
1.1075.2.11 raeburn 11318: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 11319: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
11320: next if (($rem ne '') &&
11321: (($env{"httpref.$rem".$file} ne '') ||
11322: (ref($navmap) &&
11323: (($navmap->getResourceByUrl($rem.$file) ne '') ||
11324: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
11325: ($navmap->getResourceByUrl($rem.$1)))))));
11326: }
1.1075.2.11 raeburn 11327: }
1.1071 raeburn 11328: $unused{$file} = 1;
11329: }
11330: }
1.1075.2.11 raeburn 11331: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
11332: ($args->{'context'} eq 'paste')) {
11333: $counter = scalar(keys(%existing));
11334: $numpathchg = scalar(keys(%pathchanges));
11335: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 11336: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
11337: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
11338: $counter = scalar(keys(%existing));
11339: $numpathchg = scalar(keys(%pathchanges));
11340: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 11341: }
1.984 raeburn 11342: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 11343: if ($actionurl eq '/adm/dependencies') {
11344: next if ($embed_file =~ m{^\w+://});
11345: }
1.660 raeburn 11346: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 11347: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 11348: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 11349: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 11350: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
11351: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 11352: }
1.1075.2.35 raeburn 11353: $upload_output .= '</td>';
1.1071 raeburn 11354: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 11355: $upload_output.='<td align="right">'.
11356: '<span class="LC_info LC_fontsize_medium">'.
11357: &mt("URL points to web address").'</span>';
1.987 raeburn 11358: $numremref++;
1.660 raeburn 11359: } elsif ($args->{'error_on_invalid_names'}
11360: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 11361: $upload_output.='<td align="right"><span class="LC_warning">'.
11362: &mt('Invalid characters').'</span>';
1.987 raeburn 11363: $numinvalid++;
1.660 raeburn 11364: } else {
1.1075.2.35 raeburn 11365: $upload_output .= '<td>'.
11366: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 11367: $embed_file,\%mapping,
1.1071 raeburn 11368: $allfiles,$codebase,'upload');
11369: $counter ++;
11370: $numnew ++;
1.987 raeburn 11371: }
11372: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
11373: }
11374: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 11375: if ($actionurl eq '/adm/dependencies') {
11376: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
11377: $modify_output .= &start_data_table_row().
11378: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
11379: '<img src="'.&icon($embed_file).'" border="0" />'.
11380: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
11381: '<td>'.$size.'</td>'.
11382: '<td>'.$mtime.'</td>'.
11383: '<td><label><input type="checkbox" name="mod_upload_dep" '.
11384: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
11385: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
11386: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
11387: &embedded_file_element('upload_embedded',$counter,
11388: $embed_file,\%mapping,
11389: $allfiles,$codebase,'modify').
11390: '</div></td>'.
11391: &end_data_table_row()."\n";
11392: $counter ++;
11393: } else {
11394: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 11395: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
11396: '<span class="LC_filename">'.$embed_file.'</span></td>'.
11397: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 11398: &Apache::loncommon::end_data_table_row()."\n";
11399: }
11400: }
11401: my $delidx = $counter;
11402: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
11403: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
11404: $delete_output .= &start_data_table_row().
11405: '<td><img src="'.&icon($oldfile).'" />'.
11406: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
11407: '<td>'.$size.'</td>'.
11408: '<td>'.$mtime.'</td>'.
11409: '<td><label><input type="checkbox" name="del_upload_dep" '.
11410: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
11411: &embedded_file_element('upload_embedded',$delidx,
11412: $oldfile,\%mapping,$allfiles,
11413: $codebase,'delete').'</td>'.
11414: &end_data_table_row()."\n";
11415: $numunused ++;
11416: $delidx ++;
1.987 raeburn 11417: }
11418: if ($upload_output) {
11419: $upload_output = &start_data_table().
11420: $upload_output.
11421: &end_data_table()."\n";
11422: }
1.1071 raeburn 11423: if ($modify_output) {
11424: $modify_output = &start_data_table().
11425: &start_data_table_header_row().
11426: '<th>'.&mt('File').'</th>'.
11427: '<th>'.&mt('Size (KB)').'</th>'.
11428: '<th>'.&mt('Modified').'</th>'.
11429: '<th>'.&mt('Upload replacement?').'</th>'.
11430: &end_data_table_header_row().
11431: $modify_output.
11432: &end_data_table()."\n";
11433: }
11434: if ($delete_output) {
11435: $delete_output = &start_data_table().
11436: &start_data_table_header_row().
11437: '<th>'.&mt('File').'</th>'.
11438: '<th>'.&mt('Size (KB)').'</th>'.
11439: '<th>'.&mt('Modified').'</th>'.
11440: '<th>'.&mt('Delete?').'</th>'.
11441: &end_data_table_header_row().
11442: $delete_output.
11443: &end_data_table()."\n";
11444: }
1.987 raeburn 11445: my $applies = 0;
11446: if ($numremref) {
11447: $applies ++;
11448: }
11449: if ($numinvalid) {
11450: $applies ++;
11451: }
11452: if ($numexisting) {
11453: $applies ++;
11454: }
1.1071 raeburn 11455: if ($counter || $numunused) {
1.987 raeburn 11456: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
11457: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 11458: $state.'<h3>'.$heading.'</h3>';
11459: if ($actionurl eq '/adm/dependencies') {
11460: if ($numnew) {
11461: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
11462: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
11463: $upload_output.'<br />'."\n";
11464: }
11465: if ($numexisting) {
11466: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
11467: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
11468: $modify_output.'<br />'."\n";
11469: $buttontext = &mt('Save changes');
11470: }
11471: if ($numunused) {
11472: $output .= '<h4>'.&mt('Unused files').'</h4>'.
11473: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
11474: $delete_output.'<br />'."\n";
11475: $buttontext = &mt('Save changes');
11476: }
11477: } else {
11478: $output .= $upload_output.'<br />'."\n";
11479: }
11480: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
11481: $counter.'" />'."\n";
11482: if ($actionurl eq '/adm/dependencies') {
11483: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
11484: $numnew.'" />'."\n";
11485: } elsif ($actionurl eq '') {
1.987 raeburn 11486: $output .= '<input type="hidden" name="phase" value="three" />';
11487: }
11488: } elsif ($applies) {
11489: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
11490: if ($applies > 1) {
11491: $output .=
1.1075.2.35 raeburn 11492: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 11493: if ($numremref) {
11494: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
11495: }
11496: if ($numinvalid) {
11497: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
11498: }
11499: if ($numexisting) {
11500: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
11501: }
11502: $output .= '</ul><br />';
11503: } elsif ($numremref) {
11504: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
11505: } elsif ($numinvalid) {
11506: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
11507: } elsif ($numexisting) {
11508: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
11509: }
11510: $output .= $upload_output.'<br />';
11511: }
11512: my ($pathchange_output,$chgcount);
1.1071 raeburn 11513: $chgcount = $counter;
1.987 raeburn 11514: if (keys(%pathchanges) > 0) {
11515: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 11516: if ($counter) {
1.987 raeburn 11517: $output .= &embedded_file_element('pathchange',$chgcount,
11518: $embed_file,\%mapping,
1.1071 raeburn 11519: $allfiles,$codebase,'change');
1.987 raeburn 11520: } else {
11521: $pathchange_output .=
11522: &start_data_table_row().
11523: '<td><input type ="checkbox" name="namechange" value="'.
11524: $chgcount.'" checked="checked" /></td>'.
11525: '<td>'.$mapping{$embed_file}.'</td>'.
11526: '<td>'.$embed_file.
11527: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 11528: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 11529: '</td>'.&end_data_table_row();
1.660 raeburn 11530: }
1.987 raeburn 11531: $numpathchg ++;
11532: $chgcount ++;
1.660 raeburn 11533: }
11534: }
1.1075.2.35 raeburn 11535: if (($counter) || ($numunused)) {
1.987 raeburn 11536: if ($numpathchg) {
11537: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
11538: $numpathchg.'" />'."\n";
11539: }
11540: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
11541: ($actionurl eq '/adm/imsimport')) {
11542: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
11543: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
11544: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 11545: } elsif ($actionurl eq '/adm/dependencies') {
11546: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 11547: }
1.1075.2.35 raeburn 11548: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 11549: } elsif ($numpathchg) {
11550: my %pathchange = ();
11551: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
11552: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11553: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 11554: }
1.987 raeburn 11555: }
1.1071 raeburn 11556: return ($output,$counter,$numpathchg);
1.987 raeburn 11557: }
11558:
1.1075.2.47 raeburn 11559: =pod
11560:
11561: =item * clean_path($name)
11562:
11563: Performs clean-up of directories, subdirectories and filename in an
11564: embedded object, referenced in an HTML file which is being uploaded
11565: to a course or portfolio, where
11566: "Upload embedded images/multimedia files if HTML file" checkbox was
11567: checked.
11568:
11569: Clean-up is similar to replacements in lonnet::clean_filename()
11570: except each / between sub-directory and next level is preserved.
11571:
11572: =cut
11573:
11574: sub clean_path {
11575: my ($embed_file) = @_;
11576: $embed_file =~s{^/+}{};
11577: my @contents;
11578: if ($embed_file =~ m{/}) {
11579: @contents = split(/\//,$embed_file);
11580: } else {
11581: @contents = ($embed_file);
11582: }
11583: my $lastidx = scalar(@contents)-1;
11584: for (my $i=0; $i<=$lastidx; $i++) {
11585: $contents[$i]=~s{\\}{/}g;
11586: $contents[$i]=~s/\s+/\_/g;
11587: $contents[$i]=~s{[^/\w\.\-]}{}g;
11588: if ($i == $lastidx) {
11589: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
11590: }
11591: }
11592: if ($lastidx > 0) {
11593: return join('/',@contents);
11594: } else {
11595: return $contents[0];
11596: }
11597: }
11598:
1.987 raeburn 11599: sub embedded_file_element {
1.1071 raeburn 11600: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 11601: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
11602: (ref($codebase) eq 'HASH'));
11603: my $output;
1.1071 raeburn 11604: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 11605: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
11606: }
11607: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
11608: &escape($embed_file).'" />';
11609: unless (($context eq 'upload_embedded') &&
11610: ($mapping->{$embed_file} eq $embed_file)) {
11611: $output .='
11612: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
11613: }
11614: my $attrib;
11615: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
11616: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
11617: }
11618: $output .=
11619: "\n\t\t".
11620: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
11621: $attrib.'" />';
11622: if (exists($codebase->{$mapping->{$embed_file}})) {
11623: $output .=
11624: "\n\t\t".
11625: '<input name="codebase_'.$num.'" type="hidden" value="'.
11626: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 11627: }
1.987 raeburn 11628: return $output;
1.660 raeburn 11629: }
11630:
1.1071 raeburn 11631: sub get_dependency_details {
11632: my ($currfile,$currsubfile,$embed_file) = @_;
11633: my ($size,$mtime,$showsize,$showmtime);
11634: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
11635: if ($embed_file =~ m{/}) {
11636: my ($path,$fname) = split(/\//,$embed_file);
11637: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
11638: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
11639: }
11640: } else {
11641: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
11642: ($size,$mtime) = @{$currfile->{$embed_file}};
11643: }
11644: }
11645: $showsize = $size/1024.0;
11646: $showsize = sprintf("%.1f",$showsize);
11647: if ($mtime > 0) {
11648: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
11649: }
11650: }
11651: return ($showsize,$showmtime);
11652: }
11653:
11654: sub ask_embedded_js {
11655: return <<"END";
11656: <script type="text/javascript"">
11657: // <![CDATA[
11658: function toggleBrowse(counter) {
11659: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
11660: var fileid = document.getElementById('embedded_item_'+counter);
11661: var uploaddivid = document.getElementById('moduploaddep_'+counter);
11662: if (chkboxid.checked == true) {
11663: uploaddivid.style.display='block';
11664: } else {
11665: uploaddivid.style.display='none';
11666: fileid.value = '';
11667: }
11668: }
11669: // ]]>
11670: </script>
11671:
11672: END
11673: }
11674:
1.661 raeburn 11675: sub upload_embedded {
11676: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 11677: $current_disk_usage,$hiddenstate,$actionurl) = @_;
11678: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 11679: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
11680: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
11681: my $orig_uploaded_filename =
11682: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 11683: foreach my $type ('orig','ref','attrib','codebase') {
11684: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
11685: $env{'form.embedded_'.$type.'_'.$i} =
11686: &unescape($env{'form.embedded_'.$type.'_'.$i});
11687: }
11688: }
1.661 raeburn 11689: my ($path,$fname) =
11690: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
11691: # no path, whole string is fname
11692: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
11693: $fname = &Apache::lonnet::clean_filename($fname);
11694: # See if there is anything left
11695: next if ($fname eq '');
11696:
11697: # Check if file already exists as a file or directory.
11698: my ($state,$msg);
11699: if ($context eq 'portfolio') {
11700: my $port_path = $dirpath;
11701: if ($group ne '') {
11702: $port_path = "groups/$group/$port_path";
11703: }
1.987 raeburn 11704: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
11705: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 11706: $dir_root,$port_path,$disk_quota,
11707: $current_disk_usage,$uname,$udom);
11708: if ($state eq 'will_exceed_quota'
1.984 raeburn 11709: || $state eq 'file_locked') {
1.661 raeburn 11710: $output .= $msg;
11711: next;
11712: }
11713: } elsif (($context eq 'author') || ($context eq 'testbank')) {
11714: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
11715: if ($state eq 'exists') {
11716: $output .= $msg;
11717: next;
11718: }
11719: }
11720: # Check if extension is valid
11721: if (($fname =~ /\.(\w+)$/) &&
11722: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 11723: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
11724: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 11725: next;
11726: } elsif (($fname =~ /\.(\w+)$/) &&
11727: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 11728: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 11729: next;
11730: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 11731: $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 11732: next;
11733: }
11734: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 11735: my $subdir = $path;
11736: $subdir =~ s{/+$}{};
1.661 raeburn 11737: if ($context eq 'portfolio') {
1.984 raeburn 11738: my $result;
11739: if ($state eq 'existingfile') {
11740: $result=
11741: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 11742: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 11743: } else {
1.984 raeburn 11744: $result=
11745: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 11746: $dirpath.
1.1075.2.35 raeburn 11747: $env{'form.currentpath'}.$subdir);
1.984 raeburn 11748: if ($result !~ m|^/uploaded/|) {
11749: $output .= '<span class="LC_error">'
11750: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11751: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11752: .'</span><br />';
11753: next;
11754: } else {
1.987 raeburn 11755: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11756: $path.$fname.'</span>').'<br />';
1.984 raeburn 11757: }
1.661 raeburn 11758: }
1.1075.2.35 raeburn 11759: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
11760: my $extendedsubdir = $dirpath.'/'.$subdir;
11761: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 11762: my $result =
1.1075.2.35 raeburn 11763: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 11764: if ($result !~ m|^/uploaded/|) {
11765: $output .= '<span class="LC_error">'
11766: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
11767: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
11768: .'</span><br />';
11769: next;
11770: } else {
11771: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11772: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 11773: if ($context eq 'syllabus') {
11774: &Apache::lonnet::make_public_indefinitely($result);
11775: }
1.987 raeburn 11776: }
1.661 raeburn 11777: } else {
11778: # Save the file
11779: my $target = $env{'form.embedded_item_'.$i};
11780: my $fullpath = $dir_root.$dirpath.'/'.$path;
11781: my $dest = $fullpath.$fname;
11782: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 11783: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 11784: my $count;
11785: my $filepath = $dir_root;
1.1027 raeburn 11786: foreach my $subdir (@parts) {
11787: $filepath .= "/$subdir";
11788: if (!-e $filepath) {
1.661 raeburn 11789: mkdir($filepath,0770);
11790: }
11791: }
11792: my $fh;
11793: if (!open($fh,'>'.$dest)) {
11794: &Apache::lonnet::logthis('Failed to create '.$dest);
11795: $output .= '<span class="LC_error">'.
1.1071 raeburn 11796: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
11797: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11798: '</span><br />';
11799: } else {
11800: if (!print $fh $env{'form.embedded_item_'.$i}) {
11801: &Apache::lonnet::logthis('Failed to write to '.$dest);
11802: $output .= '<span class="LC_error">'.
1.1071 raeburn 11803: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
11804: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 11805: '</span><br />';
11806: } else {
1.987 raeburn 11807: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
11808: $url.'</span>').'<br />';
11809: unless ($context eq 'testbank') {
11810: $footer .= &mt('View embedded file: [_1]',
11811: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
11812: }
11813: }
11814: close($fh);
11815: }
11816: }
11817: if ($env{'form.embedded_ref_'.$i}) {
11818: $pathchange{$i} = 1;
11819: }
11820: }
11821: if ($output) {
11822: $output = '<p>'.$output.'</p>';
11823: }
11824: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
11825: $returnflag = 'ok';
1.1071 raeburn 11826: my $numpathchgs = scalar(keys(%pathchange));
11827: if ($numpathchgs > 0) {
1.987 raeburn 11828: if ($context eq 'portfolio') {
11829: $output .= '<p>'.&mt('or').'</p>';
11830: } elsif ($context eq 'testbank') {
1.1071 raeburn 11831: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
11832: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 11833: $returnflag = 'modify_orightml';
11834: }
11835: }
1.1071 raeburn 11836: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 11837: }
11838:
11839: sub modify_html_form {
11840: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
11841: my $end = 0;
11842: my $modifyform;
11843: if ($context eq 'upload_embedded') {
11844: return unless (ref($pathchange) eq 'HASH');
11845: if ($env{'form.number_embedded_items'}) {
11846: $end += $env{'form.number_embedded_items'};
11847: }
11848: if ($env{'form.number_pathchange_items'}) {
11849: $end += $env{'form.number_pathchange_items'};
11850: }
11851: if ($end) {
11852: for (my $i=0; $i<$end; $i++) {
11853: if ($i < $env{'form.number_embedded_items'}) {
11854: next unless($pathchange->{$i});
11855: }
11856: $modifyform .=
11857: &start_data_table_row().
11858: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
11859: 'checked="checked" /></td>'.
11860: '<td>'.$env{'form.embedded_ref_'.$i}.
11861: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
11862: &escape($env{'form.embedded_ref_'.$i}).'" />'.
11863: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
11864: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
11865: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
11866: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
11867: '<td>'.$env{'form.embedded_orig_'.$i}.
11868: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
11869: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
11870: &end_data_table_row();
1.1071 raeburn 11871: }
1.987 raeburn 11872: }
11873: } else {
11874: $modifyform = $pathchgtable;
11875: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
11876: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
11877: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
11878: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
11879: }
11880: }
11881: if ($modifyform) {
1.1071 raeburn 11882: if ($actionurl eq '/adm/dependencies') {
11883: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
11884: }
1.987 raeburn 11885: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
11886: '<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".
11887: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
11888: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
11889: '</ol></p>'."\n".'<p>'.
11890: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
11891: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
11892: &start_data_table()."\n".
11893: &start_data_table_header_row().
11894: '<th>'.&mt('Change?').'</th>'.
11895: '<th>'.&mt('Current reference').'</th>'.
11896: '<th>'.&mt('Required reference').'</th>'.
11897: &end_data_table_header_row()."\n".
11898: $modifyform.
11899: &end_data_table().'<br />'."\n".$hiddenstate.
11900: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
11901: '</form>'."\n";
11902: }
11903: return;
11904: }
11905:
11906: sub modify_html_refs {
1.1075.2.35 raeburn 11907: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 11908: my $container;
11909: if ($context eq 'portfolio') {
11910: $container = $env{'form.container'};
11911: } elsif ($context eq 'coursedoc') {
11912: $container = $env{'form.primaryurl'};
1.1071 raeburn 11913: } elsif ($context eq 'manage_dependencies') {
11914: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
11915: $container = "/$container";
1.1075.2.35 raeburn 11916: } elsif ($context eq 'syllabus') {
11917: $container = $url;
1.987 raeburn 11918: } else {
1.1027 raeburn 11919: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 11920: }
11921: my (%allfiles,%codebase,$output,$content);
11922: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 11923: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 11924: if (wantarray) {
11925: return ('',0,0);
11926: } else {
11927: return;
11928: }
11929: }
11930: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 11931: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11932: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11933: if (wantarray) {
11934: return ('',0,0);
11935: } else {
11936: return;
11937: }
11938: }
1.987 raeburn 11939: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11940: if ($content eq '-1') {
11941: if (wantarray) {
11942: return ('',0,0);
11943: } else {
11944: return;
11945: }
11946: }
1.987 raeburn 11947: } else {
1.1071 raeburn 11948: unless ($container =~ /^\Q$dir_root\E/) {
11949: if (wantarray) {
11950: return ('',0,0);
11951: } else {
11952: return;
11953: }
11954: }
1.1075.2.128 raeburn 11955: if (open(my $fh,'<',$container)) {
1.987 raeburn 11956: $content = join('', <$fh>);
11957: close($fh);
11958: } else {
1.1071 raeburn 11959: if (wantarray) {
11960: return ('',0,0);
11961: } else {
11962: return;
11963: }
1.987 raeburn 11964: }
11965: }
11966: my ($count,$codebasecount) = (0,0);
11967: my $mm = new File::MMagic;
11968: my $mime_type = $mm->checktype_contents($content);
11969: if ($mime_type eq 'text/html') {
11970: my $parse_result =
11971: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11972: \%codebase,\$content);
11973: if ($parse_result eq 'ok') {
11974: foreach my $i (@changes) {
11975: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11976: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11977: if ($allfiles{$ref}) {
11978: my $newname = $orig;
11979: my ($attrib_regexp,$codebase);
1.1006 raeburn 11980: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11981: if ($attrib_regexp =~ /:/) {
11982: $attrib_regexp =~ s/\:/|/g;
11983: }
11984: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11985: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11986: $count += $numchg;
1.1075.2.35 raeburn 11987: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 11988: delete($allfiles{$ref});
1.987 raeburn 11989: }
11990: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11991: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11992: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11993: $codebasecount ++;
11994: }
11995: }
11996: }
1.1075.2.35 raeburn 11997: my $skiprewrites;
1.987 raeburn 11998: if ($count || $codebasecount) {
11999: my $saveresult;
1.1071 raeburn 12000: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 12001: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 12002: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12003: if ($url eq $container) {
12004: my ($fname) = ($container =~ m{/([^/]+)$});
12005: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12006: $count,'<span class="LC_filename">'.
1.1071 raeburn 12007: $fname.'</span>').'</p>';
1.987 raeburn 12008: } else {
12009: $output = '<p class="LC_error">'.
12010: &mt('Error: update failed for: [_1].',
12011: '<span class="LC_filename">'.
12012: $container.'</span>').'</p>';
12013: }
1.1075.2.35 raeburn 12014: if ($context eq 'syllabus') {
12015: unless ($saveresult eq 'ok') {
12016: $skiprewrites = 1;
12017: }
12018: }
1.987 raeburn 12019: } else {
1.1075.2.128 raeburn 12020: if (open(my $fh,'>',$container)) {
1.987 raeburn 12021: print $fh $content;
12022: close($fh);
12023: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
12024: $count,'<span class="LC_filename">'.
12025: $container.'</span>').'</p>';
1.661 raeburn 12026: } else {
1.987 raeburn 12027: $output = '<p class="LC_error">'.
12028: &mt('Error: could not update [_1].',
12029: '<span class="LC_filename">'.
12030: $container.'</span>').'</p>';
1.661 raeburn 12031: }
12032: }
12033: }
1.1075.2.35 raeburn 12034: if (($context eq 'syllabus') && (!$skiprewrites)) {
12035: my ($actionurl,$state);
12036: $actionurl = "/public/$udom/$uname/syllabus";
12037: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
12038: &ask_for_embedded_content($actionurl,$state,\%allfiles,
12039: \%codebase,
12040: {'context' => 'rewrites',
12041: 'ignore_remote_references' => 1,});
12042: if (ref($mapping) eq 'HASH') {
12043: my $rewrites = 0;
12044: foreach my $key (keys(%{$mapping})) {
12045: next if ($key =~ m{^https?://});
12046: my $ref = $mapping->{$key};
12047: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
12048: my $attrib;
12049: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
12050: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
12051: }
12052: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
12053: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
12054: $rewrites += $numchg;
12055: }
12056: }
12057: if ($rewrites) {
12058: my $saveresult;
12059: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
12060: if ($url eq $container) {
12061: my ($fname) = ($container =~ m{/([^/]+)$});
12062: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
12063: $count,'<span class="LC_filename">'.
12064: $fname.'</span>').'</p>';
12065: } else {
12066: $output .= '<p class="LC_error">'.
12067: &mt('Error: could not update links in [_1].',
12068: '<span class="LC_filename">'.
12069: $container.'</span>').'</p>';
12070:
12071: }
12072: }
12073: }
12074: }
1.987 raeburn 12075: } else {
12076: &logthis('Failed to parse '.$container.
12077: ' to modify references: '.$parse_result);
1.661 raeburn 12078: }
12079: }
1.1071 raeburn 12080: if (wantarray) {
12081: return ($output,$count,$codebasecount);
12082: } else {
12083: return $output;
12084: }
1.661 raeburn 12085: }
12086:
12087: sub check_for_existing {
12088: my ($path,$fname,$element) = @_;
12089: my ($state,$msg);
12090: if (-d $path.'/'.$fname) {
12091: $state = 'exists';
12092: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12093: } elsif (-e $path.'/'.$fname) {
12094: $state = 'exists';
12095: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
12096: }
12097: if ($state eq 'exists') {
12098: $msg = '<span class="LC_error">'.$msg.'</span><br />';
12099: }
12100: return ($state,$msg);
12101: }
12102:
12103: sub check_for_upload {
12104: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
12105: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 12106: my $filesize = length($env{'form.'.$element});
12107: if (!$filesize) {
12108: my $msg = '<span class="LC_error">'.
12109: &mt('Unable to upload [_1]. (size = [_2] bytes)',
12110: '<span class="LC_filename">'.$fname.'</span>',
12111: $filesize).'<br />'.
1.1007 raeburn 12112: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 12113: '</span>';
12114: return ('zero_bytes',$msg);
12115: }
12116: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 12117: my $getpropath = 1;
1.1021 raeburn 12118: my ($dirlistref,$listerror) =
12119: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 12120: my $found_file = 0;
12121: my $locked_file = 0;
1.991 raeburn 12122: my @lockers;
12123: my $navmap;
12124: if ($env{'request.course.id'}) {
12125: $navmap = Apache::lonnavmaps::navmap->new();
12126: }
1.1021 raeburn 12127: if (ref($dirlistref) eq 'ARRAY') {
12128: foreach my $line (@{$dirlistref}) {
12129: my ($file_name,$rest)=split(/\&/,$line,2);
12130: if ($file_name eq $fname){
12131: $file_name = $path.$file_name;
12132: if ($group ne '') {
12133: $file_name = $group.$file_name;
12134: }
12135: $found_file = 1;
12136: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
12137: foreach my $lock (@lockers) {
12138: if (ref($lock) eq 'ARRAY') {
12139: my ($symb,$crsid) = @{$lock};
12140: if ($crsid eq $env{'request.course.id'}) {
12141: if (ref($navmap)) {
12142: my $res = $navmap->getBySymb($symb);
12143: foreach my $part (@{$res->parts()}) {
12144: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
12145: unless (($slot_status == $res->RESERVED) ||
12146: ($slot_status == $res->RESERVED_LOCATION)) {
12147: $locked_file = 1;
12148: }
1.991 raeburn 12149: }
1.1021 raeburn 12150: } else {
12151: $locked_file = 1;
1.991 raeburn 12152: }
12153: } else {
12154: $locked_file = 1;
12155: }
12156: }
1.1021 raeburn 12157: }
12158: } else {
12159: my @info = split(/\&/,$rest);
12160: my $currsize = $info[6]/1000;
12161: if ($currsize < $filesize) {
12162: my $extra = $filesize - $currsize;
12163: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 12164: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 12165: &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 12166: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
12167: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
12168: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 12169: return ('will_exceed_quota',$msg);
12170: }
1.984 raeburn 12171: }
12172: }
1.661 raeburn 12173: }
12174: }
12175: }
12176: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 12177: my $msg = '<p class="LC_warning">'.
12178: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
12179: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 12180: return ('will_exceed_quota',$msg);
12181: } elsif ($found_file) {
12182: if ($locked_file) {
1.1075.2.69 raeburn 12183: my $msg = '<p class="LC_warning">';
1.661 raeburn 12184: $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 12185: $msg .= '</p>';
1.661 raeburn 12186: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
12187: return ('file_locked',$msg);
12188: } else {
1.1075.2.69 raeburn 12189: my $msg = '<p class="LC_error">';
1.984 raeburn 12190: $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 12191: $msg .= '</p>';
1.984 raeburn 12192: return ('existingfile',$msg);
1.661 raeburn 12193: }
12194: }
12195: }
12196:
1.987 raeburn 12197: sub check_for_traversal {
12198: my ($path,$url,$toplevel) = @_;
12199: my @parts=split(/\//,$path);
12200: my $cleanpath;
12201: my $fullpath = $url;
12202: for (my $i=0;$i<@parts;$i++) {
12203: next if ($parts[$i] eq '.');
12204: if ($parts[$i] eq '..') {
12205: $fullpath =~ s{([^/]+/)$}{};
12206: } else {
12207: $fullpath .= $parts[$i].'/';
12208: }
12209: }
12210: if ($fullpath =~ /^\Q$url\E(.*)$/) {
12211: $cleanpath = $1;
12212: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
12213: my $curr_toprel = $1;
12214: my @parts = split(/\//,$curr_toprel);
12215: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
12216: my @urlparts = split(/\//,$url_toprel);
12217: my $doubledots;
12218: my $startdiff = -1;
12219: for (my $i=0; $i<@urlparts; $i++) {
12220: if ($startdiff == -1) {
12221: unless ($urlparts[$i] eq $parts[$i]) {
12222: $startdiff = $i;
12223: $doubledots .= '../';
12224: }
12225: } else {
12226: $doubledots .= '../';
12227: }
12228: }
12229: if ($startdiff > -1) {
12230: $cleanpath = $doubledots;
12231: for (my $i=$startdiff; $i<@parts; $i++) {
12232: $cleanpath .= $parts[$i].'/';
12233: }
12234: }
12235: }
12236: $cleanpath =~ s{(/)$}{};
12237: return $cleanpath;
12238: }
1.31 albertel 12239:
1.1053 raeburn 12240: sub is_archive_file {
12241: my ($mimetype) = @_;
12242: if (($mimetype eq 'application/octet-stream') ||
12243: ($mimetype eq 'application/x-stuffit') ||
12244: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
12245: return 1;
12246: }
12247: return;
12248: }
12249:
12250: sub decompress_form {
1.1065 raeburn 12251: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 12252: my %lt = &Apache::lonlocal::texthash (
12253: this => 'This file is an archive file.',
1.1067 raeburn 12254: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 12255: itsc => 'Its contents are as follows:',
1.1053 raeburn 12256: youm => 'You may wish to extract its contents.',
12257: extr => 'Extract contents',
1.1067 raeburn 12258: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
12259: proa => 'Process automatically?',
1.1053 raeburn 12260: yes => 'Yes',
12261: no => 'No',
1.1067 raeburn 12262: fold => 'Title for folder containing movie',
12263: movi => 'Title for page containing embedded movie',
1.1053 raeburn 12264: );
1.1065 raeburn 12265: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 12266: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 12267: my $info = &list_archive_contents($fileloc,\@paths);
12268: if (@paths) {
12269: foreach my $path (@paths) {
12270: $path =~ s{^/}{};
1.1067 raeburn 12271: if ($path =~ m{^([^/]+)/$}) {
12272: $topdir = $1;
12273: }
1.1065 raeburn 12274: if ($path =~ m{^([^/]+)/}) {
12275: $toplevel{$1} = $path;
12276: } else {
12277: $toplevel{$path} = $path;
12278: }
12279: }
12280: }
1.1067 raeburn 12281: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 12282: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 12283: "$topdir/media/",
12284: "$topdir/media/$topdir.mp4",
12285: "$topdir/media/FirstFrame.png",
12286: "$topdir/media/player.swf",
12287: "$topdir/media/swfobject.js",
12288: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 12289: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 12290: "$topdir/$topdir.mp4",
12291: "$topdir/$topdir\_config.xml",
12292: "$topdir/$topdir\_controller.swf",
12293: "$topdir/$topdir\_embed.css",
12294: "$topdir/$topdir\_First_Frame.png",
12295: "$topdir/$topdir\_player.html",
12296: "$topdir/$topdir\_Thumbnails.png",
12297: "$topdir/playerProductInstall.swf",
12298: "$topdir/scripts/",
12299: "$topdir/scripts/config_xml.js",
12300: "$topdir/scripts/handlebars.js",
12301: "$topdir/scripts/jquery-1.7.1.min.js",
12302: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
12303: "$topdir/scripts/modernizr.js",
12304: "$topdir/scripts/player-min.js",
12305: "$topdir/scripts/swfobject.js",
12306: "$topdir/skins/",
12307: "$topdir/skins/configuration_express.xml",
12308: "$topdir/skins/express_show/",
12309: "$topdir/skins/express_show/player-min.css",
12310: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 12311: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
12312: "$topdir/$topdir.mp4",
12313: "$topdir/$topdir\_config.xml",
12314: "$topdir/$topdir\_controller.swf",
12315: "$topdir/$topdir\_embed.css",
12316: "$topdir/$topdir\_First_Frame.png",
12317: "$topdir/$topdir\_player.html",
12318: "$topdir/$topdir\_Thumbnails.png",
12319: "$topdir/playerProductInstall.swf",
12320: "$topdir/scripts/",
12321: "$topdir/scripts/config_xml.js",
12322: "$topdir/scripts/techsmith-smart-player.min.js",
12323: "$topdir/skins/",
12324: "$topdir/skins/configuration_express.xml",
12325: "$topdir/skins/express_show/",
12326: "$topdir/skins/express_show/spritesheet.min.css",
12327: "$topdir/skins/express_show/spritesheet.png",
12328: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 12329: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 12330: if (@diffs == 0) {
1.1075.2.59 raeburn 12331: $is_camtasia = 6;
12332: } else {
1.1075.2.81 raeburn 12333: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 12334: if (@diffs == 0) {
12335: $is_camtasia = 8;
1.1075.2.81 raeburn 12336: } else {
12337: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
12338: if (@diffs == 0) {
12339: $is_camtasia = 8;
12340: }
1.1075.2.59 raeburn 12341: }
1.1067 raeburn 12342: }
12343: }
12344: my $output;
12345: if ($is_camtasia) {
12346: $output = <<"ENDCAM";
12347: <script type="text/javascript" language="Javascript">
12348: // <![CDATA[
12349:
12350: function camtasiaToggle() {
12351: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
12352: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 12353: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 12354: document.getElementById('camtasia_titles').style.display='block';
12355: } else {
12356: document.getElementById('camtasia_titles').style.display='none';
12357: }
12358: }
12359: }
12360: return;
12361: }
12362:
12363: // ]]>
12364: </script>
12365: <p>$lt{'camt'}</p>
12366: ENDCAM
1.1065 raeburn 12367: } else {
1.1067 raeburn 12368: $output = '<p>'.$lt{'this'};
12369: if ($info eq '') {
12370: $output .= ' '.$lt{'youm'}.'</p>'."\n";
12371: } else {
12372: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
12373: '<div><pre>'.$info.'</pre></div>';
12374: }
1.1065 raeburn 12375: }
1.1067 raeburn 12376: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 12377: my $duplicates;
12378: my $num = 0;
12379: if (ref($dirlist) eq 'ARRAY') {
12380: foreach my $item (@{$dirlist}) {
12381: if (ref($item) eq 'ARRAY') {
12382: if (exists($toplevel{$item->[0]})) {
12383: $duplicates .=
12384: &start_data_table_row().
12385: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
12386: 'value="0" checked="checked" />'.&mt('No').'</label>'.
12387: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
12388: 'value="1" />'.&mt('Yes').'</label>'.
12389: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
12390: '<td>'.$item->[0].'</td>';
12391: if ($item->[2]) {
12392: $duplicates .= '<td>'.&mt('Directory').'</td>';
12393: } else {
12394: $duplicates .= '<td>'.&mt('File').'</td>';
12395: }
12396: $duplicates .= '<td>'.$item->[3].'</td>'.
12397: '<td>'.
12398: &Apache::lonlocal::locallocaltime($item->[4]).
12399: '</td>'.
12400: &end_data_table_row();
12401: $num ++;
12402: }
12403: }
12404: }
12405: }
12406: my $itemcount;
12407: if (@paths > 0) {
12408: $itemcount = scalar(@paths);
12409: } else {
12410: $itemcount = 1;
12411: }
1.1067 raeburn 12412: if ($is_camtasia) {
12413: $output .= $lt{'auto'}.'<br />'.
12414: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 12415: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 12416: $lt{'yes'}.'</label> <label>'.
12417: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
12418: $lt{'no'}.'</label></span><br />'.
12419: '<div id="camtasia_titles" style="display:block">'.
12420: &Apache::lonhtmlcommon::start_pick_box().
12421: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
12422: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
12423: &Apache::lonhtmlcommon::row_closure().
12424: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
12425: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
12426: &Apache::lonhtmlcommon::row_closure(1).
12427: &Apache::lonhtmlcommon::end_pick_box().
12428: '</div>';
12429: }
1.1065 raeburn 12430: $output .=
12431: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 12432: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
12433: "\n";
1.1065 raeburn 12434: if ($duplicates ne '') {
12435: $output .= '<p><span class="LC_warning">'.
12436: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
12437: &start_data_table().
12438: &start_data_table_header_row().
12439: '<th>'.&mt('Overwrite?').'</th>'.
12440: '<th>'.&mt('Name').'</th>'.
12441: '<th>'.&mt('Type').'</th>'.
12442: '<th>'.&mt('Size').'</th>'.
12443: '<th>'.&mt('Last modified').'</th>'.
12444: &end_data_table_header_row().
12445: $duplicates.
12446: &end_data_table().
12447: '</p>';
12448: }
1.1067 raeburn 12449: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 12450: if (ref($hiddenelements) eq 'HASH') {
12451: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
12452: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
12453: }
12454: }
12455: $output .= <<"END";
1.1067 raeburn 12456: <br />
1.1053 raeburn 12457: <input type="submit" name="decompress" value="$lt{'extr'}" />
12458: </form>
12459: $noextract
12460: END
12461: return $output;
12462: }
12463:
1.1065 raeburn 12464: sub decompression_utility {
12465: my ($program) = @_;
12466: my @utilities = ('tar','gunzip','bunzip2','unzip');
12467: my $location;
12468: if (grep(/^\Q$program\E$/,@utilities)) {
12469: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
12470: '/usr/sbin/') {
12471: if (-x $dir.$program) {
12472: $location = $dir.$program;
12473: last;
12474: }
12475: }
12476: }
12477: return $location;
12478: }
12479:
12480: sub list_archive_contents {
12481: my ($file,$pathsref) = @_;
12482: my (@cmd,$output);
12483: my $needsregexp;
12484: if ($file =~ /\.zip$/) {
12485: @cmd = (&decompression_utility('unzip'),"-l");
12486: $needsregexp = 1;
12487: } elsif (($file =~ m/\.tar\.gz$/) ||
12488: ($file =~ /\.tgz$/)) {
12489: @cmd = (&decompression_utility('tar'),"-ztf");
12490: } elsif ($file =~ /\.tar\.bz2$/) {
12491: @cmd = (&decompression_utility('tar'),"-jtf");
12492: } elsif ($file =~ m|\.tar$|) {
12493: @cmd = (&decompression_utility('tar'),"-tf");
12494: }
12495: if (@cmd) {
12496: undef($!);
12497: undef($@);
12498: if (open(my $fh,"-|", @cmd, $file)) {
12499: while (my $line = <$fh>) {
12500: $output .= $line;
12501: chomp($line);
12502: my $item;
12503: if ($needsregexp) {
12504: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
12505: } else {
12506: $item = $line;
12507: }
12508: if ($item ne '') {
12509: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
12510: push(@{$pathsref},$item);
12511: }
12512: }
12513: }
12514: close($fh);
12515: }
12516: }
12517: return $output;
12518: }
12519:
1.1053 raeburn 12520: sub decompress_uploaded_file {
12521: my ($file,$dir) = @_;
12522: &Apache::lonnet::appenv({'cgi.file' => $file});
12523: &Apache::lonnet::appenv({'cgi.dir' => $dir});
12524: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
12525: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
12526: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
12527: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
12528: my $decompressed = $env{'cgi.decompressed'};
12529: &Apache::lonnet::delenv('cgi.file');
12530: &Apache::lonnet::delenv('cgi.dir');
12531: &Apache::lonnet::delenv('cgi.decompressed');
12532: return ($decompressed,$result);
12533: }
12534:
1.1055 raeburn 12535: sub process_decompression {
12536: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
1.1075.2.128 raeburn 12537: unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
12538: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12539: &mt('Unexpected file path.').'</p>'."\n";
12540: }
12541: unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
12542: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12543: &mt('Unexpected course context.').'</p>'."\n";
12544: }
12545: unless ($file eq &Apache::lonnet::clean_filename($file)) {
12546: return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12547: &mt('Filename contained unexpected characters.').'</p>'."\n";
12548: }
1.1055 raeburn 12549: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 12550: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 12551: $error = &mt('Filename not a supported archive file type.').
12552: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 12553: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
12554: } else {
12555: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12556: if ($docuhome eq 'no_host') {
12557: $error = &mt('Could not determine home server for course.');
12558: } else {
12559: my @ids=&Apache::lonnet::current_machine_ids();
12560: my $currdir = "$dir_root/$destination";
12561: if (grep(/^\Q$docuhome\E$/,@ids)) {
12562: $dir = &LONCAPA::propath($docudom,$docuname).
12563: "$dir_root/$destination";
12564: } else {
12565: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
12566: "$dir_root/$docudom/$docuname/$destination";
12567: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
12568: $error = &mt('Archive file not found.');
12569: }
12570: }
1.1065 raeburn 12571: my (@to_overwrite,@to_skip);
12572: if ($env{'form.archive_overwrite_total'} > 0) {
12573: my $total = $env{'form.archive_overwrite_total'};
12574: for (my $i=0; $i<$total; $i++) {
12575: if ($env{'form.archive_overwrite_'.$i} == 1) {
12576: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
12577: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
12578: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
12579: }
12580: }
12581: }
12582: my $numskip = scalar(@to_skip);
1.1075.2.128 raeburn 12583: my $numoverwrite = scalar(@to_overwrite);
12584: if (($numskip) && (!$numoverwrite)) {
1.1065 raeburn 12585: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
12586: } elsif ($dir eq '') {
1.1055 raeburn 12587: $error = &mt('Directory containing archive file unavailable.');
12588: } elsif (!$error) {
1.1065 raeburn 12589: my ($decompressed,$display);
1.1075.2.128 raeburn 12590: if (($numskip) || ($numoverwrite)) {
1.1065 raeburn 12591: my $tempdir = time.'_'.$$.int(rand(10000));
12592: mkdir("$dir/$tempdir",0755);
1.1075.2.128 raeburn 12593: if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
12594: ($decompressed,$display) =
12595: &decompress_uploaded_file($file,"$dir/$tempdir");
12596: foreach my $item (@to_skip) {
12597: if (($item ne '') && ($item !~ /\.\./)) {
12598: if (-f "$dir/$tempdir/$item") {
12599: unlink("$dir/$tempdir/$item");
12600: } elsif (-d "$dir/$tempdir/$item") {
12601: &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
12602: }
12603: }
12604: }
12605: foreach my $item (@to_overwrite) {
12606: if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
12607: if (($item ne '') && ($item !~ /\.\./)) {
12608: if (-f "$dir/$item") {
12609: unlink("$dir/$item");
12610: } elsif (-d "$dir/$item") {
12611: &File::Path::remove_tree("$dir/$item",{ safe => 1 });
12612: }
12613: &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
12614: }
1.1065 raeburn 12615: }
12616: }
1.1075.2.128 raeburn 12617: if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
12618: &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
12619: }
1.1065 raeburn 12620: }
12621: } else {
12622: ($decompressed,$display) =
12623: &decompress_uploaded_file($file,$dir);
12624: }
1.1055 raeburn 12625: if ($decompressed eq 'ok') {
1.1065 raeburn 12626: $output = '<p class="LC_info">'.
12627: &mt('Files extracted successfully from archive.').
12628: '</p>'."\n";
1.1055 raeburn 12629: my ($warning,$result,@contents);
12630: my ($newdirlistref,$newlisterror) =
12631: &Apache::lonnet::dirlist($currdir,$docudom,
12632: $docuname,1);
12633: my (%is_dir,%changes,@newitems);
12634: my $dirptr = 16384;
1.1065 raeburn 12635: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 12636: foreach my $dir_line (@{$newdirlistref}) {
12637: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1075.2.128 raeburn 12638: unless (($item =~ /^\.+$/) || ($item eq $file)) {
1.1055 raeburn 12639: push(@newitems,$item);
12640: if ($dirptr&$testdir) {
12641: $is_dir{$item} = 1;
12642: }
12643: $changes{$item} = 1;
12644: }
12645: }
12646: }
12647: if (keys(%changes) > 0) {
12648: foreach my $item (sort(@newitems)) {
12649: if ($changes{$item}) {
12650: push(@contents,$item);
12651: }
12652: }
12653: }
12654: if (@contents > 0) {
1.1067 raeburn 12655: my $wantform;
12656: unless ($env{'form.autoextract_camtasia'}) {
12657: $wantform = 1;
12658: }
1.1056 raeburn 12659: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 12660: my ($count,$datatable) = &get_extracted($docudom,$docuname,
12661: $currdir,\%is_dir,
12662: \%children,\%parent,
1.1056 raeburn 12663: \@contents,\%dirorder,
12664: \%titles,$wantform);
1.1055 raeburn 12665: if ($datatable ne '') {
12666: $output .= &archive_options_form('decompressed',$datatable,
12667: $count,$hiddenelem);
1.1065 raeburn 12668: my $startcount = 6;
1.1055 raeburn 12669: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 12670: \%titles,\%children);
1.1055 raeburn 12671: }
1.1067 raeburn 12672: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 12673: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 12674: my %displayed;
12675: my $total = 1;
12676: $env{'form.archive_directory'} = [];
12677: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
12678: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
12679: $path =~ s{/$}{};
12680: my $item;
12681: if ($path ne '') {
12682: $item = "$path/$titles{$i}";
12683: } else {
12684: $item = $titles{$i};
12685: }
12686: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
12687: if ($item eq $contents[0]) {
12688: push(@{$env{'form.archive_directory'}},$i);
12689: $env{'form.archive_'.$i} = 'display';
12690: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
12691: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 12692: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
12693: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 12694: $env{'form.archive_'.$i} = 'display';
12695: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
12696: $displayed{'web'} = $i;
12697: } else {
1.1075.2.59 raeburn 12698: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
12699: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
12700: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 12701: push(@{$env{'form.archive_directory'}},$i);
12702: }
12703: $env{'form.archive_'.$i} = 'dependency';
12704: }
12705: $total ++;
12706: }
12707: for (my $i=1; $i<$total; $i++) {
12708: next if ($i == $displayed{'web'});
12709: next if ($i == $displayed{'folder'});
12710: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
12711: }
12712: $env{'form.phase'} = 'decompress_cleanup';
12713: $env{'form.archivedelete'} = 1;
12714: $env{'form.archive_count'} = $total-1;
12715: $output .=
12716: &process_extracted_files('coursedocs',$docudom,
12717: $docuname,$destination,
12718: $dir_root,$hiddenelem);
12719: }
1.1055 raeburn 12720: } else {
12721: $warning = &mt('No new items extracted from archive file.');
12722: }
12723: } else {
12724: $output = $display;
12725: $error = &mt('An error occurred during extraction from the archive file.');
12726: }
12727: }
12728: }
12729: }
12730: if ($error) {
12731: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12732: $error.'</p>'."\n";
12733: }
12734: if ($warning) {
12735: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12736: }
12737: return $output;
12738: }
12739:
12740: sub get_extracted {
1.1056 raeburn 12741: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
12742: $titles,$wantform) = @_;
1.1055 raeburn 12743: my $count = 0;
12744: my $depth = 0;
12745: my $datatable;
1.1056 raeburn 12746: my @hierarchy;
1.1055 raeburn 12747: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 12748: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
12749: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 12750: foreach my $item (@{$contents}) {
12751: $count ++;
1.1056 raeburn 12752: @{$dirorder->{$count}} = @hierarchy;
12753: $titles->{$count} = $item;
1.1055 raeburn 12754: &archive_hierarchy($depth,$count,$parent,$children);
12755: if ($wantform) {
12756: $datatable .= &archive_row($is_dir->{$item},$item,
12757: $currdir,$depth,$count);
12758: }
12759: if ($is_dir->{$item}) {
12760: $depth ++;
1.1056 raeburn 12761: push(@hierarchy,$count);
12762: $parent->{$depth} = $count;
1.1055 raeburn 12763: $datatable .=
12764: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 12765: \$depth,\$count,\@hierarchy,$dirorder,
12766: $children,$parent,$titles,$wantform);
1.1055 raeburn 12767: $depth --;
1.1056 raeburn 12768: pop(@hierarchy);
1.1055 raeburn 12769: }
12770: }
12771: return ($count,$datatable);
12772: }
12773:
12774: sub recurse_extracted_archive {
1.1056 raeburn 12775: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
12776: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 12777: my $result='';
1.1056 raeburn 12778: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
12779: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
12780: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 12781: return $result;
12782: }
12783: my $dirptr = 16384;
12784: my ($newdirlistref,$newlisterror) =
12785: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
12786: if (ref($newdirlistref) eq 'ARRAY') {
12787: foreach my $dir_line (@{$newdirlistref}) {
12788: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
12789: unless ($item =~ /^\.+$/) {
12790: $$count ++;
1.1056 raeburn 12791: @{$dirorder->{$$count}} = @{$hierarchy};
12792: $titles->{$$count} = $item;
1.1055 raeburn 12793: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 12794:
1.1055 raeburn 12795: my $is_dir;
12796: if ($dirptr&$testdir) {
12797: $is_dir = 1;
12798: }
12799: if ($wantform) {
12800: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
12801: }
12802: if ($is_dir) {
12803: $$depth ++;
1.1056 raeburn 12804: push(@{$hierarchy},$$count);
12805: $parent->{$$depth} = $$count;
1.1055 raeburn 12806: $result .=
12807: &recurse_extracted_archive("$currdir/$item",$docudom,
12808: $docuname,$depth,$count,
1.1056 raeburn 12809: $hierarchy,$dirorder,$children,
12810: $parent,$titles,$wantform);
1.1055 raeburn 12811: $$depth --;
1.1056 raeburn 12812: pop(@{$hierarchy});
1.1055 raeburn 12813: }
12814: }
12815: }
12816: }
12817: return $result;
12818: }
12819:
12820: sub archive_hierarchy {
12821: my ($depth,$count,$parent,$children) =@_;
12822: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
12823: if (exists($parent->{$depth})) {
12824: $children->{$parent->{$depth}} .= $count.':';
12825: }
12826: }
12827: return;
12828: }
12829:
12830: sub archive_row {
12831: my ($is_dir,$item,$currdir,$depth,$count) = @_;
12832: my ($name) = ($item =~ m{([^/]+)$});
12833: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 12834: 'display' => 'Add as file',
1.1055 raeburn 12835: 'dependency' => 'Include as dependency',
12836: 'discard' => 'Discard',
12837: );
12838: if ($is_dir) {
1.1059 raeburn 12839: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 12840: }
1.1056 raeburn 12841: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
12842: my $offset = 0;
1.1055 raeburn 12843: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 12844: $offset ++;
1.1065 raeburn 12845: if ($action ne 'display') {
12846: $offset ++;
12847: }
1.1055 raeburn 12848: $output .= '<td><span class="LC_nobreak">'.
12849: '<label><input type="radio" name="archive_'.$count.
12850: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
12851: my $text = $choices{$action};
12852: if ($is_dir) {
12853: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
12854: if ($action eq 'display') {
1.1059 raeburn 12855: $text = &mt('Add as folder');
1.1055 raeburn 12856: }
1.1056 raeburn 12857: } else {
12858: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
12859:
12860: }
12861: $output .= ' /> '.$choices{$action}.'</label></span>';
12862: if ($action eq 'dependency') {
12863: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
12864: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
12865: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
12866: '<option value=""></option>'."\n".
12867: '</select>'."\n".
12868: '</div>';
1.1059 raeburn 12869: } elsif ($action eq 'display') {
12870: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
12871: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
12872: '</div>';
1.1055 raeburn 12873: }
1.1056 raeburn 12874: $output .= '</td>';
1.1055 raeburn 12875: }
12876: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
12877: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
12878: for (my $i=0; $i<$depth; $i++) {
12879: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
12880: }
12881: if ($is_dir) {
12882: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
12883: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
12884: } else {
12885: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
12886: }
12887: $output .= ' '.$name.'</td>'."\n".
12888: &end_data_table_row();
12889: return $output;
12890: }
12891:
12892: sub archive_options_form {
1.1065 raeburn 12893: my ($form,$display,$count,$hiddenelem) = @_;
12894: my %lt = &Apache::lonlocal::texthash(
12895: perm => 'Permanently remove archive file?',
12896: hows => 'How should each extracted item be incorporated in the course?',
12897: cont => 'Content actions for all',
12898: addf => 'Add as folder/file',
12899: incd => 'Include as dependency for a displayed file',
12900: disc => 'Discard',
12901: no => 'No',
12902: yes => 'Yes',
12903: save => 'Save',
12904: );
12905: my $output = <<"END";
12906: <form name="$form" method="post" action="">
12907: <p><span class="LC_nobreak">$lt{'perm'}
12908: <label>
12909: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
12910: </label>
12911:
12912: <label>
12913: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
12914: </span>
12915: </p>
12916: <input type="hidden" name="phase" value="decompress_cleanup" />
12917: <br />$lt{'hows'}
12918: <div class="LC_columnSection">
12919: <fieldset>
12920: <legend>$lt{'cont'}</legend>
12921: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
12922: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
12923: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
12924: </fieldset>
12925: </div>
12926: END
12927: return $output.
1.1055 raeburn 12928: &start_data_table()."\n".
1.1065 raeburn 12929: $display."\n".
1.1055 raeburn 12930: &end_data_table()."\n".
12931: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
12932: $hiddenelem.
1.1065 raeburn 12933: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 12934: '</form>';
12935: }
12936:
12937: sub archive_javascript {
1.1056 raeburn 12938: my ($startcount,$numitems,$titles,$children) = @_;
12939: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 12940: my $maintitle = $env{'form.comment'};
1.1055 raeburn 12941: my $scripttag = <<START;
12942: <script type="text/javascript">
12943: // <![CDATA[
12944:
12945: function checkAll(form,prefix) {
12946: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
12947: for (var i=0; i < form.elements.length; i++) {
12948: var id = form.elements[i].id;
12949: if ((id != '') && (id != undefined)) {
12950: if (idstr.test(id)) {
12951: if (form.elements[i].type == 'radio') {
12952: form.elements[i].checked = true;
1.1056 raeburn 12953: var nostart = i-$startcount;
1.1059 raeburn 12954: var offset = nostart%7;
12955: var count = (nostart-offset)/7;
1.1056 raeburn 12956: dependencyCheck(form,count,offset);
1.1055 raeburn 12957: }
12958: }
12959: }
12960: }
12961: }
12962:
12963: function propagateCheck(form,count) {
12964: if (count > 0) {
1.1059 raeburn 12965: var startelement = $startcount + ((count-1) * 7);
12966: for (var j=1; j<6; j++) {
12967: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12968: var item = startelement + j;
12969: if (form.elements[item].type == 'radio') {
12970: if (form.elements[item].checked) {
12971: containerCheck(form,count,j);
12972: break;
12973: }
1.1055 raeburn 12974: }
12975: }
12976: }
12977: }
12978: }
12979:
12980: numitems = $numitems
1.1056 raeburn 12981: var titles = new Array(numitems);
12982: var parents = new Array(numitems);
1.1055 raeburn 12983: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12984: parents[i] = new Array;
1.1055 raeburn 12985: }
1.1059 raeburn 12986: var maintitle = '$maintitle';
1.1055 raeburn 12987:
12988: START
12989:
1.1056 raeburn 12990: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12991: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12992: for (my $i=0; $i<@contents; $i ++) {
12993: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12994: }
12995: }
12996:
1.1056 raeburn 12997: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12998: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12999: }
13000:
1.1055 raeburn 13001: $scripttag .= <<END;
13002:
13003: function containerCheck(form,count,offset) {
13004: if (count > 0) {
1.1056 raeburn 13005: dependencyCheck(form,count,offset);
1.1059 raeburn 13006: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 13007: form.elements[item].checked = true;
13008: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
13009: if (parents[count].length > 0) {
13010: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 13011: containerCheck(form,parents[count][j],offset);
13012: }
13013: }
13014: }
13015: }
13016: }
13017:
13018: function dependencyCheck(form,count,offset) {
13019: if (count > 0) {
1.1059 raeburn 13020: var chosen = (offset+$startcount)+7*(count-1);
13021: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 13022: var currtype = form.elements[depitem].type;
13023: if (form.elements[chosen].value == 'dependency') {
13024: document.getElementById('arc_depon_'+count).style.display='block';
13025: form.elements[depitem].options.length = 0;
13026: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 13027: for (var i=1; i<=numitems; i++) {
13028: if (i == count) {
13029: continue;
13030: }
1.1059 raeburn 13031: var startelement = $startcount + (i-1) * 7;
13032: for (var j=1; j<6; j++) {
13033: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 13034: var item = startelement + j;
13035: if (form.elements[item].type == 'radio') {
13036: if (form.elements[item].checked) {
13037: if (form.elements[item].value == 'display') {
13038: var n = form.elements[depitem].options.length;
13039: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
13040: }
13041: }
13042: }
13043: }
13044: }
13045: }
13046: } else {
13047: document.getElementById('arc_depon_'+count).style.display='none';
13048: form.elements[depitem].options.length = 0;
13049: form.elements[depitem].options[0] = new Option('Select','',true,true);
13050: }
1.1059 raeburn 13051: titleCheck(form,count,offset);
1.1056 raeburn 13052: }
13053: }
13054:
13055: function propagateSelect(form,count,offset) {
13056: if (count > 0) {
1.1065 raeburn 13057: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 13058: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
13059: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13060: if (parents[count].length > 0) {
13061: for (var j=0; j<parents[count].length; j++) {
13062: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 13063: }
13064: }
13065: }
13066: }
13067: }
1.1056 raeburn 13068:
13069: function containerSelect(form,count,offset,picked) {
13070: if (count > 0) {
1.1065 raeburn 13071: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 13072: if (form.elements[item].type == 'radio') {
13073: if (form.elements[item].value == 'dependency') {
13074: if (form.elements[item+1].type == 'select-one') {
13075: for (var i=0; i<form.elements[item+1].options.length; i++) {
13076: if (form.elements[item+1].options[i].value == picked) {
13077: form.elements[item+1].selectedIndex = i;
13078: break;
13079: }
13080: }
13081: }
13082: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
13083: if (parents[count].length > 0) {
13084: for (var j=0; j<parents[count].length; j++) {
13085: containerSelect(form,parents[count][j],offset,picked);
13086: }
13087: }
13088: }
13089: }
13090: }
13091: }
13092: }
13093:
1.1059 raeburn 13094: function titleCheck(form,count,offset) {
13095: if (count > 0) {
13096: var chosen = (offset+$startcount)+7*(count-1);
13097: var depitem = $startcount + ((count-1) * 7) + 2;
13098: var currtype = form.elements[depitem].type;
13099: if (form.elements[chosen].value == 'display') {
13100: document.getElementById('arc_title_'+count).style.display='block';
13101: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
13102: document.getElementById('archive_title_'+count).value=maintitle;
13103: }
13104: } else {
13105: document.getElementById('arc_title_'+count).style.display='none';
13106: if (currtype == 'text') {
13107: document.getElementById('archive_title_'+count).value='';
13108: }
13109: }
13110: }
13111: return;
13112: }
13113:
1.1055 raeburn 13114: // ]]>
13115: </script>
13116: END
13117: return $scripttag;
13118: }
13119:
13120: sub process_extracted_files {
1.1067 raeburn 13121: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 13122: my $numitems = $env{'form.archive_count'};
1.1075.2.128 raeburn 13123: return if ((!$numitems) || ($numitems =~ /\D/));
1.1055 raeburn 13124: my @ids=&Apache::lonnet::current_machine_ids();
13125: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 13126: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 13127: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
13128: if (grep(/^\Q$docuhome\E$/,@ids)) {
13129: $prefix = &LONCAPA::propath($docudom,$docuname);
13130: $pathtocheck = "$dir_root/$destination";
13131: $dir = $dir_root;
13132: $ishome = 1;
13133: } else {
13134: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
13135: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
1.1075.2.128 raeburn 13136: $dir = "$dir_root/$docudom/$docuname";
1.1055 raeburn 13137: }
13138: my $currdir = "$dir_root/$destination";
13139: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
13140: if ($env{'form.folderpath'}) {
13141: my @items = split('&',$env{'form.folderpath'});
13142: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 13143: if ($env{'form.folderpath'} =~ /\:1$/) {
13144: $containers{'0'}='page';
13145: } else {
13146: $containers{'0'}='sequence';
13147: }
1.1055 raeburn 13148: }
13149: my @archdirs = &get_env_multiple('form.archive_directory');
13150: if ($numitems) {
13151: for (my $i=1; $i<=$numitems; $i++) {
13152: my $path = $env{'form.archive_content_'.$i};
13153: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
13154: my $item = $1;
13155: $toplevelitems{$item} = $i;
13156: if (grep(/^\Q$i\E$/,@archdirs)) {
13157: $is_dir{$item} = 1;
13158: }
13159: }
13160: }
13161: }
1.1067 raeburn 13162: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 13163: if (keys(%toplevelitems) > 0) {
13164: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 13165: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
13166: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 13167: }
1.1066 raeburn 13168: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 13169: if ($numitems) {
13170: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 13171: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 13172: my $path = $env{'form.archive_content_'.$i};
13173: if ($path =~ /^\Q$pathtocheck\E/) {
13174: if ($env{'form.archive_'.$i} eq 'discard') {
13175: if ($prefix ne '' && $path ne '') {
13176: if (-e $prefix.$path) {
1.1066 raeburn 13177: if ((@archdirs > 0) &&
13178: (grep(/^\Q$i\E$/,@archdirs))) {
13179: $todeletedir{$prefix.$path} = 1;
13180: } else {
13181: $todelete{$prefix.$path} = 1;
13182: }
1.1055 raeburn 13183: }
13184: }
13185: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 13186: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 13187: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 13188: $docstitle = $env{'form.archive_title_'.$i};
13189: if ($docstitle eq '') {
13190: $docstitle = $title;
13191: }
1.1055 raeburn 13192: $outer = 0;
1.1056 raeburn 13193: if (ref($dirorder{$i}) eq 'ARRAY') {
13194: if (@{$dirorder{$i}} > 0) {
13195: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 13196: if ($env{'form.archive_'.$item} eq 'display') {
13197: $outer = $item;
13198: last;
13199: }
13200: }
13201: }
13202: }
13203: my ($errtext,$fatal) =
13204: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
13205: '/'.$folders{$outer}.'.'.
13206: $containers{$outer});
13207: next if ($fatal);
13208: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
13209: if ($context eq 'coursedocs') {
1.1056 raeburn 13210: $mapinner{$i} = time;
1.1055 raeburn 13211: $folders{$i} = 'default_'.$mapinner{$i};
13212: $containers{$i} = 'sequence';
13213: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13214: $folders{$i}.'.'.$containers{$i};
13215: my $newidx = &LONCAPA::map::getresidx();
13216: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 13217: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 13218: push(@LONCAPA::map::order,$newidx);
13219: my ($outtext,$errtext) =
13220: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13221: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 13222: '.'.$containers{$outer},1,1);
1.1056 raeburn 13223: $newseqid{$i} = $newidx;
1.1067 raeburn 13224: unless ($errtext) {
1.1075.2.128 raeburn 13225: $result .= '<li>'.&mt('Folder: [_1] added to course',
13226: &HTML::Entities::encode($docstitle,'<>&"'))..
13227: '</li>'."\n";
1.1067 raeburn 13228: }
1.1055 raeburn 13229: }
13230: } else {
13231: if ($context eq 'coursedocs') {
13232: my $newidx=&LONCAPA::map::getresidx();
13233: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
13234: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
13235: $title;
1.1075.2.167 raeburn 13236: if (($outer !~ /\D/) &&
13237: (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
13238: ($newidx !~ /\D/)) {
1.1075.2.128 raeburn 13239: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
13240: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
1.1067 raeburn 13241: }
1.1075.2.128 raeburn 13242: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13243: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
13244: }
13245: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
13246: if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
13247: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
13248: unless ($ishome) {
13249: my $fetch = "$newdest{$i}/$title";
13250: $fetch =~ s/^\Q$prefix$dir\E//;
13251: $prompttofetch{$fetch} = 1;
13252: }
13253: }
13254: }
13255: $LONCAPA::map::resources[$newidx]=
13256: $docstitle.':'.$url.':false:normal:res';
13257: push(@LONCAPA::map::order, $newidx);
13258: my ($outtext,$errtext)=
13259: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
13260: $docuname.'/'.$folders{$outer}.
13261: '.'.$containers{$outer},1,1);
13262: unless ($errtext) {
13263: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
13264: $result .= '<li>'.&mt('File: [_1] added to course',
13265: &HTML::Entities::encode($docstitle,'<>&"')).
13266: '</li>'."\n";
13267: }
1.1067 raeburn 13268: }
1.1075.2.128 raeburn 13269: } else {
13270: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13271: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1067 raeburn 13272: }
1.1055 raeburn 13273: }
13274: }
1.1075.2.11 raeburn 13275: }
13276: } else {
1.1075.2.128 raeburn 13277: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13278: &HTML::Entities::encode($path,'<>&"')).'<br />';
1.1075.2.11 raeburn 13279: }
13280: }
13281: for (my $i=1; $i<=$numitems; $i++) {
13282: next unless ($env{'form.archive_'.$i} eq 'dependency');
13283: my $path = $env{'form.archive_content_'.$i};
13284: if ($path =~ /^\Q$pathtocheck\E/) {
13285: my ($title) = ($path =~ m{/([^/]+)$});
13286: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
13287: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
13288: if (ref($dirorder{$i}) eq 'ARRAY') {
13289: my ($itemidx,$fullpath,$relpath);
13290: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
13291: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 13292: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 13293: if ($dirorder{$i}->[$j] eq $container) {
13294: $itemidx = $j;
1.1056 raeburn 13295: }
13296: }
1.1075.2.11 raeburn 13297: }
13298: if ($itemidx eq '') {
13299: $itemidx = 0;
13300: }
13301: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
13302: if ($mapinner{$referrer{$i}}) {
13303: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
13304: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13305: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13306: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13307: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13308: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13309: if (!-e $fullpath) {
13310: mkdir($fullpath,0755);
1.1056 raeburn 13311: }
13312: }
1.1075.2.11 raeburn 13313: } else {
13314: last;
1.1056 raeburn 13315: }
1.1075.2.11 raeburn 13316: }
13317: }
13318: } elsif ($newdest{$referrer{$i}}) {
13319: $fullpath = $newdest{$referrer{$i}};
13320: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
13321: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
13322: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
13323: last;
13324: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
13325: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
13326: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
13327: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
13328: if (!-e $fullpath) {
13329: mkdir($fullpath,0755);
1.1056 raeburn 13330: }
13331: }
1.1075.2.11 raeburn 13332: } else {
13333: last;
1.1056 raeburn 13334: }
1.1075.2.11 raeburn 13335: }
13336: }
13337: if ($fullpath ne '') {
13338: if (-e "$prefix$path") {
1.1075.2.128 raeburn 13339: unless (rename("$prefix$path","$fullpath/$title")) {
13340: $warning .= &mt('Failed to rename dependency').'<br />';
13341: }
1.1075.2.11 raeburn 13342: }
13343: if (-e "$fullpath/$title") {
13344: my $showpath;
13345: if ($relpath ne '') {
13346: $showpath = "$relpath/$title";
13347: } else {
13348: $showpath = "/$title";
1.1056 raeburn 13349: }
1.1075.2.128 raeburn 13350: $result .= '<li>'.&mt('[_1] included as a dependency',
13351: &HTML::Entities::encode($showpath,'<>&"')).
13352: '</li>'."\n";
13353: unless ($ishome) {
13354: my $fetch = "$fullpath/$title";
13355: $fetch =~ s/^\Q$prefix$dir\E//;
13356: $prompttofetch{$fetch} = 1;
13357: }
1.1055 raeburn 13358: }
13359: }
13360: }
1.1075.2.11 raeburn 13361: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
13362: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
1.1075.2.128 raeburn 13363: &HTML::Entities::encode($path,'<>&"'),
13364: &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
13365: '<br />';
1.1055 raeburn 13366: }
13367: } else {
1.1075.2.128 raeburn 13368: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
13369: &HTML::Entities::encode($path)).'<br />';
1.1055 raeburn 13370: }
13371: }
13372: if (keys(%todelete)) {
13373: foreach my $key (keys(%todelete)) {
13374: unlink($key);
1.1066 raeburn 13375: }
13376: }
13377: if (keys(%todeletedir)) {
13378: foreach my $key (keys(%todeletedir)) {
13379: rmdir($key);
13380: }
13381: }
13382: foreach my $dir (sort(keys(%is_dir))) {
13383: if (($pathtocheck ne '') && ($dir ne '')) {
13384: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 13385: }
13386: }
1.1067 raeburn 13387: if ($result ne '') {
13388: $output .= '<ul>'."\n".
13389: $result."\n".
13390: '</ul>';
13391: }
13392: unless ($ishome) {
13393: my $replicationfail;
13394: foreach my $item (keys(%prompttofetch)) {
13395: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
13396: unless ($fetchresult eq 'ok') {
13397: $replicationfail .= '<li>'.$item.'</li>'."\n";
13398: }
13399: }
13400: if ($replicationfail) {
13401: $output .= '<p class="LC_error">'.
13402: &mt('Course home server failed to retrieve:').'<ul>'.
13403: $replicationfail.
13404: '</ul></p>';
13405: }
13406: }
1.1055 raeburn 13407: } else {
13408: $warning = &mt('No items found in archive.');
13409: }
13410: if ($error) {
13411: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
13412: $error.'</p>'."\n";
13413: }
13414: if ($warning) {
13415: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
13416: }
13417: return $output;
13418: }
13419:
1.1066 raeburn 13420: sub cleanup_empty_dirs {
13421: my ($path) = @_;
13422: if (($path ne '') && (-d $path)) {
13423: if (opendir(my $dirh,$path)) {
13424: my @dircontents = grep(!/^\./,readdir($dirh));
13425: my $numitems = 0;
13426: foreach my $item (@dircontents) {
13427: if (-d "$path/$item") {
1.1075.2.28 raeburn 13428: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 13429: if (-e "$path/$item") {
13430: $numitems ++;
13431: }
13432: } else {
13433: $numitems ++;
13434: }
13435: }
13436: if ($numitems == 0) {
13437: rmdir($path);
13438: }
13439: closedir($dirh);
13440: }
13441: }
13442: return;
13443: }
13444:
1.41 ng 13445: =pod
1.45 matthew 13446:
1.1075.2.56 raeburn 13447: =item * &get_folder_hierarchy()
1.1068 raeburn 13448:
13449: Provides hierarchy of names of folders/sub-folders containing the current
13450: item,
13451:
13452: Inputs: 3
13453: - $navmap - navmaps object
13454:
13455: - $map - url for map (either the trigger itself, or map containing
13456: the resource, which is the trigger).
13457:
13458: - $showitem - 1 => show title for map itself; 0 => do not show.
13459:
13460: Outputs: 1 @pathitems - array of folder/subfolder names.
13461:
13462: =cut
13463:
13464: sub get_folder_hierarchy {
13465: my ($navmap,$map,$showitem) = @_;
13466: my @pathitems;
13467: if (ref($navmap)) {
13468: my $mapres = $navmap->getResourceByUrl($map);
13469: if (ref($mapres)) {
13470: my $pcslist = $mapres->map_hierarchy();
13471: if ($pcslist ne '') {
13472: my @pcs = split(/,/,$pcslist);
13473: foreach my $pc (@pcs) {
13474: if ($pc == 1) {
1.1075.2.38 raeburn 13475: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 13476: } else {
13477: my $res = $navmap->getByMapPc($pc);
13478: if (ref($res)) {
13479: my $title = $res->compTitle();
13480: $title =~ s/\W+/_/g;
13481: if ($title ne '') {
13482: push(@pathitems,$title);
13483: }
13484: }
13485: }
13486: }
13487: }
1.1071 raeburn 13488: if ($showitem) {
13489: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 13490: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 13491: } else {
13492: my $maptitle = $mapres->compTitle();
13493: $maptitle =~ s/\W+/_/g;
13494: if ($maptitle ne '') {
13495: push(@pathitems,$maptitle);
13496: }
1.1068 raeburn 13497: }
13498: }
13499: }
13500: }
13501: return @pathitems;
13502: }
13503:
13504: =pod
13505:
1.1015 raeburn 13506: =item * &get_turnedin_filepath()
13507:
13508: Determines path in a user's portfolio file for storage of files uploaded
13509: to a specific essayresponse or dropbox item.
13510:
13511: Inputs: 3 required + 1 optional.
13512: $symb is symb for resource, $uname and $udom are for current user (required).
13513: $caller is optional (can be "submission", if routine is called when storing
13514: an upoaded file when "Submit Answer" button was pressed).
13515:
13516: Returns array containing $path and $multiresp.
13517: $path is path in portfolio. $multiresp is 1 if this resource contains more
13518: than one file upload item. Callers of routine should append partid as a
13519: subdirectory to $path in cases where $multiresp is 1.
13520:
13521: Called by: homework/essayresponse.pm and homework/structuretags.pm
13522:
13523: =cut
13524:
13525: sub get_turnedin_filepath {
13526: my ($symb,$uname,$udom,$caller) = @_;
13527: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
13528: my $turnindir;
13529: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
13530: $turnindir = $userhash{'turnindir'};
13531: my ($path,$multiresp);
13532: if ($turnindir eq '') {
13533: if ($caller eq 'submission') {
13534: $turnindir = &mt('turned in');
13535: $turnindir =~ s/\W+/_/g;
13536: my %newhash = (
13537: 'turnindir' => $turnindir,
13538: );
13539: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
13540: }
13541: }
13542: if ($turnindir ne '') {
13543: $path = '/'.$turnindir.'/';
13544: my ($multipart,$turnin,@pathitems);
13545: my $navmap = Apache::lonnavmaps::navmap->new();
13546: if (defined($navmap)) {
13547: my $mapres = $navmap->getResourceByUrl($map);
13548: if (ref($mapres)) {
13549: my $pcslist = $mapres->map_hierarchy();
13550: if ($pcslist ne '') {
13551: foreach my $pc (split(/,/,$pcslist)) {
13552: my $res = $navmap->getByMapPc($pc);
13553: if (ref($res)) {
13554: my $title = $res->compTitle();
13555: $title =~ s/\W+/_/g;
13556: if ($title ne '') {
1.1075.2.48 raeburn 13557: if (($pc > 1) && (length($title) > 12)) {
13558: $title = substr($title,0,12);
13559: }
1.1015 raeburn 13560: push(@pathitems,$title);
13561: }
13562: }
13563: }
13564: }
13565: my $maptitle = $mapres->compTitle();
13566: $maptitle =~ s/\W+/_/g;
13567: if ($maptitle ne '') {
1.1075.2.48 raeburn 13568: if (length($maptitle) > 12) {
13569: $maptitle = substr($maptitle,0,12);
13570: }
1.1015 raeburn 13571: push(@pathitems,$maptitle);
13572: }
13573: unless ($env{'request.state'} eq 'construct') {
13574: my $res = $navmap->getBySymb($symb);
13575: if (ref($res)) {
13576: my $partlist = $res->parts();
13577: my $totaluploads = 0;
13578: if (ref($partlist) eq 'ARRAY') {
13579: foreach my $part (@{$partlist}) {
13580: my @types = $res->responseType($part);
13581: my @ids = $res->responseIds($part);
13582: for (my $i=0; $i < scalar(@ids); $i++) {
13583: if ($types[$i] eq 'essay') {
13584: my $partid = $part.'_'.$ids[$i];
13585: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
13586: $totaluploads ++;
13587: }
13588: }
13589: }
13590: }
13591: if ($totaluploads > 1) {
13592: $multiresp = 1;
13593: }
13594: }
13595: }
13596: }
13597: } else {
13598: return;
13599: }
13600: } else {
13601: return;
13602: }
13603: my $restitle=&Apache::lonnet::gettitle($symb);
13604: $restitle =~ s/\W+/_/g;
13605: if ($restitle eq '') {
13606: $restitle = ($resurl =~ m{/[^/]+$});
13607: if ($restitle eq '') {
13608: $restitle = time;
13609: }
13610: }
1.1075.2.48 raeburn 13611: if (length($restitle) > 12) {
13612: $restitle = substr($restitle,0,12);
13613: }
1.1015 raeburn 13614: push(@pathitems,$restitle);
13615: $path .= join('/',@pathitems);
13616: }
13617: return ($path,$multiresp);
13618: }
13619:
13620: =pod
13621:
1.464 albertel 13622: =back
1.41 ng 13623:
1.112 bowersj2 13624: =head1 CSV Upload/Handling functions
1.38 albertel 13625:
1.41 ng 13626: =over 4
13627:
1.648 raeburn 13628: =item * &upfile_store($r)
1.41 ng 13629:
13630: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 13631: needs $env{'form.upfile'}
1.41 ng 13632: returns $datatoken to be put into hidden field
13633:
13634: =cut
1.31 albertel 13635:
13636: sub upfile_store {
13637: my $r=shift;
1.258 albertel 13638: $env{'form.upfile'}=~s/\r/\n/gs;
13639: $env{'form.upfile'}=~s/\f/\n/gs;
13640: $env{'form.upfile'}=~s/\n+/\n/gs;
13641: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 13642:
1.1075.2.128 raeburn 13643: my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
13644: '_enroll_'.$env{'request.course.id'}.'_'.
13645: time.'_'.$$);
13646: return if ($datatoken eq '');
13647:
1.31 albertel 13648: {
1.158 raeburn 13649: my $datafile = $r->dir_config('lonDaemons').
13650: '/tmp/'.$datatoken.'.tmp';
1.1075.2.128 raeburn 13651: if ( open(my $fh,'>',$datafile) ) {
1.258 albertel 13652: print $fh $env{'form.upfile'};
1.158 raeburn 13653: close($fh);
13654: }
1.31 albertel 13655: }
13656: return $datatoken;
13657: }
13658:
1.56 matthew 13659: =pod
13660:
1.1075.2.128 raeburn 13661: =item * &load_tmp_file($r,$datatoken)
1.41 ng 13662:
13663: Load uploaded file from tmp, $r should be the HTTP Request object,
1.1075.2.128 raeburn 13664: $datatoken is the name to assign to the temporary file.
1.258 albertel 13665: sets $env{'form.upfile'} to the contents of the file
1.41 ng 13666:
13667: =cut
1.31 albertel 13668:
13669: sub load_tmp_file {
1.1075.2.128 raeburn 13670: my ($r,$datatoken) = @_;
13671: return if ($datatoken eq '');
1.31 albertel 13672: my @studentdata=();
13673: {
1.158 raeburn 13674: my $studentfile = $r->dir_config('lonDaemons').
1.1075.2.128 raeburn 13675: '/tmp/'.$datatoken.'.tmp';
13676: if ( open(my $fh,'<',$studentfile) ) {
1.158 raeburn 13677: @studentdata=<$fh>;
13678: close($fh);
13679: }
1.31 albertel 13680: }
1.258 albertel 13681: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 13682: }
13683:
1.1075.2.128 raeburn 13684: sub valid_datatoken {
13685: my ($datatoken) = @_;
1.1075.2.131 raeburn 13686: if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
1.1075.2.128 raeburn 13687: return $datatoken;
13688: }
13689: return;
13690: }
13691:
1.56 matthew 13692: =pod
13693:
1.648 raeburn 13694: =item * &upfile_record_sep()
1.41 ng 13695:
13696: Separate uploaded file into records
13697: returns array of records,
1.258 albertel 13698: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 13699:
13700: =cut
1.31 albertel 13701:
13702: sub upfile_record_sep {
1.258 albertel 13703: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 13704: } else {
1.248 albertel 13705: my @records;
1.258 albertel 13706: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 13707: if ($line=~/^\s*$/) { next; }
13708: push(@records,$line);
13709: }
13710: return @records;
1.31 albertel 13711: }
13712: }
13713:
1.56 matthew 13714: =pod
13715:
1.648 raeburn 13716: =item * &record_sep($record)
1.41 ng 13717:
1.258 albertel 13718: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 13719:
13720: =cut
13721:
1.263 www 13722: sub takeleft {
13723: my $index=shift;
13724: return substr('0000'.$index,-4,4);
13725: }
13726:
1.31 albertel 13727: sub record_sep {
13728: my $record=shift;
13729: my %components=();
1.258 albertel 13730: if ($env{'form.upfiletype'} eq 'xml') {
13731: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 13732: my $i=0;
1.356 albertel 13733: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 13734: $field=~s/^(\"|\')//;
13735: $field=~s/(\"|\')$//;
1.263 www 13736: $components{&takeleft($i)}=$field;
1.31 albertel 13737: $i++;
13738: }
1.258 albertel 13739: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 13740: my $i=0;
1.356 albertel 13741: foreach my $field (split(/\t/,$record)) {
1.31 albertel 13742: $field=~s/^(\"|\')//;
13743: $field=~s/(\"|\')$//;
1.263 www 13744: $components{&takeleft($i)}=$field;
1.31 albertel 13745: $i++;
13746: }
13747: } else {
1.561 www 13748: my $separator=',';
1.480 banghart 13749: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 13750: $separator=';';
1.480 banghart 13751: }
1.31 albertel 13752: my $i=0;
1.561 www 13753: # the character we are looking for to indicate the end of a quote or a record
13754: my $looking_for=$separator;
13755: # do not add the characters to the fields
13756: my $ignore=0;
13757: # we just encountered a separator (or the beginning of the record)
13758: my $just_found_separator=1;
13759: # store the field we are working on here
13760: my $field='';
13761: # work our way through all characters in record
13762: foreach my $character ($record=~/(.)/g) {
13763: if ($character eq $looking_for) {
13764: if ($character ne $separator) {
13765: # Found the end of a quote, again looking for separator
13766: $looking_for=$separator;
13767: $ignore=1;
13768: } else {
13769: # Found a separator, store away what we got
13770: $components{&takeleft($i)}=$field;
13771: $i++;
13772: $just_found_separator=1;
13773: $ignore=0;
13774: $field='';
13775: }
13776: next;
13777: }
13778: # single or double quotation marks after a separator indicate beginning of a quote
13779: # we are now looking for the end of the quote and need to ignore separators
13780: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
13781: $looking_for=$character;
13782: next;
13783: }
13784: # ignore would be true after we reached the end of a quote
13785: if ($ignore) { next; }
13786: if (($just_found_separator) && ($character=~/\s/)) { next; }
13787: $field.=$character;
13788: $just_found_separator=0;
1.31 albertel 13789: }
1.561 www 13790: # catch the very last entry, since we never encountered the separator
13791: $components{&takeleft($i)}=$field;
1.31 albertel 13792: }
13793: return %components;
13794: }
13795:
1.144 matthew 13796: ######################################################
13797: ######################################################
13798:
1.56 matthew 13799: =pod
13800:
1.648 raeburn 13801: =item * &upfile_select_html()
1.41 ng 13802:
1.144 matthew 13803: Return HTML code to select a file from the users machine and specify
13804: the file type.
1.41 ng 13805:
13806: =cut
13807:
1.144 matthew 13808: ######################################################
13809: ######################################################
1.31 albertel 13810: sub upfile_select_html {
1.144 matthew 13811: my %Types = (
13812: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 13813: semisv => &mt('Semicolon separated values'),
1.144 matthew 13814: space => &mt('Space separated'),
13815: tab => &mt('Tabulator separated'),
13816: # xml => &mt('HTML/XML'),
13817: );
13818: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 13819: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 13820: foreach my $type (sort(keys(%Types))) {
13821: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
13822: }
13823: $Str .= "</select>\n";
13824: return $Str;
1.31 albertel 13825: }
13826:
1.301 albertel 13827: sub get_samples {
13828: my ($records,$toget) = @_;
13829: my @samples=({});
13830: my $got=0;
13831: foreach my $rec (@$records) {
13832: my %temp = &record_sep($rec);
13833: if (! grep(/\S/, values(%temp))) { next; }
13834: if (%temp) {
13835: $samples[$got]=\%temp;
13836: $got++;
13837: if ($got == $toget) { last; }
13838: }
13839: }
13840: return \@samples;
13841: }
13842:
1.144 matthew 13843: ######################################################
13844: ######################################################
13845:
1.56 matthew 13846: =pod
13847:
1.648 raeburn 13848: =item * &csv_print_samples($r,$records)
1.41 ng 13849:
13850: Prints a table of sample values from each column uploaded $r is an
13851: Apache Request ref, $records is an arrayref from
13852: &Apache::loncommon::upfile_record_sep
13853:
13854: =cut
13855:
1.144 matthew 13856: ######################################################
13857: ######################################################
1.31 albertel 13858: sub csv_print_samples {
13859: my ($r,$records) = @_;
1.662 bisitz 13860: my $samples = &get_samples($records,5);
1.301 albertel 13861:
1.594 raeburn 13862: $r->print(&mt('Samples').'<br />'.&start_data_table().
13863: &start_data_table_header_row());
1.356 albertel 13864: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 13865: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 13866: $r->print(&end_data_table_header_row());
1.301 albertel 13867: foreach my $hash (@$samples) {
1.594 raeburn 13868: $r->print(&start_data_table_row());
1.356 albertel 13869: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 13870: $r->print('<td>');
1.356 albertel 13871: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 13872: $r->print('</td>');
13873: }
1.594 raeburn 13874: $r->print(&end_data_table_row());
1.31 albertel 13875: }
1.594 raeburn 13876: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 13877: }
13878:
1.144 matthew 13879: ######################################################
13880: ######################################################
13881:
1.56 matthew 13882: =pod
13883:
1.648 raeburn 13884: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 13885:
13886: Prints a table to create associations between values and table columns.
1.144 matthew 13887:
1.41 ng 13888: $r is an Apache Request ref,
13889: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 13890: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 13891:
13892: =cut
13893:
1.144 matthew 13894: ######################################################
13895: ######################################################
1.31 albertel 13896: sub csv_print_select_table {
13897: my ($r,$records,$d) = @_;
1.301 albertel 13898: my $i=0;
13899: my $samples = &get_samples($records,1);
1.144 matthew 13900: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 13901: &start_data_table().&start_data_table_header_row().
1.144 matthew 13902: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 13903: '<th>'.&mt('Column').'</th>'.
13904: &end_data_table_header_row()."\n");
1.356 albertel 13905: foreach my $array_ref (@$d) {
13906: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 13907: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 13908:
1.875 bisitz 13909: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 13910: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 13911: $r->print('<option value="none"></option>');
1.356 albertel 13912: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
13913: $r->print('<option value="'.$sample.'"'.
13914: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 13915: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 13916: }
1.594 raeburn 13917: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 13918: $i++;
13919: }
1.594 raeburn 13920: $r->print(&end_data_table());
1.31 albertel 13921: $i--;
13922: return $i;
13923: }
1.56 matthew 13924:
1.144 matthew 13925: ######################################################
13926: ######################################################
13927:
1.56 matthew 13928: =pod
1.31 albertel 13929:
1.648 raeburn 13930: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 13931:
13932: Prints a table of sample values from the upload and can make associate samples to internal names.
13933:
13934: $r is an Apache Request ref,
13935: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
13936: $d is an array of 2 element arrays (internal name, displayed name)
13937:
13938: =cut
13939:
1.144 matthew 13940: ######################################################
13941: ######################################################
1.31 albertel 13942: sub csv_samples_select_table {
13943: my ($r,$records,$d) = @_;
13944: my $i=0;
1.144 matthew 13945: #
1.662 bisitz 13946: my $max_samples = 5;
13947: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 13948: $r->print(&start_data_table().
13949: &start_data_table_header_row().'<th>'.
13950: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
13951: &end_data_table_header_row());
1.301 albertel 13952:
13953: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 13954: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 13955: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 13956: foreach my $option (@$d) {
13957: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 13958: $r->print('<option value="'.$value.'"'.
1.253 albertel 13959: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 13960: $display.'</option>');
1.31 albertel 13961: }
13962: $r->print('</select></td><td>');
1.662 bisitz 13963: foreach my $line (0..($max_samples-1)) {
1.301 albertel 13964: if (defined($samples->[$line]{$key})) {
13965: $r->print($samples->[$line]{$key}."<br />\n");
13966: }
13967: }
1.594 raeburn 13968: $r->print('</td>'.&end_data_table_row());
1.31 albertel 13969: $i++;
13970: }
1.594 raeburn 13971: $r->print(&end_data_table());
1.31 albertel 13972: $i--;
13973: return($i);
1.115 matthew 13974: }
13975:
1.144 matthew 13976: ######################################################
13977: ######################################################
13978:
1.115 matthew 13979: =pod
13980:
1.648 raeburn 13981: =item * &clean_excel_name($name)
1.115 matthew 13982:
13983: Returns a replacement for $name which does not contain any illegal characters.
13984:
13985: =cut
13986:
1.144 matthew 13987: ######################################################
13988: ######################################################
1.115 matthew 13989: sub clean_excel_name {
13990: my ($name) = @_;
13991: $name =~ s/[:\*\?\/\\]//g;
13992: if (length($name) > 31) {
13993: $name = substr($name,0,31);
13994: }
13995: return $name;
1.25 albertel 13996: }
1.84 albertel 13997:
1.85 albertel 13998: =pod
13999:
1.648 raeburn 14000: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 14001:
14002: Returns either 1 or undef
14003:
14004: 1 if the part is to be hidden, undef if it is to be shown
14005:
14006: Arguments are:
14007:
14008: $id the id of the part to be checked
14009: $symb, optional the symb of the resource to check
14010: $udom, optional the domain of the user to check for
14011: $uname, optional the username of the user to check for
14012:
14013: =cut
1.84 albertel 14014:
14015: sub check_if_partid_hidden {
14016: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 14017: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 14018: $symb,$udom,$uname);
1.141 albertel 14019: my $truth=1;
14020: #if the string starts with !, then the list is the list to show not hide
14021: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 14022: my @hiddenlist=split(/,/,$hiddenparts);
14023: foreach my $checkid (@hiddenlist) {
1.141 albertel 14024: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 14025: }
1.141 albertel 14026: return !$truth;
1.84 albertel 14027: }
1.127 matthew 14028:
1.138 matthew 14029:
14030: ############################################################
14031: ############################################################
14032:
14033: =pod
14034:
1.157 matthew 14035: =back
14036:
1.138 matthew 14037: =head1 cgi-bin script and graphing routines
14038:
1.157 matthew 14039: =over 4
14040:
1.648 raeburn 14041: =item * &get_cgi_id()
1.138 matthew 14042:
14043: Inputs: none
14044:
14045: Returns an id which can be used to pass environment variables
14046: to various cgi-bin scripts. These environment variables will
14047: be removed from the users environment after a given time by
14048: the routine &Apache::lonnet::transfer_profile_to_env.
14049:
14050: =cut
14051:
14052: ############################################################
14053: ############################################################
1.152 albertel 14054: my $uniq=0;
1.136 matthew 14055: sub get_cgi_id {
1.154 albertel 14056: $uniq=($uniq+1)%100000;
1.280 albertel 14057: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 14058: }
14059:
1.127 matthew 14060: ############################################################
14061: ############################################################
14062:
14063: =pod
14064:
1.648 raeburn 14065: =item * &DrawBarGraph()
1.127 matthew 14066:
1.138 matthew 14067: Facilitates the plotting of data in a (stacked) bar graph.
14068: Puts plot definition data into the users environment in order for
14069: graph.png to plot it. Returns an <img> tag for the plot.
14070: The bars on the plot are labeled '1','2',...,'n'.
14071:
14072: Inputs:
14073:
14074: =over 4
14075:
14076: =item $Title: string, the title of the plot
14077:
14078: =item $xlabel: string, text describing the X-axis of the plot
14079:
14080: =item $ylabel: string, text describing the Y-axis of the plot
14081:
14082: =item $Max: scalar, the maximum Y value to use in the plot
14083: If $Max is < any data point, the graph will not be rendered.
14084:
1.140 matthew 14085: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 14086: they are plotted. If undefined, default values will be used.
14087:
1.178 matthew 14088: =item $labels: array ref holding the labels to use on the x-axis for the bars.
14089:
1.138 matthew 14090: =item @Values: An array of array references. Each array reference holds data
14091: to be plotted in a stacked bar chart.
14092:
1.239 matthew 14093: =item If the final element of @Values is a hash reference the key/value
14094: pairs will be added to the graph definition.
14095:
1.138 matthew 14096: =back
14097:
14098: Returns:
14099:
14100: An <img> tag which references graph.png and the appropriate identifying
14101: information for the plot.
14102:
1.127 matthew 14103: =cut
14104:
14105: ############################################################
14106: ############################################################
1.134 matthew 14107: sub DrawBarGraph {
1.178 matthew 14108: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 14109: #
14110: if (! defined($colors)) {
14111: $colors = ['#33ff00',
14112: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
14113: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
14114: ];
14115: }
1.228 matthew 14116: my $extra_settings = {};
14117: if (ref($Values[-1]) eq 'HASH') {
14118: $extra_settings = pop(@Values);
14119: }
1.127 matthew 14120: #
1.136 matthew 14121: my $identifier = &get_cgi_id();
14122: my $id = 'cgi.'.$identifier;
1.129 matthew 14123: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 14124: return '';
14125: }
1.225 matthew 14126: #
14127: my @Labels;
14128: if (defined($labels)) {
14129: @Labels = @$labels;
14130: } else {
14131: for (my $i=0;$i<@{$Values[0]};$i++) {
1.1075.2.119 raeburn 14132: push(@Labels,$i+1);
1.225 matthew 14133: }
14134: }
14135: #
1.129 matthew 14136: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 14137: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 14138: my %ValuesHash;
14139: my $NumSets=1;
14140: foreach my $array (@Values) {
14141: next if (! ref($array));
1.136 matthew 14142: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 14143: join(',',@$array);
1.129 matthew 14144: }
1.127 matthew 14145: #
1.136 matthew 14146: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 14147: if ($NumBars < 3) {
14148: $width = 120+$NumBars*32;
1.220 matthew 14149: $xskip = 1;
1.225 matthew 14150: $bar_width = 30;
14151: } elsif ($NumBars < 5) {
14152: $width = 120+$NumBars*20;
14153: $xskip = 1;
14154: $bar_width = 20;
1.220 matthew 14155: } elsif ($NumBars < 10) {
1.136 matthew 14156: $width = 120+$NumBars*15;
14157: $xskip = 1;
14158: $bar_width = 15;
14159: } elsif ($NumBars <= 25) {
14160: $width = 120+$NumBars*11;
14161: $xskip = 5;
14162: $bar_width = 8;
14163: } elsif ($NumBars <= 50) {
14164: $width = 120+$NumBars*8;
14165: $xskip = 5;
14166: $bar_width = 4;
14167: } else {
14168: $width = 120+$NumBars*8;
14169: $xskip = 5;
14170: $bar_width = 4;
14171: }
14172: #
1.137 matthew 14173: $Max = 1 if ($Max < 1);
14174: if ( int($Max) < $Max ) {
14175: $Max++;
14176: $Max = int($Max);
14177: }
1.127 matthew 14178: $Title = '' if (! defined($Title));
14179: $xlabel = '' if (! defined($xlabel));
14180: $ylabel = '' if (! defined($ylabel));
1.369 www 14181: $ValuesHash{$id.'.title'} = &escape($Title);
14182: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
14183: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 14184: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 14185: $ValuesHash{$id.'.NumBars'} = $NumBars;
14186: $ValuesHash{$id.'.NumSets'} = $NumSets;
14187: $ValuesHash{$id.'.PlotType'} = 'bar';
14188: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14189: $ValuesHash{$id.'.height'} = $height;
14190: $ValuesHash{$id.'.width'} = $width;
14191: $ValuesHash{$id.'.xskip'} = $xskip;
14192: $ValuesHash{$id.'.bar_width'} = $bar_width;
14193: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 14194: #
1.228 matthew 14195: # Deal with other parameters
14196: while (my ($key,$value) = each(%$extra_settings)) {
14197: $ValuesHash{$id.'.'.$key} = $value;
14198: }
14199: #
1.646 raeburn 14200: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 14201: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14202: }
14203:
14204: ############################################################
14205: ############################################################
14206:
14207: =pod
14208:
1.648 raeburn 14209: =item * &DrawXYGraph()
1.137 matthew 14210:
1.138 matthew 14211: Facilitates the plotting of data in an XY graph.
14212: Puts plot definition data into the users environment in order for
14213: graph.png to plot it. Returns an <img> tag for the plot.
14214:
14215: Inputs:
14216:
14217: =over 4
14218:
14219: =item $Title: string, the title of the plot
14220:
14221: =item $xlabel: string, text describing the X-axis of the plot
14222:
14223: =item $ylabel: string, text describing the Y-axis of the plot
14224:
14225: =item $Max: scalar, the maximum Y value to use in the plot
14226: If $Max is < any data point, the graph will not be rendered.
14227:
14228: =item $colors: Array ref containing the hex color codes for the data to be
14229: plotted in. If undefined, default values will be used.
14230:
14231: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14232:
14233: =item $Ydata: Array ref containing Array refs.
1.185 www 14234: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 14235:
14236: =item %Values: hash indicating or overriding any default values which are
14237: passed to graph.png.
14238: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14239:
14240: =back
14241:
14242: Returns:
14243:
14244: An <img> tag which references graph.png and the appropriate identifying
14245: information for the plot.
14246:
1.137 matthew 14247: =cut
14248:
14249: ############################################################
14250: ############################################################
14251: sub DrawXYGraph {
14252: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
14253: #
14254: # Create the identifier for the graph
14255: my $identifier = &get_cgi_id();
14256: my $id = 'cgi.'.$identifier;
14257: #
14258: $Title = '' if (! defined($Title));
14259: $xlabel = '' if (! defined($xlabel));
14260: $ylabel = '' if (! defined($ylabel));
14261: my %ValuesHash =
14262: (
1.369 www 14263: $id.'.title' => &escape($Title),
14264: $id.'.xlabel' => &escape($xlabel),
14265: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 14266: $id.'.y_max_value'=> $Max,
14267: $id.'.labels' => join(',',@$Xlabels),
14268: $id.'.PlotType' => 'XY',
14269: );
14270: #
14271: if (defined($colors) && ref($colors) eq 'ARRAY') {
14272: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14273: }
14274: #
14275: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
14276: return '';
14277: }
14278: my $NumSets=1;
1.138 matthew 14279: foreach my $array (@{$Ydata}){
1.137 matthew 14280: next if (! ref($array));
14281: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
14282: }
1.138 matthew 14283: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 14284: #
14285: # Deal with other parameters
14286: while (my ($key,$value) = each(%Values)) {
14287: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 14288: }
14289: #
1.646 raeburn 14290: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 14291: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
14292: }
14293:
14294: ############################################################
14295: ############################################################
14296:
14297: =pod
14298:
1.648 raeburn 14299: =item * &DrawXYYGraph()
1.138 matthew 14300:
14301: Facilitates the plotting of data in an XY graph with two Y axes.
14302: Puts plot definition data into the users environment in order for
14303: graph.png to plot it. Returns an <img> tag for the plot.
14304:
14305: Inputs:
14306:
14307: =over 4
14308:
14309: =item $Title: string, the title of the plot
14310:
14311: =item $xlabel: string, text describing the X-axis of the plot
14312:
14313: =item $ylabel: string, text describing the Y-axis of the plot
14314:
14315: =item $colors: Array ref containing the hex color codes for the data to be
14316: plotted in. If undefined, default values will be used.
14317:
14318: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
14319:
14320: =item $Ydata1: The first data set
14321:
14322: =item $Min1: The minimum value of the left Y-axis
14323:
14324: =item $Max1: The maximum value of the left Y-axis
14325:
14326: =item $Ydata2: The second data set
14327:
14328: =item $Min2: The minimum value of the right Y-axis
14329:
14330: =item $Max2: The maximum value of the left Y-axis
14331:
14332: =item %Values: hash indicating or overriding any default values which are
14333: passed to graph.png.
14334: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
14335:
14336: =back
14337:
14338: Returns:
14339:
14340: An <img> tag which references graph.png and the appropriate identifying
14341: information for the plot.
1.136 matthew 14342:
14343: =cut
14344:
14345: ############################################################
14346: ############################################################
1.137 matthew 14347: sub DrawXYYGraph {
14348: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
14349: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 14350: #
14351: # Create the identifier for the graph
14352: my $identifier = &get_cgi_id();
14353: my $id = 'cgi.'.$identifier;
14354: #
14355: $Title = '' if (! defined($Title));
14356: $xlabel = '' if (! defined($xlabel));
14357: $ylabel = '' if (! defined($ylabel));
14358: my %ValuesHash =
14359: (
1.369 www 14360: $id.'.title' => &escape($Title),
14361: $id.'.xlabel' => &escape($xlabel),
14362: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 14363: $id.'.labels' => join(',',@$Xlabels),
14364: $id.'.PlotType' => 'XY',
14365: $id.'.NumSets' => 2,
1.137 matthew 14366: $id.'.two_axes' => 1,
14367: $id.'.y1_max_value' => $Max1,
14368: $id.'.y1_min_value' => $Min1,
14369: $id.'.y2_max_value' => $Max2,
14370: $id.'.y2_min_value' => $Min2,
1.136 matthew 14371: );
14372: #
1.137 matthew 14373: if (defined($colors) && ref($colors) eq 'ARRAY') {
14374: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
14375: }
14376: #
14377: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
14378: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 14379: return '';
14380: }
14381: my $NumSets=1;
1.137 matthew 14382: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 14383: next if (! ref($array));
14384: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 14385: }
14386: #
14387: # Deal with other parameters
14388: while (my ($key,$value) = each(%Values)) {
14389: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 14390: }
14391: #
1.646 raeburn 14392: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 14393: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 14394: }
14395:
14396: ############################################################
14397: ############################################################
14398:
14399: =pod
14400:
1.157 matthew 14401: =back
14402:
1.139 matthew 14403: =head1 Statistics helper routines?
14404:
14405: Bad place for them but what the hell.
14406:
1.157 matthew 14407: =over 4
14408:
1.648 raeburn 14409: =item * &chartlink()
1.139 matthew 14410:
14411: Returns a link to the chart for a specific student.
14412:
14413: Inputs:
14414:
14415: =over 4
14416:
14417: =item $linktext: The text of the link
14418:
14419: =item $sname: The students username
14420:
14421: =item $sdomain: The students domain
14422:
14423: =back
14424:
1.157 matthew 14425: =back
14426:
1.139 matthew 14427: =cut
14428:
14429: ############################################################
14430: ############################################################
14431: sub chartlink {
14432: my ($linktext, $sname, $sdomain) = @_;
14433: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 14434: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 14435: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 14436: '">'.$linktext.'</a>';
1.153 matthew 14437: }
14438:
14439: #######################################################
14440: #######################################################
14441:
14442: =pod
14443:
14444: =head1 Course Environment Routines
1.157 matthew 14445:
14446: =over 4
1.153 matthew 14447:
1.648 raeburn 14448: =item * &restore_course_settings()
1.153 matthew 14449:
1.648 raeburn 14450: =item * &store_course_settings()
1.153 matthew 14451:
14452: Restores/Store indicated form parameters from the course environment.
14453: Will not overwrite existing values of the form parameters.
14454:
14455: Inputs:
14456: a scalar describing the data (e.g. 'chart', 'problem_analysis')
14457:
14458: a hash ref describing the data to be stored. For example:
14459:
14460: %Save_Parameters = ('Status' => 'scalar',
14461: 'chartoutputmode' => 'scalar',
14462: 'chartoutputdata' => 'scalar',
14463: 'Section' => 'array',
1.373 raeburn 14464: 'Group' => 'array',
1.153 matthew 14465: 'StudentData' => 'array',
14466: 'Maps' => 'array');
14467:
14468: Returns: both routines return nothing
14469:
1.631 raeburn 14470: =back
14471:
1.153 matthew 14472: =cut
14473:
14474: #######################################################
14475: #######################################################
14476: sub store_course_settings {
1.496 albertel 14477: return &store_settings($env{'request.course.id'},@_);
14478: }
14479:
14480: sub store_settings {
1.153 matthew 14481: # save to the environment
14482: # appenv the same items, just to be safe
1.300 albertel 14483: my $udom = $env{'user.domain'};
14484: my $uname = $env{'user.name'};
1.496 albertel 14485: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14486: my %SaveHash;
14487: my %AppHash;
14488: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 14489: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 14490: my $envname = 'environment.'.$basename;
1.258 albertel 14491: if (exists($env{'form.'.$setting})) {
1.153 matthew 14492: # Save this value away
14493: if ($type eq 'scalar' &&
1.258 albertel 14494: (! exists($env{$envname}) ||
14495: $env{$envname} ne $env{'form.'.$setting})) {
14496: $SaveHash{$basename} = $env{'form.'.$setting};
14497: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 14498: } elsif ($type eq 'array') {
14499: my $stored_form;
1.258 albertel 14500: if (ref($env{'form.'.$setting})) {
1.153 matthew 14501: $stored_form = join(',',
14502: map {
1.369 www 14503: &escape($_);
1.258 albertel 14504: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 14505: } else {
14506: $stored_form =
1.369 www 14507: &escape($env{'form.'.$setting});
1.153 matthew 14508: }
14509: # Determine if the array contents are the same.
1.258 albertel 14510: if ($stored_form ne $env{$envname}) {
1.153 matthew 14511: $SaveHash{$basename} = $stored_form;
14512: $AppHash{$envname} = $stored_form;
14513: }
14514: }
14515: }
14516: }
14517: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 14518: $udom,$uname);
1.153 matthew 14519: if ($put_result !~ /^(ok|delayed)/) {
14520: &Apache::lonnet::logthis('unable to save form parameters, '.
14521: 'got error:'.$put_result);
14522: }
14523: # Make sure these settings stick around in this session, too
1.646 raeburn 14524: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 14525: return;
14526: }
14527:
14528: sub restore_course_settings {
1.499 albertel 14529: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 14530: }
14531:
14532: sub restore_settings {
14533: my ($context,$prefix,$Settings) = @_;
1.153 matthew 14534: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 14535: next if (exists($env{'form.'.$setting}));
1.496 albertel 14536: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 14537: '.'.$setting;
1.258 albertel 14538: if (exists($env{$envname})) {
1.153 matthew 14539: if ($type eq 'scalar') {
1.258 albertel 14540: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 14541: } elsif ($type eq 'array') {
1.258 albertel 14542: $env{'form.'.$setting} = [
1.153 matthew 14543: map {
1.369 www 14544: &unescape($_);
1.258 albertel 14545: } split(',',$env{$envname})
1.153 matthew 14546: ];
14547: }
14548: }
14549: }
1.127 matthew 14550: }
14551:
1.618 raeburn 14552: #######################################################
14553: #######################################################
14554:
14555: =pod
14556:
14557: =head1 Domain E-mail Routines
14558:
14559: =over 4
14560:
1.648 raeburn 14561: =item * &build_recipient_list()
1.618 raeburn 14562:
1.1075.2.44 raeburn 14563: Build recipient lists for following types of e-mail:
1.766 raeburn 14564: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 14565: (d) Help requests, (e) Course requests needing approval, (f) loncapa
14566: module change checking, student/employee ID conflict checks, as
14567: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
14568: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 14569:
14570: Inputs:
1.1075.2.44 raeburn 14571: defmail (scalar - email address of default recipient),
14572: mailing type (scalar: errormail, packagesmail, helpdeskmail,
14573: requestsmail, updatesmail, or idconflictsmail).
14574:
1.619 raeburn 14575: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 14576:
14577: origmail (scalar - email address of recipient from loncapa.conf,
14578: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 14579:
1.1075.2.139 raeburn 14580: $requname username of requester (if mailing type is helpdeskmail)
14581:
14582: $requdom domain of requester (if mailing type is helpdeskmail)
14583:
14584: $reqemail e-mail address of requester (if mailing type is helpdeskmail)
14585:
1.655 raeburn 14586: Returns: comma separated list of addresses to which to send e-mail.
14587:
14588: =back
1.618 raeburn 14589:
14590: =cut
14591:
14592: ############################################################
14593: ############################################################
14594: sub build_recipient_list {
1.1075.2.139 raeburn 14595: my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
1.618 raeburn 14596: my @recipients;
1.1075.2.122 raeburn 14597: my ($otheremails,$lastresort,$allbcc,$addtext);
1.618 raeburn 14598: my %domconfig =
1.1075.2.122 raeburn 14599: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
1.618 raeburn 14600: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 14601: if (exists($domconfig{'contacts'}{$mailing})) {
14602: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
14603: my @contacts = ('adminemail','supportemail');
14604: foreach my $item (@contacts) {
14605: if ($domconfig{'contacts'}{$mailing}{$item}) {
14606: my $addr = $domconfig{'contacts'}{$item};
14607: if (!grep(/^\Q$addr\E$/,@recipients)) {
14608: push(@recipients,$addr);
14609: }
1.619 raeburn 14610: }
1.1075.2.122 raeburn 14611: }
14612: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
14613: if ($mailing eq 'helpdeskmail') {
14614: if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
14615: my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
14616: my @ok_bccs;
14617: foreach my $bcc (@bccs) {
14618: $bcc =~ s/^\s+//g;
14619: $bcc =~ s/\s+$//g;
14620: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14621: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14622: push(@ok_bccs,$bcc);
14623: }
14624: }
14625: }
14626: if (@ok_bccs > 0) {
14627: $allbcc = join(', ',@ok_bccs);
14628: }
14629: }
14630: $addtext = $domconfig{'contacts'}{$mailing}{'include'};
1.618 raeburn 14631: }
14632: }
1.766 raeburn 14633: } elsif ($origmail ne '') {
1.1075.2.122 raeburn 14634: $lastresort = $origmail;
1.618 raeburn 14635: }
1.1075.2.139 raeburn 14636: if ($mailing eq 'helpdeskmail') {
14637: if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
14638: (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
14639: my ($inststatus,$inststatus_checked);
14640: if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
14641: ($env{'user.domain'} ne 'public')) {
14642: $inststatus_checked = 1;
14643: $inststatus = $env{'environment.inststatus'};
14644: }
14645: unless ($inststatus_checked) {
14646: if (($requname ne '') && ($requdom ne '')) {
14647: if (($requname =~ /^$match_username$/) &&
14648: ($requdom =~ /^$match_domain$/) &&
14649: (&Apache::lonnet::domain($requdom))) {
14650: my $requhome = &Apache::lonnet::homeserver($requname,
14651: $requdom);
14652: unless ($requhome eq 'no_host') {
14653: my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
14654: $inststatus = $userenv{'inststatus'};
14655: $inststatus_checked = 1;
14656: }
14657: }
14658: }
14659: }
14660: unless ($inststatus_checked) {
14661: if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
14662: my %srch = (srchby => 'email',
14663: srchdomain => $defdom,
14664: srchterm => $reqemail,
14665: srchtype => 'exact');
14666: my %srch_results = &Apache::lonnet::usersearch(\%srch);
14667: foreach my $uname (keys(%srch_results)) {
14668: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14669: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14670: $inststatus_checked = 1;
14671: last;
14672: }
14673: }
14674: unless ($inststatus_checked) {
14675: my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
14676: if ($dirsrchres eq 'ok') {
14677: foreach my $uname (keys(%srch_results)) {
14678: if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
14679: $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
14680: $inststatus_checked = 1;
14681: last;
14682: }
14683: }
14684: }
14685: }
14686: }
14687: }
14688: if ($inststatus ne '') {
14689: foreach my $status (split(/\:/,$inststatus)) {
14690: if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
14691: my @contacts = ('adminemail','supportemail');
14692: foreach my $item (@contacts) {
14693: if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
14694: my $addr = $domconfig{'contacts'}{'overrides'}{$status};
14695: if (!grep(/^\Q$addr\E$/,@recipients)) {
14696: push(@recipients,$addr);
14697: }
14698: }
14699: }
14700: $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
14701: if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
14702: my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
14703: my @ok_bccs;
14704: foreach my $bcc (@bccs) {
14705: $bcc =~ s/^\s+//g;
14706: $bcc =~ s/\s+$//g;
14707: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14708: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14709: push(@ok_bccs,$bcc);
14710: }
14711: }
14712: }
14713: if (@ok_bccs > 0) {
14714: $allbcc = join(', ',@ok_bccs);
14715: }
14716: }
14717: $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
14718: last;
14719: }
14720: }
14721: }
14722: }
14723: }
1.619 raeburn 14724: } elsif ($origmail ne '') {
1.1075.2.122 raeburn 14725: $lastresort = $origmail;
14726: }
1.1075.2.128 raeburn 14727: if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
1.1075.2.122 raeburn 14728: unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
14729: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
14730: my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
14731: my %what = (
14732: perlvar => 1,
14733: );
14734: my $primary = &Apache::lonnet::domain($defdom,'primary');
14735: if ($primary) {
14736: my $gotaddr;
14737: my ($result,$returnhash) =
14738: &Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
14739: if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
14740: if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
14741: $lastresort = $returnhash->{'lonSupportEMail'};
14742: $gotaddr = 1;
14743: }
14744: }
14745: unless ($gotaddr) {
14746: my $uintdom = &Apache::lonnet::internet_dom($primary);
14747: my $intdom = &Apache::lonnet::internet_dom($lonhost);
14748: unless ($uintdom eq $intdom) {
14749: my %domconfig =
14750: &Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
14751: if (ref($domconfig{'contacts'}) eq 'HASH') {
14752: if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
14753: my @contacts = ('adminemail','supportemail');
14754: foreach my $item (@contacts) {
14755: if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
14756: my $addr = $domconfig{'contacts'}{$item};
14757: if (!grep(/^\Q$addr\E$/,@recipients)) {
14758: push(@recipients,$addr);
14759: }
14760: }
14761: }
14762: if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
14763: $otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
14764: }
14765: if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
14766: my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
14767: my @ok_bccs;
14768: foreach my $bcc (@bccs) {
14769: $bcc =~ s/^\s+//g;
14770: $bcc =~ s/\s+$//g;
14771: if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
14772: if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
14773: push(@ok_bccs,$bcc);
14774: }
14775: }
14776: }
14777: if (@ok_bccs > 0) {
14778: $allbcc = join(', ',@ok_bccs);
14779: }
14780: }
14781: $addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
14782: }
14783: }
14784: }
14785: }
14786: }
14787: }
1.618 raeburn 14788: }
1.688 raeburn 14789: if (defined($defmail)) {
14790: if ($defmail ne '') {
14791: push(@recipients,$defmail);
14792: }
1.618 raeburn 14793: }
14794: if ($otheremails) {
1.619 raeburn 14795: my @others;
14796: if ($otheremails =~ /,/) {
14797: @others = split(/,/,$otheremails);
1.618 raeburn 14798: } else {
1.619 raeburn 14799: push(@others,$otheremails);
14800: }
14801: foreach my $addr (@others) {
14802: if (!grep(/^\Q$addr\E$/,@recipients)) {
14803: push(@recipients,$addr);
14804: }
1.618 raeburn 14805: }
14806: }
1.1075.2.128 raeburn 14807: if ($mailing eq 'helpdeskmail') {
1.1075.2.122 raeburn 14808: if ((!@recipients) && ($lastresort ne '')) {
14809: push(@recipients,$lastresort);
14810: }
14811: } elsif ($lastresort ne '') {
14812: if (!grep(/^\Q$lastresort\E$/,@recipients)) {
14813: push(@recipients,$lastresort);
14814: }
14815: }
14816: my $recipientlist = join(',',@recipients);
14817: if (wantarray) {
14818: return ($recipientlist,$allbcc,$addtext);
14819: } else {
14820: return $recipientlist;
14821: }
1.618 raeburn 14822: }
14823:
1.127 matthew 14824: ############################################################
14825: ############################################################
1.154 albertel 14826:
1.655 raeburn 14827: =pod
14828:
14829: =head1 Course Catalog Routines
14830:
14831: =over 4
14832:
14833: =item * &gather_categories()
14834:
14835: Converts category definitions - keys of categories hash stored in
14836: coursecategories in configuration.db on the primary library server in a
14837: domain - to an array. Also generates javascript and idx hash used to
14838: generate Domain Coordinator interface for editing Course Categories.
14839:
14840: Inputs:
1.663 raeburn 14841:
1.655 raeburn 14842: categories (reference to hash of category definitions).
1.663 raeburn 14843:
1.655 raeburn 14844: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14845: categories and subcategories).
1.663 raeburn 14846:
1.655 raeburn 14847: idx (reference to hash of counters used in Domain Coordinator interface for
14848: editing Course Categories).
1.663 raeburn 14849:
1.655 raeburn 14850: jsarray (reference to array of categories used to create Javascript arrays for
14851: Domain Coordinator interface for editing Course Categories).
14852:
14853: Returns: nothing
14854:
14855: Side effects: populates cats, idx and jsarray.
14856:
14857: =cut
14858:
14859: sub gather_categories {
14860: my ($categories,$cats,$idx,$jsarray) = @_;
14861: my %counters;
14862: my $num = 0;
14863: foreach my $item (keys(%{$categories})) {
14864: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
14865: if ($container eq '' && $depth == 0) {
14866: $cats->[$depth][$categories->{$item}] = $cat;
14867: } else {
14868: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
14869: }
14870: my ($escitem,$tail) = split(/:/,$item,2);
14871: if ($counters{$tail} eq '') {
14872: $counters{$tail} = $num;
14873: $num ++;
14874: }
14875: if (ref($idx) eq 'HASH') {
14876: $idx->{$item} = $counters{$tail};
14877: }
14878: if (ref($jsarray) eq 'ARRAY') {
14879: push(@{$jsarray->[$counters{$tail}]},$item);
14880: }
14881: }
14882: return;
14883: }
14884:
14885: =pod
14886:
14887: =item * &extract_categories()
14888:
14889: Used to generate breadcrumb trails for course categories.
14890:
14891: Inputs:
1.663 raeburn 14892:
1.655 raeburn 14893: categories (reference to hash of category definitions).
1.663 raeburn 14894:
1.655 raeburn 14895: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14896: categories and subcategories).
1.663 raeburn 14897:
1.655 raeburn 14898: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 14899:
1.655 raeburn 14900: allitems (reference to hash - key is category key
14901: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14902:
1.655 raeburn 14903: idx (reference to hash of counters used in Domain Coordinator interface for
14904: editing Course Categories).
1.663 raeburn 14905:
1.655 raeburn 14906: jsarray (reference to array of categories used to create Javascript arrays for
14907: Domain Coordinator interface for editing Course Categories).
14908:
1.665 raeburn 14909: subcats (reference to hash of arrays containing all subcategories within each
14910: category, -recursive)
14911:
1.1075.2.132 raeburn 14912: maxd (reference to hash used to hold max depth for all top-level categories).
14913:
1.655 raeburn 14914: Returns: nothing
14915:
14916: Side effects: populates trails and allitems hash references.
14917:
14918: =cut
14919:
14920: sub extract_categories {
1.1075.2.132 raeburn 14921: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
1.655 raeburn 14922: if (ref($categories) eq 'HASH') {
14923: &gather_categories($categories,$cats,$idx,$jsarray);
14924: if (ref($cats->[0]) eq 'ARRAY') {
14925: for (my $i=0; $i<@{$cats->[0]}; $i++) {
14926: my $name = $cats->[0][$i];
14927: my $item = &escape($name).'::0';
14928: my $trailstr;
14929: if ($name eq 'instcode') {
14930: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 14931: } elsif ($name eq 'communities') {
14932: $trailstr = &mt('Communities');
1.655 raeburn 14933: } else {
14934: $trailstr = $name;
14935: }
14936: if ($allitems->{$item} eq '') {
14937: push(@{$trails},$trailstr);
14938: $allitems->{$item} = scalar(@{$trails})-1;
14939: }
14940: my @parents = ($name);
14941: if (ref($cats->[1]{$name}) eq 'ARRAY') {
14942: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
14943: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 14944: if (ref($subcats) eq 'HASH') {
14945: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
14946: }
1.1075.2.132 raeburn 14947: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
1.665 raeburn 14948: }
14949: } else {
14950: if (ref($subcats) eq 'HASH') {
14951: $subcats->{$item} = [];
1.655 raeburn 14952: }
1.1075.2.132 raeburn 14953: if (ref($maxd) eq 'HASH') {
14954: $maxd->{$name} = 1;
14955: }
1.655 raeburn 14956: }
14957: }
14958: }
14959: }
14960: return;
14961: }
14962:
14963: =pod
14964:
1.1075.2.56 raeburn 14965: =item * &recurse_categories()
1.655 raeburn 14966:
14967: Recursively used to generate breadcrumb trails for course categories.
14968:
14969: Inputs:
1.663 raeburn 14970:
1.655 raeburn 14971: cats (reference to array of arrays/hashes which encapsulates hierarchy of
14972: categories and subcategories).
1.663 raeburn 14973:
1.655 raeburn 14974: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 14975:
14976: category (current course category, for which breadcrumb trail is being generated).
14977:
14978: trails (reference to array of breadcrumb trails for each category).
14979:
1.655 raeburn 14980: allitems (reference to hash - key is category key
14981: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 14982:
1.655 raeburn 14983: parents (array containing containers directories for current category,
14984: back to top level).
14985:
14986: Returns: nothing
14987:
14988: Side effects: populates trails and allitems hash references
14989:
14990: =cut
14991:
14992: sub recurse_categories {
1.1075.2.132 raeburn 14993: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
1.655 raeburn 14994: my $shallower = $depth - 1;
14995: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
14996: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
14997: my $name = $cats->[$depth]{$category}[$k];
14998: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.164 raeburn 14999: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 15000: if ($allitems->{$item} eq '') {
15001: push(@{$trails},$trailstr);
15002: $allitems->{$item} = scalar(@{$trails})-1;
15003: }
15004: my $deeper = $depth+1;
15005: push(@{$parents},$category);
1.665 raeburn 15006: if (ref($subcats) eq 'HASH') {
15007: my $subcat = &escape($name).':'.$category.':'.$depth;
15008: for (my $j=@{$parents}; $j>=0; $j--) {
15009: my $higher;
15010: if ($j > 0) {
15011: $higher = &escape($parents->[$j]).':'.
15012: &escape($parents->[$j-1]).':'.$j;
15013: } else {
15014: $higher = &escape($parents->[$j]).'::'.$j;
15015: }
15016: push(@{$subcats->{$higher}},$subcat);
15017: }
15018: }
15019: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
1.1075.2.132 raeburn 15020: $subcats,$maxd);
1.655 raeburn 15021: pop(@{$parents});
15022: }
15023: } else {
15024: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
1.1075.2.132 raeburn 15025: my $trailstr = join(' » ',(@{$parents},$category));
1.655 raeburn 15026: if ($allitems->{$item} eq '') {
15027: push(@{$trails},$trailstr);
15028: $allitems->{$item} = scalar(@{$trails})-1;
15029: }
1.1075.2.132 raeburn 15030: if (ref($maxd) eq 'HASH') {
15031: if ($depth > $maxd->{$parents->[0]}) {
15032: $maxd->{$parents->[0]} = $depth;
15033: }
15034: }
1.655 raeburn 15035: }
15036: return;
15037: }
15038:
1.663 raeburn 15039: =pod
15040:
1.1075.2.56 raeburn 15041: =item * &assign_categories_table()
1.663 raeburn 15042:
15043: Create a datatable for display of hierarchical categories in a domain,
15044: with checkboxes to allow a course to be categorized.
15045:
15046: Inputs:
15047:
15048: cathash - reference to hash of categories defined for the domain (from
15049: configuration.db)
15050:
15051: currcat - scalar with an & separated list of categories assigned to a course.
15052:
1.919 raeburn 15053: type - scalar contains course type (Course or Community).
15054:
1.1075.2.117 raeburn 15055: disabled - scalar (optional) contains disabled="disabled" if input elements are
15056: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15057:
1.663 raeburn 15058: Returns: $output (markup to be displayed)
15059:
15060: =cut
15061:
15062: sub assign_categories_table {
1.1075.2.117 raeburn 15063: my ($cathash,$currcat,$type,$disabled) = @_;
1.663 raeburn 15064: my $output;
15065: if (ref($cathash) eq 'HASH') {
1.1075.2.132 raeburn 15066: my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
15067: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
1.663 raeburn 15068: $maxdepth = scalar(@cats);
15069: if (@cats > 0) {
15070: my $itemcount = 0;
15071: if (ref($cats[0]) eq 'ARRAY') {
15072: my @currcategories;
15073: if ($currcat ne '') {
15074: @currcategories = split('&',$currcat);
15075: }
1.919 raeburn 15076: my $table;
1.663 raeburn 15077: for (my $i=0; $i<@{$cats[0]}; $i++) {
15078: my $parent = $cats[0][$i];
1.919 raeburn 15079: next if ($parent eq 'instcode');
15080: if ($type eq 'Community') {
15081: next unless ($parent eq 'communities');
15082: } else {
15083: next if ($parent eq 'communities');
15084: }
1.663 raeburn 15085: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
15086: my $item = &escape($parent).'::0';
15087: my $checked = '';
15088: if (@currcategories > 0) {
15089: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 15090: $checked = ' checked="checked"';
1.663 raeburn 15091: }
15092: }
1.919 raeburn 15093: my $parent_title = $parent;
15094: if ($parent eq 'communities') {
15095: $parent_title = &mt('Communities');
15096: }
15097: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
15098: '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117 raeburn 15099: $item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
1.919 raeburn 15100: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 15101: my $depth = 1;
15102: push(@path,$parent);
1.1075.2.117 raeburn 15103: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
1.663 raeburn 15104: pop(@path);
1.919 raeburn 15105: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 15106: $itemcount ++;
15107: }
1.919 raeburn 15108: if ($itemcount) {
15109: $output = &Apache::loncommon::start_data_table().
15110: $table.
15111: &Apache::loncommon::end_data_table();
15112: }
1.663 raeburn 15113: }
15114: }
15115: }
15116: return $output;
15117: }
15118:
15119: =pod
15120:
1.1075.2.56 raeburn 15121: =item * &assign_category_rows()
1.663 raeburn 15122:
15123: Create a datatable row for display of nested categories in a domain,
15124: with checkboxes to allow a course to be categorized,called recursively.
15125:
15126: Inputs:
15127:
15128: itemcount - track row number for alternating colors
15129:
15130: cats - reference to array of arrays/hashes which encapsulates hierarchy of
15131: categories and subcategories.
15132:
15133: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
15134:
15135: parent - parent of current category item
15136:
15137: path - Array containing all categories back up through the hierarchy from the
15138: current category to the top level.
15139:
15140: currcategories - reference to array of current categories assigned to the course
15141:
1.1075.2.117 raeburn 15142: disabled - scalar (optional) contains disabled="disabled" if input elements are
15143: to be readonly (e.g., Domain Helpdesk role viewing course settings).
15144:
1.663 raeburn 15145: Returns: $output (markup to be displayed).
15146:
15147: =cut
15148:
15149: sub assign_category_rows {
1.1075.2.117 raeburn 15150: my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
1.663 raeburn 15151: my ($text,$name,$item,$chgstr);
15152: if (ref($cats) eq 'ARRAY') {
15153: my $maxdepth = scalar(@{$cats});
15154: if (ref($cats->[$depth]) eq 'HASH') {
15155: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
15156: my $numchildren = @{$cats->[$depth]{$parent}};
15157: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 15158: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 15159: for (my $j=0; $j<$numchildren; $j++) {
15160: $name = $cats->[$depth]{$parent}[$j];
15161: $item = &escape($name).':'.&escape($parent).':'.$depth;
15162: my $deeper = $depth+1;
15163: my $checked = '';
15164: if (ref($currcategories) eq 'ARRAY') {
15165: if (@{$currcategories} > 0) {
15166: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 15167: $checked = ' checked="checked"';
1.663 raeburn 15168: }
15169: }
15170: }
1.664 raeburn 15171: $text .= '<tr><td><span class="LC_nobreak"><label>'.
15172: '<input type="checkbox" name="usecategory" value="'.
1.1075.2.117 raeburn 15173: $item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
1.675 raeburn 15174: '<input type="hidden" name="catname" value="'.$name.'" />'.
15175: '</td><td>';
1.663 raeburn 15176: if (ref($path) eq 'ARRAY') {
15177: push(@{$path},$name);
1.1075.2.117 raeburn 15178: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
1.663 raeburn 15179: pop(@{$path});
15180: }
15181: $text .= '</td></tr>';
15182: }
15183: $text .= '</table></td>';
15184: }
15185: }
15186: }
15187: return $text;
15188: }
15189:
1.1075.2.69 raeburn 15190: =pod
15191:
15192: =back
15193:
15194: =cut
15195:
1.655 raeburn 15196: ############################################################
15197: ############################################################
15198:
15199:
1.443 albertel 15200: sub commit_customrole {
1.664 raeburn 15201: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 15202: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 15203: ($start?', '.&mt('starting').' '.localtime($start):'').
15204: ($end?', ending '.localtime($end):'').': <b>'.
15205: &Apache::lonnet::assigncustomrole(
1.664 raeburn 15206: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 15207: '</b><br />';
15208: return $output;
15209: }
15210:
15211: sub commit_standardrole {
1.1075.2.31 raeburn 15212: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 15213: my ($output,$logmsg,$linefeed);
15214: if ($context eq 'auto') {
15215: $linefeed = "\n";
15216: } else {
15217: $linefeed = "<br />\n";
15218: }
1.443 albertel 15219: if ($three eq 'st') {
1.541 raeburn 15220: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 15221: $one,$two,$sec,$context,$credits);
1.541 raeburn 15222: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 15223: ($result eq 'unknown_course') || ($result eq 'refused')) {
15224: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 15225: } else {
1.541 raeburn 15226: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 15227: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15228: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
15229: if ($context eq 'auto') {
15230: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
15231: } else {
15232: $output .= '<b>'.$result.'</b>'.$linefeed.
15233: &mt('Add to classlist').': <b>ok</b>';
15234: }
15235: $output .= $linefeed;
1.443 albertel 15236: }
15237: } else {
15238: $output = &mt('Assigning').' '.$three.' in '.$url.
15239: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 15240: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 15241: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 15242: if ($context eq 'auto') {
15243: $output .= $result.$linefeed;
15244: } else {
15245: $output .= '<b>'.$result.'</b>'.$linefeed;
15246: }
1.443 albertel 15247: }
15248: return $output;
15249: }
15250:
15251: sub commit_studentrole {
1.1075.2.31 raeburn 15252: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
15253: $credits) = @_;
1.626 raeburn 15254: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 15255: if ($context eq 'auto') {
15256: $linefeed = "\n";
15257: } else {
15258: $linefeed = '<br />'."\n";
15259: }
1.443 albertel 15260: if (defined($one) && defined($two)) {
15261: my $cid=$one.'_'.$two;
15262: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
15263: my $secchange = 0;
15264: my $expire_role_result;
15265: my $modify_section_result;
1.628 raeburn 15266: if ($oldsec ne '-1') {
15267: if ($oldsec ne $sec) {
1.443 albertel 15268: $secchange = 1;
1.628 raeburn 15269: my $now = time;
1.443 albertel 15270: my $uurl='/'.$cid;
15271: $uurl=~s/\_/\//g;
15272: if ($oldsec) {
15273: $uurl.='/'.$oldsec;
15274: }
1.626 raeburn 15275: $oldsecurl = $uurl;
1.628 raeburn 15276: $expire_role_result =
1.1075.2.167 raeburn 15277: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,
15278: '','','',$context);
1.628 raeburn 15279: if ($env{'request.course.sec'} ne '') {
15280: if ($expire_role_result eq 'refused') {
15281: my @roles = ('st');
15282: my @statuses = ('previous');
15283: my @roledoms = ($one);
15284: my $withsec = 1;
15285: my %roleshash =
15286: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
15287: \@statuses,\@roles,\@roledoms,$withsec);
15288: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
15289: my ($oldstart,$oldend) =
15290: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
15291: if ($oldend > 0 && $oldend <= $now) {
15292: $expire_role_result = 'ok';
15293: }
15294: }
15295: }
15296: }
1.443 albertel 15297: $result = $expire_role_result;
15298: }
15299: }
15300: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 15301: $modify_section_result =
15302: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
15303: undef,undef,undef,$sec,
15304: $end,$start,'','',$cid,
15305: '',$context,$credits);
1.443 albertel 15306: if ($modify_section_result =~ /^ok/) {
15307: if ($secchange == 1) {
1.628 raeburn 15308: if ($sec eq '') {
15309: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
15310: } else {
15311: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
15312: }
1.443 albertel 15313: } elsif ($oldsec eq '-1') {
1.628 raeburn 15314: if ($sec eq '') {
15315: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
15316: } else {
15317: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15318: }
1.443 albertel 15319: } else {
1.628 raeburn 15320: if ($sec eq '') {
15321: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
15322: } else {
15323: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
15324: }
1.443 albertel 15325: }
15326: } else {
1.628 raeburn 15327: if ($secchange) {
15328: $$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;
15329: } else {
15330: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
15331: }
1.443 albertel 15332: }
15333: $result = $modify_section_result;
15334: } elsif ($secchange == 1) {
1.628 raeburn 15335: if ($oldsec eq '') {
1.1075.2.20 raeburn 15336: $$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 15337: } else {
15338: $$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;
15339: }
1.626 raeburn 15340: if ($expire_role_result eq 'refused') {
15341: my $newsecurl = '/'.$cid;
15342: $newsecurl =~ s/\_/\//g;
15343: if ($sec ne '') {
15344: $newsecurl.='/'.$sec;
15345: }
15346: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
15347: if ($sec eq '') {
15348: $$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;
15349: } else {
15350: $$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;
15351: }
15352: }
15353: }
1.443 albertel 15354: }
15355: } else {
1.626 raeburn 15356: $$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 15357: $result = "error: incomplete course id\n";
15358: }
15359: return $result;
15360: }
15361:
1.1075.2.25 raeburn 15362: sub show_role_extent {
15363: my ($scope,$context,$role) = @_;
15364: $scope =~ s{^/}{};
15365: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
15366: push(@courseroles,'co');
15367: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
15368: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
15369: $scope =~ s{/}{_};
15370: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
15371: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
15372: my ($audom,$auname) = split(/\//,$scope);
15373: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
15374: &Apache::loncommon::plainname($auname,$audom).'</span>');
15375: } else {
15376: $scope =~ s{/$}{};
15377: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
15378: &Apache::lonnet::domain($scope,'description').'</span>');
15379: }
15380: }
15381:
1.443 albertel 15382: ############################################################
15383: ############################################################
15384:
1.566 albertel 15385: sub check_clone {
1.578 raeburn 15386: my ($args,$linefeed) = @_;
1.566 albertel 15387: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
15388: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
15389: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
15390: my $clonemsg;
15391: my $can_clone = 0;
1.944 raeburn 15392: my $lctype = lc($args->{'crstype'});
1.908 raeburn 15393: if ($lctype ne 'community') {
15394: $lctype = 'course';
15395: }
1.566 albertel 15396: if ($clonehome eq 'no_host') {
1.944 raeburn 15397: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15398: $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
15399: } else {
15400: $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
15401: }
1.566 albertel 15402: } else {
15403: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 15404: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 15405: if ($clonedesc{'type'} ne 'Community') {
15406: $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
15407: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15408: }
15409: }
1.1075.2.119 raeburn 15410: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
1.882 raeburn 15411: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 15412: $can_clone = 1;
15413: } else {
1.1075.2.95 raeburn 15414: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 15415: $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95 raeburn 15416: if ($clonehash{'cloners'} eq '') {
15417: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
15418: if ($domdefs{'canclone'}) {
15419: unless ($domdefs{'canclone'} eq 'none') {
15420: if ($domdefs{'canclone'} eq 'domain') {
15421: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
15422: $can_clone = 1;
15423: }
15424: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15425: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
15426: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
15427: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
15428: $can_clone = 1;
15429: }
15430: }
15431: }
1.908 raeburn 15432: }
1.1075.2.95 raeburn 15433: } else {
15434: my @cloners = split(/,/,$clonehash{'cloners'});
15435: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 15436: $can_clone = 1;
1.1075.2.95 raeburn 15437: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 15438: $can_clone = 1;
1.1075.2.96 raeburn 15439: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
15440: $can_clone = 1;
1.1075.2.95 raeburn 15441: }
15442: unless ($can_clone) {
1.1075.2.96 raeburn 15443: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
15444: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1075.2.95 raeburn 15445: my (%gotdomdefaults,%gotcodedefaults);
15446: foreach my $cloner (@cloners) {
15447: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
15448: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
15449: my (%codedefaults,@code_order);
15450: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
15451: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
15452: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
15453: }
15454: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
15455: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
15456: }
15457: } else {
15458: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
15459: \%codedefaults,
15460: \@code_order);
15461: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
15462: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
15463: }
15464: if (@code_order > 0) {
15465: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
15466: $cloner,$clonehash{'internal.coursecode'},
15467: $args->{'crscode'})) {
15468: $can_clone = 1;
15469: last;
15470: }
15471: }
15472: }
15473: }
15474: }
1.1075.2.96 raeburn 15475: }
15476: }
15477: unless ($can_clone) {
15478: my $ccrole = 'cc';
15479: if ($args->{'crstype'} eq 'Community') {
15480: $ccrole = 'co';
15481: }
15482: my %roleshash =
15483: &Apache::lonnet::get_my_roles($args->{'ccuname'},
15484: $args->{'ccdomain'},
15485: 'userroles',['active'],[$ccrole],
15486: [$args->{'clonedomain'}]);
15487: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
15488: $can_clone = 1;
15489: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
15490: $args->{'ccuname'},$args->{'ccdomain'})) {
15491: $can_clone = 1;
1.1075.2.95 raeburn 15492: }
15493: }
15494: unless ($can_clone) {
15495: if ($args->{'crstype'} eq 'Community') {
15496: $clonemsg = &mt('No new community created.').$linefeed.&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]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
15497: } else {
15498: $clonemsg = &mt('No new course created.').$linefeed.&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]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
1.578 raeburn 15499: }
1.566 albertel 15500: }
1.578 raeburn 15501: }
1.566 albertel 15502: }
15503: return ($can_clone, $clonemsg, $cloneid, $clonehome);
15504: }
15505:
1.444 albertel 15506: sub construct_course {
1.1075.2.119 raeburn 15507: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
15508: $cnum,$category,$coderef) = @_;
1.444 albertel 15509: my $outcome;
1.541 raeburn 15510: my $linefeed = '<br />'."\n";
15511: if ($context eq 'auto') {
15512: $linefeed = "\n";
15513: }
1.566 albertel 15514:
15515: #
15516: # Are we cloning?
15517: #
15518: my ($can_clone, $clonemsg, $cloneid, $clonehome);
15519: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 15520: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 15521: if ($context ne 'auto') {
1.578 raeburn 15522: if ($clonemsg ne '') {
15523: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
15524: }
1.566 albertel 15525: }
15526: $outcome .= $clonemsg.$linefeed;
15527:
15528: if (!$can_clone) {
15529: return (0,$outcome);
15530: }
15531: }
15532:
1.444 albertel 15533: #
15534: # Open course
15535: #
15536: my $crstype = lc($args->{'crstype'});
15537: my %cenv=();
15538: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
15539: $args->{'cdescr'},
15540: $args->{'curl'},
15541: $args->{'course_home'},
15542: $args->{'nonstandard'},
15543: $args->{'crscode'},
15544: $args->{'ccuname'}.':'.
15545: $args->{'ccdomain'},
1.882 raeburn 15546: $args->{'crstype'},
1.885 raeburn 15547: $cnum,$context,$category);
1.444 albertel 15548:
15549: # Note: The testing routines depend on this being output; see
15550: # Utils::Course. This needs to at least be output as a comment
15551: # if anyone ever decides to not show this, and Utils::Course::new
15552: # will need to be suitably modified.
1.541 raeburn 15553: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 15554: if ($$courseid =~ /^error:/) {
15555: return (0,$outcome);
15556: }
15557:
1.444 albertel 15558: #
15559: # Check if created correctly
15560: #
1.479 albertel 15561: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 15562: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 15563: if ($crsuhome eq 'no_host') {
15564: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
15565: return (0,$outcome);
15566: }
1.541 raeburn 15567: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 15568:
1.444 albertel 15569: #
1.566 albertel 15570: # Do the cloning
15571: #
15572: if ($can_clone && $cloneid) {
15573: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
15574: if ($context ne 'auto') {
15575: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
15576: }
15577: $outcome .= $clonemsg.$linefeed;
15578: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 15579: # Copy all files
1.637 www 15580: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 15581: # Restore URL
1.566 albertel 15582: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 15583: # Restore title
1.566 albertel 15584: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 15585: # Restore creation date, creator and creation context.
15586: $cenv{'internal.created'}=$oldcenv{'internal.created'};
15587: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
15588: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 15589: # Mark as cloned
1.566 albertel 15590: $cenv{'clonedfrom'}=$cloneid;
1.638 www 15591: # Need to clone grading mode
15592: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
15593: $cenv{'grading'}=$newenv{'grading'};
15594: # Do not clone these environment entries
15595: &Apache::lonnet::del('environment',
15596: ['default_enrollment_start_date',
15597: 'default_enrollment_end_date',
15598: 'question.email',
15599: 'policy.email',
15600: 'comment.email',
15601: 'pch.users.denied',
1.725 raeburn 15602: 'plc.users.denied',
15603: 'hidefromcat',
1.1075.2.36 raeburn 15604: 'checkforpriv',
1.1075.2.158 raeburn 15605: 'categories'],
1.638 www 15606: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 15607: if ($args->{'textbook'}) {
15608: $cenv{'internal.textbook'} = $args->{'textbook'};
15609: }
1.444 albertel 15610: }
1.566 albertel 15611:
1.444 albertel 15612: #
15613: # Set environment (will override cloned, if existing)
15614: #
15615: my @sections = ();
15616: my @xlists = ();
15617: if ($args->{'crstype'}) {
15618: $cenv{'type'}=$args->{'crstype'};
15619: }
15620: if ($args->{'crsid'}) {
15621: $cenv{'courseid'}=$args->{'crsid'};
15622: }
15623: if ($args->{'crscode'}) {
15624: $cenv{'internal.coursecode'}=$args->{'crscode'};
15625: }
15626: if ($args->{'crsquota'} ne '') {
15627: $cenv{'internal.coursequota'}=$args->{'crsquota'};
15628: } else {
15629: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
15630: }
15631: if ($args->{'ccuname'}) {
15632: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
15633: ':'.$args->{'ccdomain'};
15634: } else {
15635: $cenv{'internal.courseowner'} = $args->{'curruser'};
15636: }
1.1075.2.31 raeburn 15637: if ($args->{'defaultcredits'}) {
15638: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
15639: }
1.444 albertel 15640: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
1.1075.2.166 raeburn 15641: my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
1.444 albertel 15642: if ($args->{'crssections'}) {
15643: $cenv{'internal.sectionnums'} = '';
15644: if ($args->{'crssections'} =~ m/,/) {
15645: @sections = split/,/,$args->{'crssections'};
15646: } else {
15647: $sections[0] = $args->{'crssections'};
15648: }
15649: if (@sections > 0) {
15650: foreach my $item (@sections) {
15651: my ($sec,$gp) = split/:/,$item;
15652: my $class = $args->{'crscode'}.$sec;
15653: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
15654: $cenv{'internal.sectionnums'} .= $item.',';
1.1075.2.166 raeburn 15655: if ($addcheck eq 'ok') {
15656: unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
15657: push(@oklcsecs,$gp);
15658: }
15659: } else {
1.1075.2.119 raeburn 15660: push(@badclasses,$class);
1.444 albertel 15661: }
15662: }
15663: $cenv{'internal.sectionnums'} =~ s/,$//;
15664: }
15665: }
15666: # do not hide course coordinator from staff listing,
15667: # even if privileged
15668: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 15669: # add course coordinator's domain to domains to check for privileged users
15670: # if different to course domain
15671: if ($$crsudom ne $args->{'ccdomain'}) {
15672: $cenv{'checkforpriv'} = $args->{'ccdomain'};
15673: }
1.444 albertel 15674: # add crosslistings
15675: if ($args->{'crsxlist'}) {
15676: $cenv{'internal.crosslistings'}='';
15677: if ($args->{'crsxlist'} =~ m/,/) {
15678: @xlists = split/,/,$args->{'crsxlist'};
15679: } else {
15680: $xlists[0] = $args->{'crsxlist'};
15681: }
15682: if (@xlists > 0) {
15683: foreach my $item (@xlists) {
15684: my ($xl,$gp) = split/:/,$item;
15685: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
15686: $cenv{'internal.crosslistings'} .= $item.',';
1.1075.2.166 raeburn 15687: if ($addcheck eq 'ok') {
15688: unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
15689: push(@oklcsecs,$gp);
15690: }
15691: } else {
1.1075.2.119 raeburn 15692: push(@badclasses,$xl);
1.444 albertel 15693: }
15694: }
15695: $cenv{'internal.crosslistings'} =~ s/,$//;
15696: }
15697: }
15698: if ($args->{'autoadds'}) {
15699: $cenv{'internal.autoadds'}=$args->{'autoadds'};
15700: }
15701: if ($args->{'autodrops'}) {
15702: $cenv{'internal.autodrops'}=$args->{'autodrops'};
15703: }
15704: # check for notification of enrollment changes
15705: my @notified = ();
15706: if ($args->{'notify_owner'}) {
15707: if ($args->{'ccuname'} ne '') {
15708: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
15709: }
15710: }
15711: if ($args->{'notify_dc'}) {
15712: if ($uname ne '') {
1.630 raeburn 15713: push(@notified,$uname.':'.$udom);
1.444 albertel 15714: }
15715: }
15716: if (@notified > 0) {
15717: my $notifylist;
15718: if (@notified > 1) {
15719: $notifylist = join(',',@notified);
15720: } else {
15721: $notifylist = $notified[0];
15722: }
15723: $cenv{'internal.notifylist'} = $notifylist;
15724: }
15725: if (@badclasses > 0) {
15726: my %lt=&Apache::lonlocal::texthash(
1.1075.2.119 raeburn 15727: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
15728: 'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
15729: 'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
1.444 albertel 15730: );
1.1075.2.119 raeburn 15731: my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
15732: &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 15733: if ($context eq 'auto') {
15734: $outcome .= $badclass_msg.$linefeed;
1.1075.2.119 raeburn 15735: } else {
1.566 albertel 15736: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.1075.2.119 raeburn 15737: }
15738: foreach my $item (@badclasses) {
1.541 raeburn 15739: if ($context eq 'auto') {
1.1075.2.119 raeburn 15740: $outcome .= " - $item\n";
1.541 raeburn 15741: } else {
1.1075.2.119 raeburn 15742: $outcome .= "<li>$item</li>\n";
1.541 raeburn 15743: }
1.1075.2.119 raeburn 15744: }
15745: if ($context eq 'auto') {
15746: $outcome .= $linefeed;
15747: } else {
15748: $outcome .= "</ul><br /><br /></div>\n";
15749: }
1.444 albertel 15750: }
15751: if ($args->{'no_end_date'}) {
15752: $args->{'endaccess'} = 0;
15753: }
1.1075.2.166 raeburn 15754: # If an official course with institutional sections is created by cloning
15755: # an existing course, section-specific hiding of course totals in student's
15756: # view of grades as copied from cloned course, will be checked for valid
15757: # sections.
15758: if (($can_clone && $cloneid) &&
15759: ($cenv{'internal.coursecode'} ne '') &&
15760: ($cenv{'grading'} eq 'standard') &&
15761: ($cenv{'hidetotals'} ne '') &&
15762: ($cenv{'hidetotals'} ne 'all')) {
15763: my @hidesecs;
15764: my $deletehidetotals;
15765: if (@oklcsecs) {
15766: foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
15767: if (grep(/^\Q$sec$/,@oklcsecs)) {
15768: push(@hidesecs,$sec);
15769: }
15770: }
15771: if (@hidesecs) {
15772: $cenv{'hidetotals'} = join(',',@hidesecs);
15773: } else {
15774: $deletehidetotals = 1;
15775: }
15776: } else {
15777: $deletehidetotals = 1;
15778: }
15779: if ($deletehidetotals) {
15780: delete($cenv{'hidetotals'});
15781: &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
15782: }
15783: }
1.444 albertel 15784: $cenv{'internal.autostart'}=$args->{'enrollstart'};
15785: $cenv{'internal.autoend'}=$args->{'enrollend'};
15786: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
15787: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
15788: if ($args->{'showphotos'}) {
15789: $cenv{'internal.showphotos'}=$args->{'showphotos'};
15790: }
15791: $cenv{'internal.authtype'} = $args->{'authtype'};
15792: $cenv{'internal.autharg'} = $args->{'autharg'};
15793: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
15794: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 15795: 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');
15796: if ($context eq 'auto') {
15797: $outcome .= $krb_msg;
15798: } else {
1.566 albertel 15799: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 15800: }
15801: $outcome .= $linefeed;
1.444 albertel 15802: }
15803: }
15804: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
15805: if ($args->{'setpolicy'}) {
15806: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15807: }
15808: if ($args->{'setcontent'}) {
15809: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15810: }
1.1075.2.110 raeburn 15811: if ($args->{'setcomment'}) {
15812: $cenv{'comment.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
15813: }
1.444 albertel 15814: }
15815: if ($args->{'reshome'}) {
15816: $cenv{'reshome'}=$args->{'reshome'}.'/';
15817: $cenv{'reshome'}=~s/\/+$/\//;
15818: }
15819: #
15820: # course has keyed access
15821: #
15822: if ($args->{'setkeys'}) {
15823: $cenv{'keyaccess'}='yes';
15824: }
15825: # if specified, key authority is not course, but user
15826: # only active if keyaccess is yes
15827: if ($args->{'keyauth'}) {
1.487 albertel 15828: my ($user,$domain) = split(':',$args->{'keyauth'});
15829: $user = &LONCAPA::clean_username($user);
15830: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 15831: if ($user ne '' && $domain ne '') {
1.487 albertel 15832: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 15833: }
15834: }
15835:
1.1075.2.59 raeburn 15836: #
15837: # generate and store uniquecode (available to course requester), if course should have one.
15838: #
15839: if ($args->{'uniquecode'}) {
15840: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
15841: if ($code) {
15842: $cenv{'internal.uniquecode'} = $code;
15843: my %crsinfo =
15844: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
15845: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
15846: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
15847: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
15848: }
15849: if (ref($coderef)) {
15850: $$coderef = $code;
15851: }
15852: }
15853: }
15854:
1.444 albertel 15855: if ($args->{'disresdis'}) {
15856: $cenv{'pch.roles.denied'}='st';
15857: }
15858: if ($args->{'disablechat'}) {
15859: $cenv{'plc.roles.denied'}='st';
15860: }
15861:
15862: # Record we've not yet viewed the Course Initialization Helper for this
15863: # course
15864: $cenv{'course.helper.not.run'} = 1;
15865: #
15866: # Use new Randomseed
15867: #
15868: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
15869: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
15870: #
15871: # The encryption code and receipt prefix for this course
15872: #
15873: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
15874: $cenv{'internal.encpref'}=100+int(9*rand(99));
15875: #
15876: # By default, use standard grading
15877: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
15878:
1.541 raeburn 15879: $outcome .= $linefeed.&mt('Setting environment').': '.
15880: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15881: #
15882: # Open all assignments
15883: #
15884: if ($args->{'openall'}) {
1.1075.2.146 raeburn 15885: my $opendate = time;
15886: if ($args->{'openallfrom'} =~ /^\d+$/) {
15887: $opendate = $args->{'openallfrom'};
15888: }
1.444 albertel 15889: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
1.1075.2.146 raeburn 15890: my %storecontent = ($storeunder => $opendate,
1.444 albertel 15891: $storeunder.'.type' => 'date_start');
1.1075.2.146 raeburn 15892: $outcome .= &mt('All assignments open starting [_1]',
15893: &Apache::lonlocal::locallocaltime($opendate)).': '.
15894: &Apache::lonnet::cput
15895: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 15896: }
15897: #
15898: # Set first page
15899: #
15900: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
15901: || ($cloneid)) {
1.445 albertel 15902: use LONCAPA::map;
1.444 albertel 15903: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 15904:
15905: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
15906: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
15907:
1.444 albertel 15908: $outcome .= ($fatal?$errtext:'read ok').' - ';
15909: my $title; my $url;
15910: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 15911: $title=&mt('Syllabus');
1.444 albertel 15912: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
15913: } else {
1.963 raeburn 15914: $title=&mt('Table of Contents');
1.444 albertel 15915: $url='/adm/navmaps';
15916: }
1.445 albertel 15917:
15918: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
15919: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
15920:
15921: if ($errtext) { $fatal=2; }
1.541 raeburn 15922: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 15923: }
1.566 albertel 15924:
15925: return (1,$outcome);
1.444 albertel 15926: }
15927:
1.1075.2.59 raeburn 15928: sub make_unique_code {
15929: my ($cdom,$cnum) = @_;
15930: # get lock on uniquecodes db
15931: my $lockhash = {
15932: $cnum."\0".'uniquecodes' => $env{'user.name'}.
15933: ':'.$env{'user.domain'},
15934: };
15935: my $tries = 0;
15936: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15937: my ($code,$error);
15938:
15939: while (($gotlock ne 'ok') && ($tries<3)) {
15940: $tries ++;
15941: sleep 1;
15942: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
15943: }
15944: if ($gotlock eq 'ok') {
15945: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
15946: my $gotcode;
15947: my $attempts = 0;
15948: while ((!$gotcode) && ($attempts < 100)) {
15949: $code = &generate_code();
15950: if (!exists($currcodes{$code})) {
15951: $gotcode = 1;
15952: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
15953: $error = 'nostore';
15954: }
15955: }
15956: $attempts ++;
15957: }
15958: my @del_lock = ($cnum."\0".'uniquecodes');
15959: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
15960: } else {
15961: $error = 'nolock';
15962: }
15963: return ($code,$error);
15964: }
15965:
15966: sub generate_code {
15967: my $code;
15968: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
15969: for (my $i=0; $i<6; $i++) {
15970: my $lettnum = int (rand 2);
15971: my $item = '';
15972: if ($lettnum) {
15973: $item = $letts[int( rand(18) )];
15974: } else {
15975: $item = 1+int( rand(8) );
15976: }
15977: $code .= $item;
15978: }
15979: return $code;
15980: }
15981:
1.444 albertel 15982: ############################################################
15983: ############################################################
15984:
1.953 droeschl 15985: #SD
15986: # only Community and Course, or anything else?
1.378 raeburn 15987: sub course_type {
15988: my ($cid) = @_;
15989: if (!defined($cid)) {
15990: $cid = $env{'request.course.id'};
15991: }
1.404 albertel 15992: if (defined($env{'course.'.$cid.'.type'})) {
15993: return $env{'course.'.$cid.'.type'};
1.378 raeburn 15994: } else {
15995: return 'Course';
1.377 raeburn 15996: }
15997: }
1.156 albertel 15998:
1.406 raeburn 15999: sub group_term {
16000: my $crstype = &course_type();
16001: my %names = (
16002: 'Course' => 'group',
1.865 raeburn 16003: 'Community' => 'group',
1.406 raeburn 16004: );
16005: return $names{$crstype};
16006: }
16007:
1.902 raeburn 16008: sub course_types {
1.1075.2.59 raeburn 16009: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 16010: my %typename = (
16011: official => 'Official course',
16012: unofficial => 'Unofficial course',
16013: community => 'Community',
1.1075.2.59 raeburn 16014: textbook => 'Textbook course',
1.902 raeburn 16015: );
16016: return (\@types,\%typename);
16017: }
16018:
1.156 albertel 16019: sub icon {
16020: my ($file)=@_;
1.505 albertel 16021: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 16022: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 16023: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 16024: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
16025: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
16026: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16027: $curfext.".gif") {
16028: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
16029: $curfext.".gif";
16030: }
16031: }
1.249 albertel 16032: return &lonhttpdurl($iconname);
1.154 albertel 16033: }
1.84 albertel 16034:
1.575 albertel 16035: sub lonhttpdurl {
1.692 www 16036: #
16037: # Had been used for "small fry" static images on separate port 8080.
16038: # Modify here if lightweight http functionality desired again.
16039: # Currently eliminated due to increasing firewall issues.
16040: #
1.575 albertel 16041: my ($url)=@_;
1.692 www 16042: return $url;
1.215 albertel 16043: }
16044:
1.213 albertel 16045: sub connection_aborted {
16046: my ($r)=@_;
16047: $r->print(" ");$r->rflush();
16048: my $c = $r->connection;
16049: return $c->aborted();
16050: }
16051:
1.221 foxr 16052: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 16053: # strings as 'strings'.
16054: sub escape_single {
1.221 foxr 16055: my ($input) = @_;
1.223 albertel 16056: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 16057: $input =~ s/\'/\\\'/g; # Esacpe the 's....
16058: return $input;
16059: }
1.223 albertel 16060:
1.222 foxr 16061: # Same as escape_single, but escape's "'s This
16062: # can be used for "strings"
16063: sub escape_double {
16064: my ($input) = @_;
16065: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
16066: $input =~ s/\"/\\\"/g; # Esacpe the "s....
16067: return $input;
16068: }
1.223 albertel 16069:
1.222 foxr 16070: # Escapes the last element of a full URL.
16071: sub escape_url {
16072: my ($url) = @_;
1.238 raeburn 16073: my @urlslices = split(/\//, $url,-1);
1.369 www 16074: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 16075: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 16076: }
1.462 albertel 16077:
1.820 raeburn 16078: sub compare_arrays {
16079: my ($arrayref1,$arrayref2) = @_;
16080: my (@difference,%count);
16081: @difference = ();
16082: %count = ();
16083: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
16084: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
16085: foreach my $element (keys(%count)) {
16086: if ($count{$element} == 1) {
16087: push(@difference,$element);
16088: }
16089: }
16090: }
16091: return @difference;
16092: }
16093:
1.1075.2.152 raeburn 16094: sub lon_status_items {
16095: my %defaults = (
16096: E => 100,
16097: W => 4,
16098: N => 1,
16099: U => 5,
16100: threshold => 200,
16101: sysmail => 2500,
16102: );
16103: my %names = (
16104: E => 'Errors',
16105: W => 'Warnings',
16106: N => 'Notices',
16107: U => 'Unsent',
16108: );
16109: return (\%defaults,\%names);
16110: }
16111:
1.817 bisitz 16112: # -------------------------------------------------------- Initialize user login
1.462 albertel 16113: sub init_user_environment {
1.463 albertel 16114: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 16115: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
16116:
16117: my $public=($username eq 'public' && $domain eq 'public');
16118:
16119: # See if old ID present, if so, remove
16120:
1.1062 raeburn 16121: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 16122: my $now=time;
16123:
16124: if ($public) {
16125: my $max_public=100;
16126: my $oldest;
16127: my $oldest_time=0;
16128: for(my $next=1;$next<=$max_public;$next++) {
16129: if (-e $lonids."/publicuser_$next.id") {
16130: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
16131: if ($mtime<$oldest_time || !$oldest_time) {
16132: $oldest_time=$mtime;
16133: $oldest=$next;
16134: }
16135: } else {
16136: $cookie="publicuser_$next";
16137: last;
16138: }
16139: }
16140: if (!$cookie) { $cookie="publicuser_$oldest"; }
16141: } else {
1.463 albertel 16142: # if this isn't a robot, kill any existing non-robot sessions
16143: if (!$args->{'robot'}) {
16144: opendir(DIR,$lonids);
16145: while ($filename=readdir(DIR)) {
16146: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
1.1075.2.136 raeburn 16147: if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
16148: &GDBM_READER(),0640)) {
16149: my $linkedfile;
16150: if (exists($oldenv{'user.linkedenv'})) {
16151: $linkedfile = $oldenv{'user.linkedenv'};
16152: }
16153: untie(%oldenv);
16154: if (unlink("$lonids/$filename")) {
16155: if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
16156: if (-l "$lonids/$linkedfile.id") {
16157: unlink("$lonids/$linkedfile.id");
16158: }
16159: }
16160: }
16161: } else {
16162: unlink($lonids.'/'.$filename);
16163: }
1.463 albertel 16164: }
1.462 albertel 16165: }
1.463 albertel 16166: closedir(DIR);
1.1075.2.84 raeburn 16167: # If there is a undeleted lockfile for the user's paste buffer remove it.
16168: my $namespace = 'nohist_courseeditor';
16169: my $lockingkey = 'paste'."\0".'locked_num';
16170: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
16171: $domain,$username);
16172: if (exists($lockhash{$lockingkey})) {
16173: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
16174: unless ($delresult eq 'ok') {
16175: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
16176: }
16177: }
1.462 albertel 16178: }
16179: # Give them a new cookie
1.463 albertel 16180: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 16181: : $now.$$.int(rand(10000)));
1.463 albertel 16182: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 16183:
16184: # Initialize roles
16185:
1.1062 raeburn 16186: ($userroles,$firstaccenv,$timerintenv) =
16187: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 16188: }
16189: # ------------------------------------ Check browser type and MathML capability
16190:
1.1075.2.77 raeburn 16191: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
16192: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 16193:
16194: # ------------------------------------------------------------- Get environment
16195:
16196: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
16197: my ($tmp) = keys(%userenv);
16198: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
16199: } else {
16200: undef(%userenv);
16201: }
16202: if (($userenv{'interface'}) && (!$form->{'interface'})) {
16203: $form->{'interface'}=$userenv{'interface'};
16204: }
16205: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
16206:
16207: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 16208: foreach my $option ('interface','localpath','localres') {
16209: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 16210: }
16211: # --------------------------------------------------------- Write first profile
16212:
16213: {
1.1075.2.150 raeburn 16214: my $ip = &Apache::lonnet::get_requestor_ip();
1.462 albertel 16215: my %initial_env =
16216: ("user.name" => $username,
16217: "user.domain" => $domain,
16218: "user.home" => $authhost,
16219: "browser.type" => $clientbrowser,
16220: "browser.version" => $clientversion,
16221: "browser.mathml" => $clientmathml,
16222: "browser.unicode" => $clientunicode,
16223: "browser.os" => $clientos,
1.1075.2.42 raeburn 16224: "browser.mobile" => $clientmobile,
16225: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 16226: "browser.osversion" => $clientosversion,
1.462 albertel 16227: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
16228: "request.course.fn" => '',
16229: "request.course.uri" => '',
16230: "request.course.sec" => '',
16231: "request.role" => 'cm',
16232: "request.role.adv" => $env{'user.adv'},
1.1075.2.150 raeburn 16233: "request.host" => $ip,);
1.462 albertel 16234:
16235: if ($form->{'localpath'}) {
16236: $initial_env{"browser.localpath"} = $form->{'localpath'};
16237: $initial_env{"browser.localres"} = $form->{'localres'};
16238: }
16239:
16240: if ($form->{'interface'}) {
16241: $form->{'interface'}=~s/\W//gs;
16242: $initial_env{"browser.interface"} = $form->{'interface'};
16243: $env{'browser.interface'}=$form->{'interface'};
16244: }
16245:
1.1075.2.54 raeburn 16246: if ($form->{'iptoken'}) {
16247: my $lonhost = $r->dir_config('lonHostID');
16248: $initial_env{"user.noloadbalance"} = $lonhost;
16249: $env{'user.noloadbalance'} = $lonhost;
16250: }
16251:
1.1075.2.120 raeburn 16252: if ($form->{'noloadbalance'}) {
16253: my @hosts = &Apache::lonnet::current_machine_ids();
16254: my $hosthere = $form->{'noloadbalance'};
16255: if (grep(/^\Q$hosthere\E$/,@hosts)) {
16256: $initial_env{"user.noloadbalance"} = $hosthere;
16257: $env{'user.noloadbalance'} = $hosthere;
16258: }
16259: }
16260:
1.1016 raeburn 16261: unless ($domain eq 'public') {
1.1075.2.125 raeburn 16262: my %is_adv = ( is_adv => $env{'user.adv'} );
16263: my %domdef = &Apache::lonnet::get_domain_defaults($domain);
1.980 raeburn 16264:
1.1075.2.125 raeburn 16265: foreach my $tool ('aboutme','blog','webdav','portfolio') {
16266: $userenv{'availabletools.'.$tool} =
16267: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
16268: undef,\%userenv,\%domdef,\%is_adv);
16269: }
1.724 raeburn 16270:
1.1075.2.125 raeburn 16271: foreach my $crstype ('official','unofficial','community','textbook') {
16272: $userenv{'canrequest.'.$crstype} =
16273: &Apache::lonnet::usertools_access($username,$domain,$crstype,
16274: 'reload','requestcourses',
16275: \%userenv,\%domdef,\%is_adv);
16276: }
1.765 raeburn 16277:
1.1075.2.125 raeburn 16278: $userenv{'canrequest.author'} =
16279: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
16280: 'reload','requestauthor',
16281: \%userenv,\%domdef,\%is_adv);
16282: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
16283: $domain,$username);
16284: my $reqstatus = $reqauthor{'author_status'};
16285: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
16286: if (ref($reqauthor{'author'}) eq 'HASH') {
16287: $userenv{'requestauthorqueued'} = $reqstatus.':'.
16288: $reqauthor{'author'}{'timestamp'};
16289: }
1.1075.2.14 raeburn 16290: }
16291: }
16292:
1.462 albertel 16293: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 16294:
1.462 albertel 16295: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
16296: &GDBM_WRCREAT(),0640)) {
16297: &_add_to_env(\%disk_env,\%initial_env);
16298: &_add_to_env(\%disk_env,\%userenv,'environment.');
16299: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 16300: if (ref($firstaccenv) eq 'HASH') {
16301: &_add_to_env(\%disk_env,$firstaccenv);
16302: }
16303: if (ref($timerintenv) eq 'HASH') {
16304: &_add_to_env(\%disk_env,$timerintenv);
16305: }
1.463 albertel 16306: if (ref($args->{'extra_env'})) {
16307: &_add_to_env(\%disk_env,$args->{'extra_env'});
16308: }
1.462 albertel 16309: untie(%disk_env);
16310: } else {
1.705 tempelho 16311: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
16312: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 16313: return 'error: '.$!;
16314: }
16315: }
16316: $env{'request.role'}='cm';
16317: $env{'request.role.adv'}=$env{'user.adv'};
16318: $env{'browser.type'}=$clientbrowser;
16319:
16320: return $cookie;
16321:
16322: }
16323:
16324: sub _add_to_env {
16325: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 16326: if (ref($env_data) eq 'HASH') {
16327: while (my ($key,$value) = each(%$env_data)) {
16328: $idf->{$prefix.$key} = $value;
16329: $env{$prefix.$key} = $value;
16330: }
1.462 albertel 16331: }
16332: }
16333:
1.685 tempelho 16334: # --- Get the symbolic name of a problem and the url
16335: sub get_symb {
16336: my ($request,$silent) = @_;
1.726 raeburn 16337: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 16338: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
16339: if ($symb eq '') {
16340: if (!$silent) {
1.1071 raeburn 16341: if (ref($request)) {
16342: $request->print("Unable to handle ambiguous references:$url:.");
16343: }
1.685 tempelho 16344: return ();
16345: }
16346: }
16347: &Apache::lonenc::check_decrypt(\$symb);
16348: return ($symb);
16349: }
16350:
16351: # --------------------------------------------------------------Get annotation
16352:
16353: sub get_annotation {
16354: my ($symb,$enc) = @_;
16355:
16356: my $key = $symb;
16357: if (!$enc) {
16358: $key =
16359: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
16360: }
16361: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
16362: return $annotation{$key};
16363: }
16364:
16365: sub clean_symb {
1.731 raeburn 16366: my ($symb,$delete_enc) = @_;
1.685 tempelho 16367:
16368: &Apache::lonenc::check_decrypt(\$symb);
16369: my $enc = $env{'request.enc'};
1.731 raeburn 16370: if ($delete_enc) {
1.730 raeburn 16371: delete($env{'request.enc'});
16372: }
1.685 tempelho 16373:
16374: return ($symb,$enc);
16375: }
1.462 albertel 16376:
1.1075.2.69 raeburn 16377: ############################################################
16378: ############################################################
16379:
16380: =pod
16381:
16382: =head1 Routines for building display used to search for courses
16383:
16384:
16385: =over 4
16386:
16387: =item * &build_filters()
16388:
16389: Create markup for a table used to set filters to use when selecting
16390: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
16391: and quotacheck.pl
16392:
16393:
16394: Inputs:
16395:
16396: filterlist - anonymous array of fields to include as potential filters
16397:
16398: crstype - course type
16399:
16400: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
16401: to pop-open a course selector (will contain "extra element").
16402:
16403: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
16404:
16405: filter - anonymous hash of criteria and their values
16406:
16407: action - form action
16408:
16409: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
16410:
16411: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
16412:
16413: cloneruname - username of owner of new course who wants to clone
16414:
16415: clonerudom - domain of owner of new course who wants to clone
16416:
16417: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
16418:
16419: codetitlesref - reference to array of titles of components in institutional codes (official courses)
16420:
16421: codedom - domain
16422:
16423: formname - value of form element named "form".
16424:
16425: fixeddom - domain, if fixed.
16426:
16427: prevphase - value to assign to form element named "phase" when going back to the previous screen
16428:
16429: cnameelement - name of form element in form on opener page which will receive title of selected course
16430:
16431: cnumelement - name of form element in form on opener page which will receive courseID of selected course
16432:
16433: cdomelement - name of form element in form on opener page which will receive domain of selected course
16434:
16435: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
16436:
16437: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
16438:
16439: clonewarning - warning message about missing information for intended course owner when DC creates a course
16440:
16441:
16442: Returns: $output - HTML for display of search criteria, and hidden form elements.
16443:
16444:
16445: Side Effects: None
16446:
16447: =cut
16448:
16449: # ---------------------------------------------- search for courses based on last activity etc.
16450:
16451: sub build_filters {
16452: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
16453: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
16454: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
16455: $cnameelement,$cnumelement,$cdomelement,$setroles,
16456: $clonetext,$clonewarning) = @_;
16457: my ($list,$jscript);
16458: my $onchange = 'javascript:updateFilters(this)';
16459: my ($domainselectform,$sincefilterform,$createdfilterform,
16460: $ownerdomselectform,$persondomselectform,$instcodeform,
16461: $typeselectform,$instcodetitle);
16462: if ($formname eq '') {
16463: $formname = $caller;
16464: }
16465: foreach my $item (@{$filterlist}) {
16466: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
16467: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
16468: if ($item eq 'domainfilter') {
16469: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
16470: } elsif ($item eq 'coursefilter') {
16471: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
16472: } elsif ($item eq 'ownerfilter') {
16473: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16474: } elsif ($item eq 'ownerdomfilter') {
16475: $filter->{'ownerdomfilter'} =
16476: &LONCAPA::clean_domain($filter->{$item});
16477: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
16478: 'ownerdomfilter',1);
16479: } elsif ($item eq 'personfilter') {
16480: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
16481: } elsif ($item eq 'persondomfilter') {
16482: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
16483: 'persondomfilter',1);
16484: } else {
16485: $filter->{$item} =~ s/\W//g;
16486: }
16487: if (!$filter->{$item}) {
16488: $filter->{$item} = '';
16489: }
16490: }
16491: if ($item eq 'domainfilter') {
16492: my $allow_blank = 1;
16493: if ($formname eq 'portform') {
16494: $allow_blank=0;
16495: } elsif ($formname eq 'studentform') {
16496: $allow_blank=0;
16497: }
16498: if ($fixeddom) {
16499: $domainselectform = '<input type="hidden" name="domainfilter"'.
16500: ' value="'.$codedom.'" />'.
16501: &Apache::lonnet::domain($codedom,'description');
16502: } else {
16503: $domainselectform = &select_dom_form($filter->{$item},
16504: 'domainfilter',
16505: $allow_blank,'',$onchange);
16506: }
16507: } else {
16508: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
16509: }
16510: }
16511:
16512: # last course activity filter and selection
16513: $sincefilterform = &timebased_select_form('sincefilter',$filter);
16514:
16515: # course created filter and selection
16516: if (exists($filter->{'createdfilter'})) {
16517: $createdfilterform = &timebased_select_form('createdfilter',$filter);
16518: }
16519:
16520: my %lt = &Apache::lonlocal::texthash(
16521: 'cac' => "$crstype Activity",
16522: 'ccr' => "$crstype Created",
16523: 'cde' => "$crstype Title",
16524: 'cdo' => "$crstype Domain",
16525: 'ins' => 'Institutional Code',
16526: 'inc' => 'Institutional Categorization',
16527: 'cow' => "$crstype Owner/Co-owner",
16528: 'cop' => "$crstype Personnel Includes",
16529: 'cog' => 'Type',
16530: );
16531:
16532: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16533: my $typeval = 'Course';
16534: if ($crstype eq 'Community') {
16535: $typeval = 'Community';
16536: }
16537: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
16538: } else {
16539: $typeselectform = '<select name="type" size="1"';
16540: if ($onchange) {
16541: $typeselectform .= ' onchange="'.$onchange.'"';
16542: }
16543: $typeselectform .= '>'."\n";
16544: foreach my $posstype ('Course','Community') {
16545: $typeselectform.='<option value="'.$posstype.'"'.
16546: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
16547: }
16548: $typeselectform.="</select>";
16549: }
16550:
16551: my ($cloneableonlyform,$cloneabletitle);
16552: if (exists($filter->{'cloneableonly'})) {
16553: my $cloneableon = '';
16554: my $cloneableoff = ' checked="checked"';
16555: if ($filter->{'cloneableonly'}) {
16556: $cloneableon = $cloneableoff;
16557: $cloneableoff = '';
16558: }
16559: $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>';
16560: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 16561: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 16562: } else {
16563: $cloneabletitle = &mt('Cloneable by you');
16564: }
16565: }
16566: my $officialjs;
16567: if ($crstype eq 'Course') {
16568: if (exists($filter->{'instcodefilter'})) {
16569: # if (($fixeddom) || ($formname eq 'requestcrs') ||
16570: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
16571: if ($codedom) {
16572: $officialjs = 1;
16573: ($instcodeform,$jscript,$$numtitlesref) =
16574: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
16575: $officialjs,$codetitlesref);
16576: if ($jscript) {
16577: $jscript = '<script type="text/javascript">'."\n".
16578: '// <![CDATA['."\n".
16579: $jscript."\n".
16580: '// ]]>'."\n".
16581: '</script>'."\n";
16582: }
16583: }
16584: if ($instcodeform eq '') {
16585: $instcodeform =
16586: '<input type="text" name="instcodefilter" size="10" value="'.
16587: $list->{'instcodefilter'}.'" />';
16588: $instcodetitle = $lt{'ins'};
16589: } else {
16590: $instcodetitle = $lt{'inc'};
16591: }
16592: if ($fixeddom) {
16593: $instcodetitle .= '<br />('.$codedom.')';
16594: }
16595: }
16596: }
16597: my $output = qq|
16598: <form method="post" name="filterpicker" action="$action">
16599: <input type="hidden" name="form" value="$formname" />
16600: |;
16601: if ($formname eq 'modifycourse') {
16602: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
16603: '<input type="hidden" name="prevphase" value="'.
16604: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 16605: } elsif ($formname eq 'quotacheck') {
16606: $output .= qq|
16607: <input type="hidden" name="sortby" value="" />
16608: <input type="hidden" name="sortorder" value="" />
16609: |;
16610: } else {
1.1075.2.69 raeburn 16611: my $name_input;
16612: if ($cnameelement ne '') {
16613: $name_input = '<input type="hidden" name="cnameelement" value="'.
16614: $cnameelement.'" />';
16615: }
16616: $output .= qq|
16617: <input type="hidden" name="cnumelement" value="$cnumelement" />
16618: <input type="hidden" name="cdomelement" value="$cdomelement" />
16619: $name_input
16620: $roleelement
16621: $multelement
16622: $typeelement
16623: |;
16624: if ($formname eq 'portform') {
16625: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
16626: }
16627: }
16628: if ($fixeddom) {
16629: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
16630: }
16631: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
16632: if ($sincefilterform) {
16633: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
16634: .$sincefilterform
16635: .&Apache::lonhtmlcommon::row_closure();
16636: }
16637: if ($createdfilterform) {
16638: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
16639: .$createdfilterform
16640: .&Apache::lonhtmlcommon::row_closure();
16641: }
16642: if ($domainselectform) {
16643: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
16644: .$domainselectform
16645: .&Apache::lonhtmlcommon::row_closure();
16646: }
16647: if ($typeselectform) {
16648: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
16649: $output .= $typeselectform;
16650: } else {
16651: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
16652: .$typeselectform
16653: .&Apache::lonhtmlcommon::row_closure();
16654: }
16655: }
16656: if ($instcodeform) {
16657: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
16658: .$instcodeform
16659: .&Apache::lonhtmlcommon::row_closure();
16660: }
16661: if (exists($filter->{'ownerfilter'})) {
16662: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
16663: '<table><tr><td>'.&mt('Username').'<br />'.
16664: '<input type="text" name="ownerfilter" size="20" value="'.
16665: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16666: $ownerdomselectform.'</td></tr></table>'.
16667: &Apache::lonhtmlcommon::row_closure();
16668: }
16669: if (exists($filter->{'personfilter'})) {
16670: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
16671: '<table><tr><td>'.&mt('Username').'<br />'.
16672: '<input type="text" name="personfilter" size="20" value="'.
16673: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
16674: $persondomselectform.'</td></tr></table>'.
16675: &Apache::lonhtmlcommon::row_closure();
16676: }
16677: if (exists($filter->{'coursefilter'})) {
16678: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
16679: .'<input type="text" name="coursefilter" size="25" value="'
16680: .$list->{'coursefilter'}.'" />'
16681: .&Apache::lonhtmlcommon::row_closure();
16682: }
16683: if ($cloneableonlyform) {
16684: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
16685: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
16686: }
16687: if (exists($filter->{'descriptfilter'})) {
16688: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
16689: .'<input type="text" name="descriptfilter" size="40" value="'
16690: .$list->{'descriptfilter'}.'" />'
16691: .&Apache::lonhtmlcommon::row_closure(1);
16692: }
16693: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
16694: '<input type="hidden" name="updater" value="" />'."\n".
16695: '<input type="submit" name="gosearch" value="'.
16696: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
16697: return $jscript.$clonewarning.$output;
16698: }
16699:
16700: =pod
16701:
16702: =item * &timebased_select_form()
16703:
16704: Create markup for a dropdown list used to select a time-based
16705: filter e.g., Course Activity, Course Created, when searching for courses
16706: or communities
16707:
16708: Inputs:
16709:
16710: item - name of form element (sincefilter or createdfilter)
16711:
16712: filter - anonymous hash of criteria and their values
16713:
16714: Returns: HTML for a select box contained a blank, then six time selections,
16715: with value set in incoming form variables currently selected.
16716:
16717: Side Effects: None
16718:
16719: =cut
16720:
16721: sub timebased_select_form {
16722: my ($item,$filter) = @_;
16723: if (ref($filter) eq 'HASH') {
16724: $filter->{$item} =~ s/[^\d-]//g;
16725: if (!$filter->{$item}) { $filter->{$item}=-1; }
16726: return &select_form(
16727: $filter->{$item},
16728: $item,
16729: { '-1' => '',
16730: '86400' => &mt('today'),
16731: '604800' => &mt('last week'),
16732: '2592000' => &mt('last month'),
16733: '7776000' => &mt('last three months'),
16734: '15552000' => &mt('last six months'),
16735: '31104000' => &mt('last year'),
16736: 'select_form_order' =>
16737: ['-1','86400','604800','2592000','7776000',
16738: '15552000','31104000']});
16739: }
16740: }
16741:
16742: =pod
16743:
16744: =item * &js_changer()
16745:
16746: Create script tag containing Javascript used to submit course search form
16747: when course type or domain is changed, and also to hide 'Searching ...' on
16748: page load completion for page showing search result.
16749:
16750: Inputs: None
16751:
16752: Returns: markup containing updateFilters() and hideSearching() javascript functions.
16753:
16754: Side Effects: None
16755:
16756: =cut
16757:
16758: sub js_changer {
16759: return <<ENDJS;
16760: <script type="text/javascript">
16761: // <![CDATA[
16762: function updateFilters(caller) {
16763: if (typeof(caller) != "undefined") {
16764: document.filterpicker.updater.value = caller.name;
16765: }
16766: document.filterpicker.submit();
16767: }
16768:
16769: function hideSearching() {
16770: if (document.getElementById('searching')) {
16771: document.getElementById('searching').style.display = 'none';
16772: }
16773: return;
16774: }
16775:
16776: // ]]>
16777: </script>
16778:
16779: ENDJS
16780: }
16781:
16782: =pod
16783:
16784: =item * &search_courses()
16785:
16786: Process selected filters form course search form and pass to lonnet::courseiddump
16787: to retrieve a hash for which keys are courseIDs which match the selected filters.
16788:
16789: Inputs:
16790:
16791: dom - domain being searched
16792:
16793: type - course type ('Course' or 'Community' or '.' if any).
16794:
16795: filter - anonymous hash of criteria and their values
16796:
16797: numtitles - for institutional codes - number of categories
16798:
16799: cloneruname - optional username of new course owner
16800:
16801: clonerudom - optional domain of new course owner
16802:
1.1075.2.95 raeburn 16803: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69 raeburn 16804: (used when DC is using course creation form)
16805:
16806: codetitles - reference to array of titles of components in institutional codes (official courses).
16807:
1.1075.2.95 raeburn 16808: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
16809: (and so can clone automatically)
16810:
16811: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
16812:
16813: reqinstcode - institutional code of new course, where search_courses is used to identify potential
16814: courses to clone
1.1075.2.69 raeburn 16815:
16816: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
16817:
16818:
16819: Side Effects: None
16820:
16821: =cut
16822:
16823:
16824: sub search_courses {
1.1075.2.95 raeburn 16825: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
16826: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69 raeburn 16827: my (%courses,%showcourses,$cloner);
16828: if (($filter->{'ownerfilter'} ne '') ||
16829: ($filter->{'ownerdomfilter'} ne '')) {
16830: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
16831: $filter->{'ownerdomfilter'};
16832: }
16833: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
16834: if (!$filter->{$item}) {
16835: $filter->{$item}='.';
16836: }
16837: }
16838: my $now = time;
16839: my $timefilter =
16840: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
16841: my ($createdbefore,$createdafter);
16842: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
16843: $createdbefore = $now;
16844: $createdafter = $now-$filter->{'createdfilter'};
16845: }
16846: my ($instcodefilter,$regexpok);
16847: if ($numtitles) {
16848: if ($env{'form.official'} eq 'on') {
16849: $instcodefilter =
16850: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16851: $regexpok = 1;
16852: } elsif ($env{'form.official'} eq 'off') {
16853: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
16854: unless ($instcodefilter eq '') {
16855: $regexpok = -1;
16856: }
16857: }
16858: } else {
16859: $instcodefilter = $filter->{'instcodefilter'};
16860: }
16861: if ($instcodefilter eq '') { $instcodefilter = '.'; }
16862: if ($type eq '') { $type = '.'; }
16863:
16864: if (($clonerudom ne '') && ($cloneruname ne '')) {
16865: $cloner = $cloneruname.':'.$clonerudom;
16866: }
16867: %courses = &Apache::lonnet::courseiddump($dom,
16868: $filter->{'descriptfilter'},
16869: $timefilter,
16870: $instcodefilter,
16871: $filter->{'combownerfilter'},
16872: $filter->{'coursefilter'},
16873: undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95 raeburn 16874: undef,undef,$cloner,$cc_clone,
1.1075.2.69 raeburn 16875: $filter->{'cloneableonly'},
16876: $createdbefore,$createdafter,undef,
1.1075.2.95 raeburn 16877: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69 raeburn 16878: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
16879: my $ccrole;
16880: if ($type eq 'Community') {
16881: $ccrole = 'co';
16882: } else {
16883: $ccrole = 'cc';
16884: }
16885: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
16886: $filter->{'persondomfilter'},
16887: 'userroles',undef,
16888: [$ccrole,'in','ad','ep','ta','cr'],
16889: $dom);
16890: foreach my $role (keys(%rolehash)) {
16891: my ($cnum,$cdom,$courserole) = split(':',$role);
16892: my $cid = $cdom.'_'.$cnum;
16893: if (exists($courses{$cid})) {
16894: if (ref($courses{$cid}) eq 'HASH') {
16895: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
16896: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
1.1075.2.119 raeburn 16897: push(@{$courses{$cid}{roles}},$courserole);
1.1075.2.69 raeburn 16898: }
16899: } else {
16900: $courses{$cid}{roles} = [$courserole];
16901: }
16902: $showcourses{$cid} = $courses{$cid};
16903: }
16904: }
16905: }
16906: %courses = %showcourses;
16907: }
16908: return %courses;
16909: }
16910:
16911: =pod
16912:
16913: =back
16914:
1.1075.2.88 raeburn 16915: =head1 Routines for version requirements for current course.
16916:
16917: =over 4
16918:
16919: =item * &check_release_required()
16920:
16921: Compares required LON-CAPA version with version on server, and
16922: if required version is newer looks for a server with the required version.
16923:
16924: Looks first at servers in user's owen domain; if none suitable, looks at
16925: servers in course's domain are permitted to host sessions for user's domain.
16926:
16927: Inputs:
16928:
16929: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
16930:
16931: $courseid - Course ID of current course
16932:
16933: $rolecode - User's current role in course (for switchserver query string).
16934:
16935: $required - LON-CAPA version needed by course (format: Major.Minor).
16936:
16937:
16938: Returns:
16939:
16940: $switchserver - query string tp append to /adm/switchserver call (if
16941: current server's LON-CAPA version is too old.
16942:
16943: $warning - Message is displayed if no suitable server could be found.
16944:
16945: =cut
16946:
16947: sub check_release_required {
16948: my ($loncaparev,$courseid,$rolecode,$required) = @_;
16949: my ($switchserver,$warning);
16950: if ($required ne '') {
16951: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
16952: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16953: if ($reqdmajor ne '' && $reqdminor ne '') {
16954: my $otherserver;
16955: if (($major eq '' && $minor eq '') ||
16956: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
16957: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
16958: my $switchlcrev =
16959: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
16960: $userdomserver);
16961: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
16962: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
16963: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
16964: my $cdom = $env{'course.'.$courseid.'.domain'};
16965: if ($cdom ne $env{'user.domain'}) {
16966: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
16967: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
16968: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16969: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
16970: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
16971: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
16972: my $canhost =
16973: &Apache::lonnet::can_host_session($env{'user.domain'},
16974: $coursedomserver,
16975: $remoterev,
16976: $udomdefaults{'remotesessions'},
16977: $defdomdefaults{'hostedsessions'});
16978:
16979: if ($canhost) {
16980: $otherserver = $coursedomserver;
16981: } else {
16982: $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.");
16983: }
16984: } else {
16985: $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).");
16986: }
16987: } else {
16988: $otherserver = $userdomserver;
16989: }
16990: }
16991: if ($otherserver ne '') {
16992: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
16993: }
16994: }
16995: }
16996: return ($switchserver,$warning);
16997: }
16998:
16999: =pod
17000:
17001: =item * &check_release_result()
17002:
17003: Inputs:
17004:
17005: $switchwarning - Warning message if no suitable server found to host session.
17006:
17007: $switchserver - query string to append to /adm/switchserver containing lonHostID
17008: and current role.
17009:
17010: Returns: HTML to display with information about requirement to switch server.
17011: Either displaying warning with link to Roles/Courses screen or
17012: display link to switchserver.
17013:
1.1075.2.69 raeburn 17014: =cut
17015:
1.1075.2.88 raeburn 17016: sub check_release_result {
17017: my ($switchwarning,$switchserver) = @_;
17018: my $output = &start_page('Selected course unavailable on this server').
17019: '<p class="LC_warning">';
17020: if ($switchwarning) {
17021: $output .= $switchwarning.'<br /><a href="/adm/roles">';
17022: if (&show_course()) {
17023: $output .= &mt('Display courses');
17024: } else {
17025: $output .= &mt('Display roles');
17026: }
17027: $output .= '</a>';
17028: } elsif ($switchserver) {
17029: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
17030: '<br />'.
17031: '<a href="/adm/switchserver?'.$switchserver.'">'.
17032: &mt('Switch Server').
17033: '</a>';
17034: }
17035: $output .= '</p>'.&end_page();
17036: return $output;
17037: }
17038:
17039: =pod
17040:
17041: =item * &needs_coursereinit()
17042:
17043: Determine if course contents stored for user's session needs to be
17044: refreshed, because content has changed since "Big Hash" last tied.
17045:
17046: Check for change is made if time last checked is more than 10 minutes ago
17047: (by default).
17048:
17049: Inputs:
17050:
17051: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
17052:
17053: $interval (optional) - Time which may elapse (in s) between last check for content
17054: change in current course. (default: 600 s).
17055:
17056: Returns: an array; first element is:
17057:
17058: =over 4
17059:
17060: 'switch' - if content updates mean user's session
17061: needs to be switched to a server running a newer LON-CAPA version
17062:
17063: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
17064: on current server hosting user's session
17065:
17066: '' - if no action required.
17067:
17068: =back
17069:
17070: If first item element is 'switch':
17071:
17072: second item is $switchwarning - Warning message if no suitable server found to host session.
17073:
17074: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
17075: and current role.
17076:
17077: otherwise: no other elements returned.
17078:
17079: =back
17080:
17081: =cut
17082:
17083: sub needs_coursereinit {
17084: my ($loncaparev,$interval) = @_;
17085: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
17086: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
17087: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
17088: my $now = time;
17089: if ($interval eq '') {
17090: $interval = 600;
17091: }
17092: if (($now-$env{'request.course.timechecked'})>$interval) {
17093: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
17094: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
17095: if ($lastchange > $env{'request.course.tied'}) {
17096: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17097: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
17098: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
17099: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
17100: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
17101: $curr_reqd_hash{'internal.releaserequired'}});
17102: my ($switchserver,$switchwarning) =
17103: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
17104: $curr_reqd_hash{'internal.releaserequired'});
17105: if ($switchwarning ne '' || $switchserver ne '') {
17106: return ('switch',$switchwarning,$switchserver);
17107: }
17108: }
17109: }
17110: return ('update');
17111: }
17112: }
17113: return ();
17114: }
1.1075.2.69 raeburn 17115:
1.1075.2.11 raeburn 17116: sub update_content_constraints {
17117: my ($cdom,$cnum,$chome,$cid) = @_;
17118: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
17119: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
17120: my %checkresponsetypes;
17121: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
17122: my ($item,$name,$value) = split(/:/,$key);
17123: if ($item eq 'resourcetag') {
17124: if ($name eq 'responsetype') {
17125: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
17126: }
17127: }
17128: }
17129: my $navmap = Apache::lonnavmaps::navmap->new();
17130: if (defined($navmap)) {
17131: my %allresponses;
17132: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
17133: my %responses = $res->responseTypes();
17134: foreach my $key (keys(%responses)) {
17135: next unless(exists($checkresponsetypes{$key}));
17136: $allresponses{$key} += $responses{$key};
17137: }
17138: }
17139: foreach my $key (keys(%allresponses)) {
17140: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
17141: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
17142: ($reqdmajor,$reqdminor) = ($major,$minor);
17143: }
17144: }
17145: undef($navmap);
17146: }
17147: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
17148: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
17149: }
17150: return;
17151: }
17152:
1.1075.2.27 raeburn 17153: sub allmaps_incourse {
17154: my ($cdom,$cnum,$chome,$cid) = @_;
17155: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
17156: $cid = $env{'request.course.id'};
17157: $cdom = $env{'course.'.$cid.'.domain'};
17158: $cnum = $env{'course.'.$cid.'.num'};
17159: $chome = $env{'course.'.$cid.'.home'};
17160: }
17161: my %allmaps = ();
17162: my $lastchange =
17163: &Apache::lonnet::get_coursechange($cdom,$cnum);
17164: if ($lastchange > $env{'request.course.tied'}) {
17165: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
17166: unless ($ferr) {
17167: &update_content_constraints($cdom,$cnum,$chome,$cid);
17168: }
17169: }
17170: my $navmap = Apache::lonnavmaps::navmap->new();
17171: if (defined($navmap)) {
17172: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
17173: $allmaps{$res->src()} = 1;
17174: }
17175: }
17176: return \%allmaps;
17177: }
17178:
1.1075.2.11 raeburn 17179: sub parse_supplemental_title {
17180: my ($title) = @_;
17181:
17182: my ($foldertitle,$renametitle);
17183: if ($title =~ /&&&/) {
17184: $title = &HTML::Entites::decode($title);
17185: }
17186: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
17187: $renametitle=$4;
17188: my ($time,$uname,$udom) = ($1,$2,$3);
17189: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
17190: my $name = &plainname($uname,$udom);
17191: $name = &HTML::Entities::encode($name,'"<>&\'');
17192: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
17193: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
17194: $name.': <br />'.$foldertitle;
17195: }
17196: if (wantarray) {
17197: return ($title,$foldertitle,$renametitle);
17198: }
17199: return $title;
17200: }
17201:
1.1075.2.43 raeburn 17202: sub recurse_supplemental {
17203: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
17204: if ($suppmap) {
17205: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
17206: if ($fatal) {
17207: $errors ++;
17208: } else {
1.1075.2.167 raeburn 17209: my @order = @LONCAPA::map::order;
17210: if (@order > 0) {
17211: my @resources = @LONCAPA::map::resources;
17212: my @resparms = @LONCAPA::map::resparms;
17213: foreach my $idx (@order) {
17214: my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
1.1075.2.43 raeburn 17215: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 17216: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
17217: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 17218: } else {
17219: $numfiles ++;
17220: }
17221: }
17222: }
17223: }
17224: }
17225: }
17226: return ($numfiles,$errors);
17227: }
17228:
1.1075.2.18 raeburn 17229: sub symb_to_docspath {
1.1075.2.119 raeburn 17230: my ($symb,$navmapref) = @_;
17231: return unless ($symb && ref($navmapref));
1.1075.2.18 raeburn 17232: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
17233: if ($resurl=~/\.(sequence|page)$/) {
17234: $mapurl=$resurl;
17235: } elsif ($resurl eq 'adm/navmaps') {
17236: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
17237: }
17238: my $mapresobj;
1.1075.2.119 raeburn 17239: unless (ref($$navmapref)) {
17240: $$navmapref = Apache::lonnavmaps::navmap->new();
17241: }
17242: if (ref($$navmapref)) {
17243: $mapresobj = $$navmapref->getResourceByUrl($mapurl);
1.1075.2.18 raeburn 17244: }
17245: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
17246: my $type=$2;
17247: my $path;
17248: if (ref($mapresobj)) {
17249: my $pcslist = $mapresobj->map_hierarchy();
17250: if ($pcslist ne '') {
17251: foreach my $pc (split(/,/,$pcslist)) {
17252: next if ($pc <= 1);
1.1075.2.119 raeburn 17253: my $res = $$navmapref->getByMapPc($pc);
1.1075.2.18 raeburn 17254: if (ref($res)) {
17255: my $thisurl = $res->src();
17256: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
17257: my $thistitle = $res->title();
17258: $path .= '&'.
17259: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 17260: &escape($thistitle).
1.1075.2.18 raeburn 17261: ':'.$res->randompick().
17262: ':'.$res->randomout().
17263: ':'.$res->encrypted().
17264: ':'.$res->randomorder().
17265: ':'.$res->is_page();
17266: }
17267: }
17268: }
17269: $path =~ s/^\&//;
17270: my $maptitle = $mapresobj->title();
17271: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 17272: $maptitle = 'Main Content';
1.1075.2.18 raeburn 17273: }
17274: $path .= (($path ne '')? '&' : '').
17275: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 17276: &escape($maptitle).
1.1075.2.18 raeburn 17277: ':'.$mapresobj->randompick().
17278: ':'.$mapresobj->randomout().
17279: ':'.$mapresobj->encrypted().
17280: ':'.$mapresobj->randomorder().
17281: ':'.$mapresobj->is_page();
17282: } else {
17283: my $maptitle = &Apache::lonnet::gettitle($mapurl);
17284: my $ispage = (($type eq 'page')? 1 : '');
17285: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 17286: $maptitle = 'Main Content';
1.1075.2.18 raeburn 17287: }
17288: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 17289: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 17290: }
17291: unless ($mapurl eq 'default') {
17292: $path = 'default&'.
1.1075.2.46 raeburn 17293: &escape('Main Content').
1.1075.2.18 raeburn 17294: ':::::&'.$path;
17295: }
17296: return $path;
17297: }
17298:
1.1075.2.14 raeburn 17299: sub captcha_display {
1.1075.2.137 raeburn 17300: my ($context,$lonhost,$defdom) = @_;
1.1075.2.14 raeburn 17301: my ($output,$error);
1.1075.2.107 raeburn 17302: my ($captcha,$pubkey,$privkey,$version) =
1.1075.2.137 raeburn 17303: &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14 raeburn 17304: if ($captcha eq 'original') {
17305: $output = &create_captcha();
17306: unless ($output) {
17307: $error = 'captcha';
17308: }
17309: } elsif ($captcha eq 'recaptcha') {
1.1075.2.107 raeburn 17310: $output = &create_recaptcha($pubkey,$version);
1.1075.2.14 raeburn 17311: unless ($output) {
17312: $error = 'recaptcha';
17313: }
17314: }
1.1075.2.107 raeburn 17315: return ($output,$error,$captcha,$version);
1.1075.2.14 raeburn 17316: }
17317:
17318: sub captcha_response {
1.1075.2.137 raeburn 17319: my ($context,$lonhost,$defdom) = @_;
1.1075.2.14 raeburn 17320: my ($captcha_chk,$captcha_error);
1.1075.2.137 raeburn 17321: my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
1.1075.2.14 raeburn 17322: if ($captcha eq 'original') {
17323: ($captcha_chk,$captcha_error) = &check_captcha();
17324: } elsif ($captcha eq 'recaptcha') {
1.1075.2.107 raeburn 17325: $captcha_chk = &check_recaptcha($privkey,$version);
1.1075.2.14 raeburn 17326: } else {
17327: $captcha_chk = 1;
17328: }
17329: return ($captcha_chk,$captcha_error);
17330: }
17331:
17332: sub get_captcha_config {
1.1075.2.137 raeburn 17333: my ($context,$lonhost,$dom_in_effect) = @_;
1.1075.2.107 raeburn 17334: my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
1.1075.2.14 raeburn 17335: my $hostname = &Apache::lonnet::hostname($lonhost);
17336: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
17337: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
17338: if ($context eq 'usercreation') {
17339: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
17340: if (ref($domconfig{$context}) eq 'HASH') {
17341: $hashtocheck = $domconfig{$context}{'cancreate'};
17342: if (ref($hashtocheck) eq 'HASH') {
17343: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
17344: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
17345: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
17346: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
17347: }
17348: if ($privkey && $pubkey) {
17349: $captcha = 'recaptcha';
1.1075.2.107 raeburn 17350: $version = $hashtocheck->{'recaptchaversion'};
17351: if ($version ne '2') {
17352: $version = 1;
17353: }
1.1075.2.14 raeburn 17354: } else {
17355: $captcha = 'original';
17356: }
17357: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
17358: $captcha = 'original';
17359: }
17360: }
17361: } else {
17362: $captcha = 'captcha';
17363: }
17364: } elsif ($context eq 'login') {
17365: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
17366: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
17367: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
17368: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
17369: if ($privkey && $pubkey) {
17370: $captcha = 'recaptcha';
1.1075.2.107 raeburn 17371: $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'};
17372: if ($version ne '2') {
17373: $version = 1;
17374: }
1.1075.2.14 raeburn 17375: } else {
17376: $captcha = 'original';
17377: }
17378: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
17379: $captcha = 'original';
17380: }
1.1075.2.137 raeburn 17381: } elsif ($context eq 'passwords') {
17382: if ($dom_in_effect) {
17383: my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
17384: if ($passwdconf{'captcha'} eq 'recaptcha') {
17385: if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
17386: $pubkey = $passwdconf{'recaptchakeys'}{'public'};
17387: $privkey = $passwdconf{'recaptchakeys'}{'private'};
17388: }
17389: if ($privkey && $pubkey) {
17390: $captcha = 'recaptcha';
17391: $version = $passwdconf{'recaptchaversion'};
17392: if ($version ne '2') {
17393: $version = 1;
17394: }
17395: } else {
17396: $captcha = 'original';
17397: }
17398: } elsif ($passwdconf{'captcha'} ne 'notused') {
17399: $captcha = 'original';
17400: }
17401: }
1.1075.2.14 raeburn 17402: }
1.1075.2.107 raeburn 17403: return ($captcha,$pubkey,$privkey,$version);
1.1075.2.14 raeburn 17404: }
17405:
17406: sub create_captcha {
17407: my %captcha_params = &captcha_settings();
17408: my ($output,$maxtries,$tries) = ('',10,0);
17409: while ($tries < $maxtries) {
17410: $tries ++;
17411: my $captcha = Authen::Captcha->new (
17412: output_folder => $captcha_params{'output_dir'},
17413: data_folder => $captcha_params{'db_dir'},
17414: );
17415: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
17416:
17417: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
17418: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
1.1075.2.158 raeburn 17419: '<span class="LC_nobreak">'.
1.1075.2.14 raeburn 17420: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.167 raeburn 17421: '<input type="text" size="5" name="code" value="" autocomplete="new-password" />'.
1.1075.2.158 raeburn 17422: '</span><br />'.
1.1075.2.66 raeburn 17423: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 17424: last;
17425: }
17426: }
1.1075.2.158 raeburn 17427: if ($output eq '') {
17428: &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
17429: }
1.1075.2.14 raeburn 17430: return $output;
17431: }
17432:
17433: sub captcha_settings {
17434: my %captcha_params = (
17435: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
17436: www_output_dir => "/captchaspool",
17437: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
17438: numchars => '5',
17439: );
17440: return %captcha_params;
17441: }
17442:
17443: sub check_captcha {
17444: my ($captcha_chk,$captcha_error);
17445: my $code = $env{'form.code'};
17446: my $md5sum = $env{'form.crypt'};
17447: my %captcha_params = &captcha_settings();
17448: my $captcha = Authen::Captcha->new(
17449: output_folder => $captcha_params{'output_dir'},
17450: data_folder => $captcha_params{'db_dir'},
17451: );
1.1075.2.26 raeburn 17452: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 17453: my %captcha_hash = (
17454: 0 => 'Code not checked (file error)',
17455: -1 => 'Failed: code expired',
17456: -2 => 'Failed: invalid code (not in database)',
17457: -3 => 'Failed: invalid code (code does not match crypt)',
17458: );
17459: if ($captcha_chk != 1) {
17460: $captcha_error = $captcha_hash{$captcha_chk}
17461: }
17462: return ($captcha_chk,$captcha_error);
17463: }
17464:
17465: sub create_recaptcha {
1.1075.2.107 raeburn 17466: my ($pubkey,$version) = @_;
17467: if ($version >= 2) {
1.1075.2.158 raeburn 17468: return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
17469: '<div style="padding:0;clear:both;margin:0;border:0"></div>';
1.1075.2.107 raeburn 17470: } else {
17471: my $use_ssl;
17472: if ($ENV{'SERVER_PORT'} == 443) {
17473: $use_ssl = 1;
17474: }
17475: my $captcha = Captcha::reCAPTCHA->new;
17476: return $captcha->get_options_setter({theme => 'white'})."\n".
17477: $captcha->get_html($pubkey,undef,$use_ssl).
17478: &mt('If the text is hard to read, [_1] will replace them.',
17479: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
17480: '<br /><br />';
17481: }
1.1075.2.14 raeburn 17482: }
17483:
17484: sub check_recaptcha {
1.1075.2.107 raeburn 17485: my ($privkey,$version) = @_;
1.1075.2.14 raeburn 17486: my $captcha_chk;
1.1075.2.150 raeburn 17487: my $ip = &Apache::lonnet::get_requestor_ip();
1.1075.2.107 raeburn 17488: if ($version >= 2) {
17489: my $ua = LWP::UserAgent->new;
17490: $ua->timeout(10);
17491: my %info = (
17492: secret => $privkey,
17493: response => $env{'form.g-recaptcha-response'},
1.1075.2.150 raeburn 17494: remoteip => $ip,
1.1075.2.107 raeburn 17495: );
17496: my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
17497: if ($response->is_success) {
17498: my $data = JSON::DWIW->from_json($response->decoded_content);
17499: if (ref($data) eq 'HASH') {
17500: if ($data->{'success'}) {
17501: $captcha_chk = 1;
17502: }
17503: }
17504: }
17505: } else {
17506: my $captcha = Captcha::reCAPTCHA->new;
17507: my $captcha_result =
17508: $captcha->check_answer(
17509: $privkey,
1.1075.2.150 raeburn 17510: $ip,
1.1075.2.107 raeburn 17511: $env{'form.recaptcha_challenge_field'},
17512: $env{'form.recaptcha_response_field'},
17513: );
17514: if ($captcha_result->{is_valid}) {
17515: $captcha_chk = 1;
17516: }
1.1075.2.14 raeburn 17517: }
17518: return $captcha_chk;
17519: }
17520:
1.1075.2.64 raeburn 17521: sub emailusername_info {
1.1075.2.103 raeburn 17522: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1075.2.64 raeburn 17523: my %titles = &Apache::lonlocal::texthash (
17524: lastname => 'Last Name',
17525: firstname => 'First Name',
17526: institution => 'School/college/university',
17527: location => "School's city, state/province, country",
17528: web => "School's web address",
17529: officialemail => 'E-mail address at institution (if different)',
1.1075.2.103 raeburn 17530: id => 'Student/Employee ID',
1.1075.2.64 raeburn 17531: );
17532: return (\@fields,\%titles);
17533: }
17534:
1.1075.2.56 raeburn 17535: sub cleanup_html {
17536: my ($incoming) = @_;
17537: my $outgoing;
17538: if ($incoming ne '') {
17539: $outgoing = $incoming;
17540: $outgoing =~ s/;/;/g;
17541: $outgoing =~ s/\#/#/g;
17542: $outgoing =~ s/\&/&/g;
17543: $outgoing =~ s/</</g;
17544: $outgoing =~ s/>/>/g;
17545: $outgoing =~ s/\(/(/g;
17546: $outgoing =~ s/\)/)/g;
17547: $outgoing =~ s/"/"/g;
17548: $outgoing =~ s/'/'/g;
17549: $outgoing =~ s/\$/$/g;
17550: $outgoing =~ s{/}{/}g;
17551: $outgoing =~ s/=/=/g;
17552: $outgoing =~ s/\\/\/g
17553: }
17554: return $outgoing;
17555: }
17556:
1.1075.2.74 raeburn 17557: # Checks for critical messages and returns a redirect url if one exists.
17558: # $interval indicates how often to check for messages.
17559: sub critical_redirect {
17560: my ($interval) = @_;
1.1075.2.158 raeburn 17561: unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
17562: return ();
17563: }
1.1075.2.74 raeburn 17564: if ((time-$env{'user.criticalcheck.time'})>$interval) {
17565: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
17566: $env{'user.name'});
17567: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
17568: my $redirecturl;
17569: if ($what[0]) {
1.1075.2.158 raeburn 17570: if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
1.1075.2.74 raeburn 17571: $redirecturl='/adm/email?critical=display';
17572: my $url=&Apache::lonnet::absolute_url().$redirecturl;
17573: return (1, $url);
17574: }
17575: }
17576: }
17577: return ();
17578: }
17579:
1.1075.2.64 raeburn 17580: # Use:
17581: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
17582: #
17583: ##################################################
17584: # password associated functions #
17585: ##################################################
17586: sub des_keys {
17587: # Make a new key for DES encryption.
17588: # Each key has two parts which are returned separately.
17589: # Please note: Each key must be passed through the &hex function
17590: # before it is output to the web browser. The hex versions cannot
17591: # be used to decrypt.
17592: my @hexstr=('0','1','2','3','4','5','6','7',
17593: '8','9','a','b','c','d','e','f');
17594: my $lkey='';
17595: for (0..7) {
17596: $lkey.=$hexstr[rand(15)];
17597: }
17598: my $ukey='';
17599: for (0..7) {
17600: $ukey.=$hexstr[rand(15)];
17601: }
17602: return ($lkey,$ukey);
17603: }
17604:
17605: sub des_decrypt {
17606: my ($key,$cyphertext) = @_;
17607: my $keybin=pack("H16",$key);
17608: my $cypher;
17609: if ($Crypt::DES::VERSION>=2.03) {
17610: $cypher=new Crypt::DES $keybin;
17611: } else {
17612: $cypher=new DES $keybin;
17613: }
1.1075.2.106 raeburn 17614: my $plaintext='';
17615: my $cypherlength = length($cyphertext);
17616: my $numchunks = int($cypherlength/32);
17617: for (my $j=0; $j<$numchunks; $j++) {
17618: my $start = $j*32;
17619: my $cypherblock = substr($cyphertext,$start,32);
17620: my $chunk =
17621: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,0,16))));
17622: $chunk .=
17623: $cypher->decrypt(unpack("a8",pack("H16",substr($cypherblock,16,16))));
17624: $chunk=substr($chunk,1,ord(substr($chunk,0,1)) );
17625: $plaintext .= $chunk;
17626: }
1.1075.2.64 raeburn 17627: return $plaintext;
17628: }
17629:
1.1075.2.135 raeburn 17630: sub is_nonframeable {
17631: my ($url,$absolute,$hostname,$ip,$nocache) = @_;
17632: my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
17633: return if (($remprotocol eq '') || ($remhost eq ''));
17634:
17635: $remprotocol = lc($remprotocol);
17636: $remhost = lc($remhost);
17637: my $remport = 80;
17638: if ($remprotocol eq 'https') {
17639: $remport = 443;
17640: }
17641: my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
17642: if ($cached) {
17643: unless ($nocache) {
17644: if ($result) {
17645: return 1;
17646: } else {
17647: return 0;
17648: }
17649: }
17650: }
17651: my $uselink;
17652: my $request = new HTTP::Request('HEAD',$url);
1.1075.2.142 raeburn 17653: my $ua = LWP::UserAgent->new;
17654: $ua->timeout(5);
17655: my $response=$ua->request($request);
1.1075.2.135 raeburn 17656: if ($response->is_success()) {
17657: my $secpolicy = lc($response->header('content-security-policy'));
17658: my $xframeop = lc($response->header('x-frame-options'));
17659: $secpolicy =~ s/^\s+|\s+$//g;
17660: $xframeop =~ s/^\s+|\s+$//g;
17661: if (($secpolicy ne '') || ($xframeop ne '')) {
17662: my $remotehost = $remprotocol.'://'.$remhost;
17663: my ($origin,$protocol,$port);
17664: if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
17665: $port = $ENV{'SERVER_PORT'};
17666: } else {
17667: $port = 80;
17668: }
17669: if ($absolute eq '') {
17670: $protocol = 'http:';
17671: if ($port == 443) {
17672: $protocol = 'https:';
17673: }
17674: $origin = $protocol.'//'.lc($hostname);
17675: } else {
17676: $origin = lc($absolute);
17677: ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
17678: }
17679: if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
17680: my $framepolicy = $1;
17681: $framepolicy =~ s/^\s+|\s+$//g;
17682: my @policies = split(/\s+/,$framepolicy);
17683: if (@policies) {
17684: if (grep(/^\Q'none'\E$/,@policies)) {
17685: $uselink = 1;
17686: } else {
17687: $uselink = 1;
17688: if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
17689: (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
17690: (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
17691: undef($uselink);
17692: }
17693: if ($uselink) {
17694: if (grep(/^\Q'self'\E$/,@policies)) {
17695: if (($origin ne '') && ($remotehost eq $origin)) {
17696: undef($uselink);
17697: }
17698: }
17699: }
17700: if ($uselink) {
17701: my @possok;
17702: if ($ip ne '') {
17703: push(@possok,$ip);
17704: }
17705: my $hoststr = '';
17706: foreach my $part (reverse(split(/\./,$hostname))) {
17707: if ($hoststr eq '') {
17708: $hoststr = $part;
17709: } else {
17710: $hoststr = "$part.$hoststr";
17711: }
17712: if ($hoststr eq $hostname) {
17713: push(@possok,$hostname);
17714: } else {
17715: push(@possok,"*.$hoststr");
17716: }
17717: }
17718: if (@possok) {
17719: foreach my $poss (@possok) {
17720: last if (!$uselink);
17721: foreach my $policy (@policies) {
17722: if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
17723: undef($uselink);
17724: last;
17725: }
17726: }
17727: }
17728: }
17729: }
17730: }
17731: }
17732: } elsif ($xframeop ne '') {
17733: $uselink = 1;
17734: my @policies = split(/\s*,\s*/,$xframeop);
17735: if (@policies) {
17736: unless (grep(/^deny$/,@policies)) {
17737: if ($origin ne '') {
17738: if (grep(/^sameorigin$/,@policies)) {
17739: if ($remotehost eq $origin) {
17740: undef($uselink);
17741: }
17742: }
17743: if ($uselink) {
17744: foreach my $policy (@policies) {
17745: if ($policy =~ /^allow-from\s*(.+)$/) {
17746: my $allowfrom = $1;
17747: if (($allowfrom ne '') && ($allowfrom eq $origin)) {
17748: undef($uselink);
17749: last;
17750: }
17751: }
17752: }
17753: }
17754: }
17755: }
17756: }
17757: }
17758: }
17759: }
17760: if ($nocache) {
17761: if ($cached) {
17762: my $devalidate;
17763: if ($uselink && !$result) {
17764: $devalidate = 1;
17765: } elsif (!$uselink && $result) {
17766: $devalidate = 1;
17767: }
17768: if ($devalidate) {
17769: &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
17770: }
17771: }
17772: } else {
17773: if ($uselink) {
17774: $result = 1;
17775: } else {
17776: $result = 0;
17777: }
17778: &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
17779: }
17780: return $uselink;
17781: }
17782:
1.112 bowersj2 17783: 1;
17784: __END__;
1.41 ng 17785:
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