Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.94
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.94! raeburn 4: # $Id: loncommon.pm,v 1.1075.2.93 2015/04/20 11:48:27 raeburn Exp $
1.10 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.1 albertel 28:
29: # Makes a table out of the previous attempts
1.2 albertel 30: # Inputs result_from_symbread, user, domain, course_id
1.16 harris41 31: # Reads in non-network-related .tab files
1.1 albertel 32:
1.35 matthew 33: # POD header:
34:
1.45 matthew 35: =pod
36:
1.35 matthew 37: =head1 NAME
38:
39: Apache::loncommon - pile of common routines
40:
41: =head1 SYNOPSIS
42:
1.112 bowersj2 43: Common routines for manipulating connections, student answers,
44: domains, common Javascript fragments, etc.
1.35 matthew 45:
1.112 bowersj2 46: =head1 OVERVIEW
1.35 matthew 47:
1.112 bowersj2 48: A collection of commonly used subroutines that don't have a natural
49: home anywhere else. This collection helps remove
1.35 matthew 50: redundancy from other modules and increase efficiency of memory usage.
51:
52: =cut
53:
54: # End of POD header
1.1 albertel 55: package Apache::loncommon;
56:
57: use strict;
1.258 albertel 58: use Apache::lonnet;
1.46 matthew 59: use GDBM_File;
1.51 www 60: use POSIX qw(strftime mktime);
1.82 www 61: use Apache::lonmenu();
1.498 albertel 62: use Apache::lonenc();
1.117 www 63: use Apache::lonlocal;
1.685 tempelho 64: use Apache::lonnet();
1.139 matthew 65: use HTML::Entities;
1.334 albertel 66: use Apache::lonhtmlcommon();
67: use Apache::loncoursedata();
1.344 albertel 68: use Apache::lontexconvert();
1.444 albertel 69: use Apache::lonclonecourse();
1.1075.2.25 raeburn 70: use Apache::lonuserutils();
1.1075.2.27 raeburn 71: use Apache::lonuserstate();
1.1075.2.69 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 74: use DateTime::TimeZone;
1.687 raeburn 75: use DateTime::Locale::Catalog;
1.1075.2.94! raeburn 76: use Encode();
1.1075.2.14 raeburn 77: use Authen::Captcha;
78: use Captcha::reCAPTCHA;
1.1075.2.64 raeburn 79: use Crypt::DES;
80: use DynaLoader; # for Crypt::DES version
1.117 www 81:
1.517 raeburn 82: # ---------------------------------------------- Designs
83: use vars qw(%defaultdesign);
84:
1.22 www 85: my $readit;
86:
1.517 raeburn 87:
1.157 matthew 88: ##
89: ## Global Variables
90: ##
1.46 matthew 91:
1.643 foxr 92:
93: # ----------------------------------------------- SSI with retries:
94: #
95:
96: =pod
97:
1.648 raeburn 98: =head1 Server Side include with retries:
1.643 foxr 99:
100: =over 4
101:
1.648 raeburn 102: =item * &ssi_with_retries(resource,retries form)
1.643 foxr 103:
104: Performs an ssi with some number of retries. Retries continue either
105: until the result is ok or until the retry count supplied by the
106: caller is exhausted.
107:
108: Inputs:
1.648 raeburn 109:
110: =over 4
111:
1.643 foxr 112: resource - Identifies the resource to insert.
1.648 raeburn 113:
1.643 foxr 114: retries - Count of the number of retries allowed.
1.648 raeburn 115:
1.643 foxr 116: form - Hash that identifies the rendering options.
117:
1.648 raeburn 118: =back
119:
120: Returns:
121:
122: =over 4
123:
1.643 foxr 124: content - The content of the response. If retries were exhausted this is empty.
1.648 raeburn 125:
1.643 foxr 126: response - The response from the last attempt (which may or may not have been successful.
127:
1.648 raeburn 128: =back
129:
130: =back
131:
1.643 foxr 132: =cut
133:
134: sub ssi_with_retries {
135: my ($resource, $retries, %form) = @_;
136:
137:
138: my $ok = 0; # True if we got a good response.
139: my $content;
140: my $response;
141:
142: # Try to get the ssi done. within the retries count:
143:
144: do {
145: ($content, $response) = &Apache::lonnet::ssi($resource, %form);
146: $ok = $response->is_success;
1.650 www 147: if (!$ok) {
148: &Apache::lonnet::logthis("Failed ssi_with_retries on $resource: ".$response->is_success.', '.$response->code.', '.$response->message);
149: }
1.643 foxr 150: $retries--;
151: } while (!$ok && ($retries > 0));
152:
153: if (!$ok) {
154: $content = ''; # On error return an empty content.
155: }
156: return ($content, $response);
157:
158: }
159:
160:
161:
1.20 www 162: # ----------------------------------------------- Filetypes/Languages/Copyright
1.12 harris41 163: my %language;
1.124 www 164: my %supported_language;
1.1048 foxr 165: my %latex_language; # For choosing hyphenation in <transl..>
166: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 167: my %cprtag;
1.192 taceyjo1 168: my %scprtag;
1.351 www 169: my %fe; my %fd; my %fm;
1.41 ng 170: my %category_extensions;
1.12 harris41 171:
1.46 matthew 172: # ---------------------------------------------- Thesaurus variables
1.144 matthew 173: #
174: # %Keywords:
175: # A hash used by &keyword to determine if a word is considered a keyword.
176: # $thesaurus_db_file
177: # Scalar containing the full path to the thesaurus database.
1.46 matthew 178:
179: my %Keywords;
180: my $thesaurus_db_file;
181:
1.144 matthew 182: #
183: # Initialize values from language.tab, copyright.tab, filetypes.tab,
184: # thesaurus.tab, and filecategories.tab.
185: #
1.18 www 186: BEGIN {
1.46 matthew 187: # Variable initialization
188: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
189: #
1.22 www 190: unless ($readit) {
1.12 harris41 191: # ------------------------------------------------------------------- languages
192: {
1.158 raeburn 193: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
194: '/language.tab';
195: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 196: while (my $line = <$fh>) {
197: next if ($line=~/^\#/);
198: chomp($line);
1.1048 foxr 199: my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 200: $language{$key}=$val.' - '.$enc;
201: if ($sup) {
202: $supported_language{$key}=$sup;
203: }
1.1048 foxr 204: if ($latex) {
205: $latex_language_bykey{$key} = $latex;
206: $latex_language{$two} = $latex;
207: }
1.158 raeburn 208: }
209: close($fh);
210: }
1.12 harris41 211: }
212: # ------------------------------------------------------------------ copyrights
213: {
1.158 raeburn 214: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
215: '/copyright.tab';
216: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 217: while (my $line = <$fh>) {
218: next if ($line=~/^\#/);
219: chomp($line);
220: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 221: $cprtag{$key}=$val;
222: }
223: close($fh);
224: }
1.12 harris41 225: }
1.351 www 226: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 227: {
228: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
229: '/source_copyright.tab';
230: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 231: while (my $line = <$fh>) {
232: next if ($line =~ /^\#/);
233: chomp($line);
234: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 235: $scprtag{$key}=$val;
236: }
237: close($fh);
238: }
239: }
1.63 www 240:
1.517 raeburn 241: # -------------------------------------------------------------- default domain designs
1.63 www 242: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 243: my $designfile = $designdir.'/default.tab';
244: if ( open (my $fh,"<$designfile") ) {
245: while (my $line = <$fh>) {
246: next if ($line =~ /^\#/);
247: chomp($line);
248: my ($key,$val)=(split(/\=/,$line));
249: if ($val) { $defaultdesign{$key}=$val; }
250: }
251: close($fh);
1.63 www 252: }
253:
1.15 harris41 254: # ------------------------------------------------------------- file categories
255: {
1.158 raeburn 256: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
257: '/filecategories.tab';
258: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 259: while (my $line = <$fh>) {
260: next if ($line =~ /^\#/);
261: chomp($line);
262: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 263: push @{$category_extensions{lc($category)}},$extension;
264: }
265: close($fh);
266: }
267:
1.15 harris41 268: }
1.12 harris41 269: # ------------------------------------------------------------------ file types
270: {
1.158 raeburn 271: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
272: '/filetypes.tab';
273: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 274: while (my $line = <$fh>) {
275: next if ($line =~ /^\#/);
276: chomp($line);
277: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 278: if ($descr ne '') {
279: $fe{$ending}=lc($emb);
280: $fd{$ending}=$descr;
1.351 www 281: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 282: }
283: }
284: close($fh);
285: }
1.12 harris41 286: }
1.22 www 287: &Apache::lonnet::logthis(
1.705 tempelho 288: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 289: $readit=1;
1.46 matthew 290: } # end of unless($readit)
1.32 matthew 291:
292: }
1.112 bowersj2 293:
1.42 matthew 294: ###############################################################
295: ## HTML and Javascript Helper Functions ##
296: ###############################################################
297:
298: =pod
299:
1.112 bowersj2 300: =head1 HTML and Javascript Functions
1.42 matthew 301:
1.112 bowersj2 302: =over 4
303:
1.648 raeburn 304: =item * &browser_and_searcher_javascript()
1.112 bowersj2 305:
306: X<browsing, javascript>X<searching, javascript>Returns a string
307: containing javascript with two functions, C<openbrowser> and
308: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
309: tags.
1.42 matthew 310:
1.648 raeburn 311: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 312:
313: inputs: formname, elementname, only, omit
314:
315: formname and elementname indicate the name of the html form and name of
316: the element that the results of the browsing selection are to be placed in.
317:
318: Specifying 'only' will restrict the browser to displaying only files
1.185 www 319: with the given extension. Can be a comma separated list.
1.42 matthew 320:
321: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 322: with the given extension. Can be a comma separated list.
1.42 matthew 323:
1.648 raeburn 324: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 325:
326: Inputs: formname, elementname
327:
328: formname and elementname specify the name of the html form and the name
329: of the element the selection from the search results will be placed in.
1.542 raeburn 330:
1.42 matthew 331: =cut
332:
333: sub browser_and_searcher_javascript {
1.199 albertel 334: my ($mode)=@_;
335: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 336: my $resurl=&escape_single(&lastresurl());
1.42 matthew 337: return <<END;
1.219 albertel 338: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 339: var editbrowser = null;
1.135 albertel 340: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 341: var url = '$resurl/?';
1.42 matthew 342: if (editbrowser == null) {
343: url += 'launch=1&';
344: }
345: url += 'catalogmode=interactive&';
1.199 albertel 346: url += 'mode=$mode&';
1.611 albertel 347: url += 'inhibitmenu=yes&';
1.42 matthew 348: url += 'form=' + formname + '&';
349: if (only != null) {
350: url += 'only=' + only + '&';
1.217 albertel 351: } else {
352: url += 'only=&';
353: }
1.42 matthew 354: if (omit != null) {
355: url += 'omit=' + omit + '&';
1.217 albertel 356: } else {
357: url += 'omit=&';
358: }
1.135 albertel 359: if (titleelement != null) {
360: url += 'titleelement=' + titleelement + '&';
1.217 albertel 361: } else {
362: url += 'titleelement=&';
363: }
1.42 matthew 364: url += 'element=' + elementname + '';
365: var title = 'Browser';
1.435 albertel 366: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 367: options += ',width=700,height=600';
368: editbrowser = open(url,title,options,'1');
369: editbrowser.focus();
370: }
371: var editsearcher;
1.135 albertel 372: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 373: var url = '/adm/searchcat?';
374: if (editsearcher == null) {
375: url += 'launch=1&';
376: }
377: url += 'catalogmode=interactive&';
1.199 albertel 378: url += 'mode=$mode&';
1.42 matthew 379: url += 'form=' + formname + '&';
1.135 albertel 380: if (titleelement != null) {
381: url += 'titleelement=' + titleelement + '&';
1.217 albertel 382: } else {
383: url += 'titleelement=&';
384: }
1.42 matthew 385: url += 'element=' + elementname + '';
386: var title = 'Search';
1.435 albertel 387: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 388: options += ',width=700,height=600';
389: editsearcher = open(url,title,options,'1');
390: editsearcher.focus();
391: }
1.219 albertel 392: // END LON-CAPA Internal -->
1.42 matthew 393: END
1.170 www 394: }
395:
396: sub lastresurl {
1.258 albertel 397: if ($env{'environment.lastresurl'}) {
398: return $env{'environment.lastresurl'}
1.170 www 399: } else {
400: return '/res';
401: }
402: }
403:
404: sub storeresurl {
405: my $resurl=&Apache::lonnet::clutter(shift);
406: unless ($resurl=~/^\/res/) { return 0; }
407: $resurl=~s/\/$//;
408: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 409: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 410: return 1;
1.42 matthew 411: }
412:
1.74 www 413: sub studentbrowser_javascript {
1.111 www 414: unless (
1.258 albertel 415: (($env{'request.course.id'}) &&
1.302 albertel 416: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
417: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
418: '/'.$env{'request.course.sec'})
419: ))
1.258 albertel 420: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 421: ) { return ''; }
1.74 www 422: return (<<'ENDSTDBRW');
1.776 bisitz 423: <script type="text/javascript" language="Javascript">
1.824 bisitz 424: // <![CDATA[
1.74 www 425: var stdeditbrowser;
1.999 www 426: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 427: var url = '/adm/pickstudent?';
428: var filter;
1.558 albertel 429: if (!ignorefilter) {
430: eval('filter=document.'+formname+'.'+uname+'.value;');
431: }
1.74 www 432: if (filter != null) {
433: if (filter != '') {
434: url += 'filter='+filter+'&';
435: }
436: }
437: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 438: '&udomelement='+udom+
439: '&clicker='+clicker;
1.111 www 440: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 441: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 442: var title = 'Student_Browser';
1.74 www 443: var options = 'scrollbars=1,resizable=1,menubar=0';
444: options += ',width=700,height=600';
445: stdeditbrowser = open(url,title,options,'1');
446: stdeditbrowser.focus();
447: }
1.824 bisitz 448: // ]]>
1.74 www 449: </script>
450: ENDSTDBRW
451: }
1.42 matthew 452:
1.1003 www 453: sub resourcebrowser_javascript {
454: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 455: return (<<'ENDRESBRW');
1.1003 www 456: <script type="text/javascript" language="Javascript">
457: // <![CDATA[
458: var reseditbrowser;
1.1004 www 459: function openresbrowser(formname,reslink) {
1.1005 www 460: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 461: var title = 'Resource_Browser';
462: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 463: options += ',width=700,height=500';
1.1004 www 464: reseditbrowser = open(url,title,options,'1');
465: reseditbrowser.focus();
1.1003 www 466: }
467: // ]]>
468: </script>
1.1004 www 469: ENDRESBRW
1.1003 www 470: }
471:
1.74 www 472: sub selectstudent_link {
1.999 www 473: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
474: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
475: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
476: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 477: if ($env{'request.course.id'}) {
1.302 albertel 478: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
479: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
480: '/'.$env{'request.course.sec'})) {
1.111 www 481: return '';
482: }
1.999 www 483: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 484: if ($courseadvonly) {
485: $callargs .= ",'',1,1";
486: }
487: return '<span class="LC_nobreak">'.
488: '<a href="javascript:openstdbrowser('.$callargs.');">'.
489: &mt('Select User').'</a></span>';
1.74 www 490: }
1.258 albertel 491: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 492: $callargs .= ",'',1";
1.793 raeburn 493: return '<span class="LC_nobreak">'.
494: '<a href="javascript:openstdbrowser('.$callargs.');">'.
495: &mt('Select User').'</a></span>';
1.111 www 496: }
497: return '';
1.91 www 498: }
499:
1.1004 www 500: sub selectresource_link {
501: my ($form,$reslink,$arg)=@_;
502:
503: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
504: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
505: unless ($env{'request.course.id'}) { return $arg; }
506: return '<span class="LC_nobreak">'.
507: '<a href="javascript:openresbrowser('.$callargs.');">'.
508: $arg.'</a></span>';
509: }
510:
511:
512:
1.653 raeburn 513: sub authorbrowser_javascript {
514: return <<"ENDAUTHORBRW";
1.776 bisitz 515: <script type="text/javascript" language="JavaScript">
1.824 bisitz 516: // <![CDATA[
1.653 raeburn 517: var stdeditbrowser;
518:
519: function openauthorbrowser(formname,udom) {
520: var url = '/adm/pickauthor?';
521: url += 'form='+formname+'&roledom='+udom;
522: var title = 'Author_Browser';
523: var options = 'scrollbars=1,resizable=1,menubar=0';
524: options += ',width=700,height=600';
525: stdeditbrowser = open(url,title,options,'1');
526: stdeditbrowser.focus();
527: }
528:
1.824 bisitz 529: // ]]>
1.653 raeburn 530: </script>
531: ENDAUTHORBRW
532: }
533:
1.91 www 534: sub coursebrowser_javascript {
1.1075.2.31 raeburn 535: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
536: $credits_element) = @_;
1.932 raeburn 537: my $wintitle = 'Course_Browser';
1.931 raeburn 538: if ($crstype eq 'Community') {
1.932 raeburn 539: $wintitle = 'Community_Browser';
1.909 raeburn 540: }
1.876 raeburn 541: my $id_functions = &javascript_index_functions();
542: my $output = '
1.776 bisitz 543: <script type="text/javascript" language="JavaScript">
1.824 bisitz 544: // <![CDATA[
1.468 raeburn 545: var stdeditbrowser;'."\n";
1.876 raeburn 546:
547: $output .= <<"ENDSTDBRW";
1.909 raeburn 548: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 549: var url = '/adm/pickcourse?';
1.895 raeburn 550: var formid = getFormIdByName(formname);
1.876 raeburn 551: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 552: if (domainfilter != null) {
553: if (domainfilter != '') {
554: url += 'domainfilter='+domainfilter+'&';
555: }
556: }
1.91 www 557: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 558: '&cdomelement='+udom+
559: '&cnameelement='+desc;
1.468 raeburn 560: if (extra_element !=null && extra_element != '') {
1.594 raeburn 561: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 562: url += '&roleelement='+extra_element;
563: if (domainfilter == null || domainfilter == '') {
564: url += '&domainfilter='+extra_element;
565: }
1.234 raeburn 566: }
1.468 raeburn 567: else {
568: if (formname == 'portform') {
569: url += '&setroles='+extra_element;
1.800 raeburn 570: } else {
571: if (formname == 'rules') {
572: url += '&fixeddom='+extra_element;
573: }
1.468 raeburn 574: }
575: }
1.230 raeburn 576: }
1.909 raeburn 577: if (type != null && type != '') {
578: url += '&type='+type;
579: }
580: if (type_elem != null && type_elem != '') {
581: url += '&typeelement='+type_elem;
582: }
1.872 raeburn 583: if (formname == 'ccrs') {
584: var ownername = document.forms[formid].ccuname.value;
585: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
586: url += '&cloner='+ownername+':'+ownerdom;
587: }
1.293 raeburn 588: if (multflag !=null && multflag != '') {
589: url += '&multiple='+multflag;
590: }
1.909 raeburn 591: var title = '$wintitle';
1.91 www 592: var options = 'scrollbars=1,resizable=1,menubar=0';
593: options += ',width=700,height=600';
594: stdeditbrowser = open(url,title,options,'1');
595: stdeditbrowser.focus();
596: }
1.876 raeburn 597: $id_functions
598: ENDSTDBRW
1.1075.2.31 raeburn 599: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
600: $output .= &setsec_javascript($sec_element,$formname,$role_element,
601: $credits_element);
1.876 raeburn 602: }
603: $output .= '
604: // ]]>
605: </script>';
606: return $output;
607: }
608:
609: sub javascript_index_functions {
610: return <<"ENDJS";
611:
612: function getFormIdByName(formname) {
613: for (var i=0;i<document.forms.length;i++) {
614: if (document.forms[i].name == formname) {
615: return i;
616: }
617: }
618: return -1;
619: }
620:
621: function getIndexByName(formid,item) {
622: for (var i=0;i<document.forms[formid].elements.length;i++) {
623: if (document.forms[formid].elements[i].name == item) {
624: return i;
625: }
626: }
627: return -1;
628: }
1.468 raeburn 629:
1.876 raeburn 630: function getDomainFromSelectbox(formname,udom) {
631: var userdom;
632: var formid = getFormIdByName(formname);
633: if (formid > -1) {
634: var domid = getIndexByName(formid,udom);
635: if (domid > -1) {
636: if (document.forms[formid].elements[domid].type == 'select-one') {
637: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
638: }
639: if (document.forms[formid].elements[domid].type == 'hidden') {
640: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 641: }
642: }
643: }
1.876 raeburn 644: return userdom;
645: }
646:
647: ENDJS
1.468 raeburn 648:
1.876 raeburn 649: }
650:
1.1017 raeburn 651: sub javascript_array_indexof {
1.1018 raeburn 652: return <<ENDJS;
1.1017 raeburn 653: <script type="text/javascript" language="JavaScript">
654: // <![CDATA[
655:
656: if (!Array.prototype.indexOf) {
657: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
658: "use strict";
659: if (this === void 0 || this === null) {
660: throw new TypeError();
661: }
662: var t = Object(this);
663: var len = t.length >>> 0;
664: if (len === 0) {
665: return -1;
666: }
667: var n = 0;
668: if (arguments.length > 0) {
669: n = Number(arguments[1]);
670: if (n !== n) { // shortcut for verifying if it's NaN
671: n = 0;
672: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
673: n = (n > 0 || -1) * Math.floor(Math.abs(n));
674: }
675: }
676: if (n >= len) {
677: return -1;
678: }
679: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
680: for (; k < len; k++) {
681: if (k in t && t[k] === searchElement) {
682: return k;
683: }
684: }
685: return -1;
686: }
687: }
688:
689: // ]]>
690: </script>
691:
692: ENDJS
693:
694: }
695:
1.876 raeburn 696: sub userbrowser_javascript {
697: my $id_functions = &javascript_index_functions();
698: return <<"ENDUSERBRW";
699:
1.888 raeburn 700: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 701: var url = '/adm/pickuser?';
702: var userdom = getDomainFromSelectbox(formname,udom);
703: if (userdom != null) {
704: if (userdom != '') {
705: url += 'srchdom='+userdom+'&';
706: }
707: }
708: url += 'form=' + formname + '&unameelement='+uname+
709: '&udomelement='+udom+
710: '&ulastelement='+ulast+
711: '&ufirstelement='+ufirst+
712: '&uemailelement='+uemail+
1.881 raeburn 713: '&hideudomelement='+hideudom+
714: '&coursedom='+crsdom;
1.888 raeburn 715: if ((caller != null) && (caller != undefined)) {
716: url += '&caller='+caller;
717: }
1.876 raeburn 718: var title = 'User_Browser';
719: var options = 'scrollbars=1,resizable=1,menubar=0';
720: options += ',width=700,height=600';
721: var stdeditbrowser = open(url,title,options,'1');
722: stdeditbrowser.focus();
723: }
724:
1.888 raeburn 725: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 726: var formid = getFormIdByName(formname);
727: if (formid > -1) {
1.888 raeburn 728: var unameid = getIndexByName(formid,uname);
1.876 raeburn 729: var domid = getIndexByName(formid,udom);
730: var hidedomid = getIndexByName(formid,origdom);
731: if (hidedomid > -1) {
732: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 733: var unameval = document.forms[formid].elements[unameid].value;
734: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
735: if (domid > -1) {
736: var slct = document.forms[formid].elements[domid];
737: if (slct.type == 'select-one') {
738: var i;
739: for (i=0;i<slct.length;i++) {
740: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
741: }
742: }
743: if (slct.type == 'hidden') {
744: slct.value = fixeddom;
1.876 raeburn 745: }
746: }
1.468 raeburn 747: }
748: }
749: }
1.876 raeburn 750: return;
751: }
752:
753: $id_functions
754: ENDUSERBRW
1.468 raeburn 755: }
756:
757: sub setsec_javascript {
1.1075.2.31 raeburn 758: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 759: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
760: $communityrolestr);
761: if ($role_element ne '') {
762: my @allroles = ('st','ta','ep','in','ad');
763: foreach my $crstype ('Course','Community') {
764: if ($crstype eq 'Community') {
765: foreach my $role (@allroles) {
766: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
767: }
768: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
769: } else {
770: foreach my $role (@allroles) {
771: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
772: }
773: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
774: }
775: }
776: $rolestr = '"'.join('","',@allroles).'"';
777: $courserolestr = '"'.join('","',@courserolenames).'"';
778: $communityrolestr = '"'.join('","',@communityrolenames).'"';
779: }
1.468 raeburn 780: my $setsections = qq|
781: function setSect(sectionlist) {
1.629 raeburn 782: var sectionsArray = new Array();
783: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
784: sectionsArray = sectionlist.split(",");
785: }
1.468 raeburn 786: var numSections = sectionsArray.length;
787: document.$formname.$sec_element.length = 0;
788: if (numSections == 0) {
789: document.$formname.$sec_element.multiple=false;
790: document.$formname.$sec_element.size=1;
791: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
792: } else {
793: if (numSections == 1) {
794: document.$formname.$sec_element.multiple=false;
795: document.$formname.$sec_element.size=1;
796: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
797: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
798: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
799: } else {
800: for (var i=0; i<numSections; i++) {
801: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
802: }
803: document.$formname.$sec_element.multiple=true
804: if (numSections < 3) {
805: document.$formname.$sec_element.size=numSections;
806: } else {
807: document.$formname.$sec_element.size=3;
808: }
809: document.$formname.$sec_element.options[0].selected = false
810: }
811: }
1.91 www 812: }
1.905 raeburn 813:
814: function setRole(crstype) {
1.468 raeburn 815: |;
1.905 raeburn 816: if ($role_element eq '') {
817: $setsections .= ' return;
818: }
819: ';
820: } else {
821: $setsections .= qq|
822: var elementLength = document.$formname.$role_element.length;
823: var allroles = Array($rolestr);
824: var courserolenames = Array($courserolestr);
825: var communityrolenames = Array($communityrolestr);
826: if (elementLength != undefined) {
827: if (document.$formname.$role_element.options[5].value == 'cc') {
828: if (crstype == 'Course') {
829: return;
830: } else {
831: allroles[5] = 'co';
832: for (var i=0; i<6; i++) {
833: document.$formname.$role_element.options[i].value = allroles[i];
834: document.$formname.$role_element.options[i].text = communityrolenames[i];
835: }
836: }
837: } else {
838: if (crstype == 'Community') {
839: return;
840: } else {
841: allroles[5] = 'cc';
842: for (var i=0; i<6; i++) {
843: document.$formname.$role_element.options[i].value = allroles[i];
844: document.$formname.$role_element.options[i].text = courserolenames[i];
845: }
846: }
847: }
848: }
849: return;
850: }
851: |;
852: }
1.1075.2.31 raeburn 853: if ($credits_element) {
854: $setsections .= qq|
855: function setCredits(defaultcredits) {
856: document.$formname.$credits_element.value = defaultcredits;
857: return;
858: }
859: |;
860: }
1.468 raeburn 861: return $setsections;
862: }
863:
1.91 www 864: sub selectcourse_link {
1.909 raeburn 865: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
866: $typeelement) = @_;
867: my $type = $selecttype;
1.871 raeburn 868: my $linktext = &mt('Select Course');
869: if ($selecttype eq 'Community') {
1.909 raeburn 870: $linktext = &mt('Select Community');
1.906 raeburn 871: } elsif ($selecttype eq 'Course/Community') {
872: $linktext = &mt('Select Course/Community');
1.909 raeburn 873: $type = '';
1.1019 raeburn 874: } elsif ($selecttype eq 'Select') {
875: $linktext = &mt('Select');
876: $type = '';
1.871 raeburn 877: }
1.787 bisitz 878: return '<span class="LC_nobreak">'
879: ."<a href='"
880: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
881: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 882: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 883: ."'>".$linktext.'</a>'
1.787 bisitz 884: .'</span>';
1.74 www 885: }
1.42 matthew 886:
1.653 raeburn 887: sub selectauthor_link {
888: my ($form,$udom)=@_;
889: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
890: &mt('Select Author').'</a>';
891: }
892:
1.876 raeburn 893: sub selectuser_link {
1.881 raeburn 894: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 895: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 896: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 897: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 898: ');">'.$linktext.'</a>';
1.876 raeburn 899: }
900:
1.273 raeburn 901: sub check_uncheck_jscript {
902: my $jscript = <<"ENDSCRT";
903: function checkAll(field) {
904: if (field.length > 0) {
905: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 906: if (!field[i].disabled) {
907: field[i].checked = true;
908: }
1.273 raeburn 909: }
910: } else {
1.1075.2.14 raeburn 911: if (!field.disabled) {
912: field.checked = true;
913: }
1.273 raeburn 914: }
915: }
916:
917: function uncheckAll(field) {
918: if (field.length > 0) {
919: for (i = 0; i < field.length; i++) {
920: field[i].checked = false ;
1.543 albertel 921: }
922: } else {
1.273 raeburn 923: field.checked = false ;
924: }
925: }
926: ENDSCRT
927: return $jscript;
928: }
929:
1.656 www 930: sub select_timezone {
1.659 raeburn 931: my ($name,$selected,$onchange,$includeempty)=@_;
932: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
933: if ($includeempty) {
934: $output .= '<option value=""';
935: if (($selected eq '') || ($selected eq 'local')) {
936: $output .= ' selected="selected" ';
937: }
938: $output .= '> </option>';
939: }
1.657 raeburn 940: my @timezones = DateTime::TimeZone->all_names;
941: foreach my $tzone (@timezones) {
942: $output.= '<option value="'.$tzone.'"';
943: if ($tzone eq $selected) {
944: $output.=' selected="selected"';
945: }
946: $output.=">$tzone</option>\n";
1.656 www 947: }
948: $output.="</select>";
949: return $output;
950: }
1.273 raeburn 951:
1.687 raeburn 952: sub select_datelocale {
953: my ($name,$selected,$onchange,$includeempty)=@_;
954: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
955: if ($includeempty) {
956: $output .= '<option value=""';
957: if ($selected eq '') {
958: $output .= ' selected="selected" ';
959: }
960: $output .= '> </option>';
961: }
962: my (@possibles,%locale_names);
963: my @locales = DateTime::Locale::Catalog::Locales;
964: foreach my $locale (@locales) {
965: if (ref($locale) eq 'HASH') {
966: my $id = $locale->{'id'};
967: if ($id ne '') {
968: my $en_terr = $locale->{'en_territory'};
969: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 970: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 971: if (grep(/^en$/,@languages) || !@languages) {
972: if ($en_terr ne '') {
973: $locale_names{$id} = '('.$en_terr.')';
974: } elsif ($native_terr ne '') {
975: $locale_names{$id} = $native_terr;
976: }
977: } else {
978: if ($native_terr ne '') {
979: $locale_names{$id} = $native_terr.' ';
980: } elsif ($en_terr ne '') {
981: $locale_names{$id} = '('.$en_terr.')';
982: }
983: }
1.1075.2.94! raeburn 984: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.687 raeburn 985: push (@possibles,$id);
986: }
987: }
988: }
989: foreach my $item (sort(@possibles)) {
990: $output.= '<option value="'.$item.'"';
991: if ($item eq $selected) {
992: $output.=' selected="selected"';
993: }
994: $output.=">$item";
995: if ($locale_names{$item} ne '') {
1.1075.2.94! raeburn 996: $output.=' '.$locale_names{$item};
1.687 raeburn 997: }
998: $output.="</option>\n";
999: }
1000: $output.="</select>";
1001: return $output;
1002: }
1003:
1.792 raeburn 1004: sub select_language {
1005: my ($name,$selected,$includeempty) = @_;
1006: my %langchoices;
1007: if ($includeempty) {
1.1075.2.32 raeburn 1008: %langchoices = ('' => 'No language preference');
1.792 raeburn 1009: }
1010: foreach my $id (&languageids()) {
1011: my $code = &supportedlanguagecode($id);
1012: if ($code) {
1013: $langchoices{$code} = &plainlanguagedescription($id);
1014: }
1015: }
1.1075.2.32 raeburn 1016: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1017: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1018: }
1019:
1.42 matthew 1020: =pod
1.36 matthew 1021:
1.648 raeburn 1022: =item * &linked_select_forms(...)
1.36 matthew 1023:
1024: linked_select_forms returns a string containing a <script></script> block
1025: and html for two <select> menus. The select menus will be linked in that
1026: changing the value of the first menu will result in new values being placed
1027: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1028: order unless a defined order is provided.
1.36 matthew 1029:
1030: linked_select_forms takes the following ordered inputs:
1031:
1032: =over 4
1033:
1.112 bowersj2 1034: =item * $formname, the name of the <form> tag
1.36 matthew 1035:
1.112 bowersj2 1036: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1037:
1.112 bowersj2 1038: =item * $firstdefault, the default value for the first menu
1.36 matthew 1039:
1.112 bowersj2 1040: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1041:
1.112 bowersj2 1042: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1043:
1.112 bowersj2 1044: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1045:
1.609 raeburn 1046: =item * $menuorder, the order of values in the first menu
1047:
1.1075.2.31 raeburn 1048: =item * $onchangefirst, additional javascript call to execute for an onchange
1049: event for the first <select> tag
1050:
1051: =item * $onchangesecond, additional javascript call to execute for an onchange
1052: event for the second <select> tag
1053:
1.41 ng 1054: =back
1055:
1.36 matthew 1056: Below is an example of such a hash. Only the 'text', 'default', and
1057: 'select2' keys must appear as stated. keys(%menu) are the possible
1058: values for the first select menu. The text that coincides with the
1.41 ng 1059: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1060: and text for the second menu are given in the hash pointed to by
1061: $menu{$choice1}->{'select2'}.
1062:
1.112 bowersj2 1063: my %menu = ( A1 => { text =>"Choice A1" ,
1064: default => "B3",
1065: select2 => {
1066: B1 => "Choice B1",
1067: B2 => "Choice B2",
1068: B3 => "Choice B3",
1069: B4 => "Choice B4"
1.609 raeburn 1070: },
1071: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1072: },
1073: A2 => { text =>"Choice A2" ,
1074: default => "C2",
1075: select2 => {
1076: C1 => "Choice C1",
1077: C2 => "Choice C2",
1078: C3 => "Choice C3"
1.609 raeburn 1079: },
1080: order => ['C2','C1','C3'],
1.112 bowersj2 1081: },
1082: A3 => { text =>"Choice A3" ,
1083: default => "D6",
1084: select2 => {
1085: D1 => "Choice D1",
1086: D2 => "Choice D2",
1087: D3 => "Choice D3",
1088: D4 => "Choice D4",
1089: D5 => "Choice D5",
1090: D6 => "Choice D6",
1091: D7 => "Choice D7"
1.609 raeburn 1092: },
1093: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1094: }
1095: );
1.36 matthew 1096:
1097: =cut
1098:
1099: sub linked_select_forms {
1100: my ($formname,
1101: $middletext,
1102: $firstdefault,
1103: $firstselectname,
1104: $secondselectname,
1.609 raeburn 1105: $hashref,
1106: $menuorder,
1.1075.2.31 raeburn 1107: $onchangefirst,
1108: $onchangesecond
1.36 matthew 1109: ) = @_;
1110: my $second = "document.$formname.$secondselectname";
1111: my $first = "document.$formname.$firstselectname";
1112: # output the javascript to do the changing
1113: my $result = '';
1.776 bisitz 1114: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1115: $result.="// <![CDATA[\n";
1.36 matthew 1116: $result.="var select2data = new Object();\n";
1117: $" = '","';
1118: my $debug = '';
1119: foreach my $s1 (sort(keys(%$hashref))) {
1120: $result.="select2data.d_$s1 = new Object();\n";
1121: $result.="select2data.d_$s1.def = new String('".
1122: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1123: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1124: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1125: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1126: @s2values = @{$hashref->{$s1}->{'order'}};
1127: }
1.36 matthew 1128: $result.="\"@s2values\");\n";
1129: $result.="select2data.d_$s1.texts = new Array(";
1130: my @s2texts;
1131: foreach my $value (@s2values) {
1132: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1133: }
1134: $result.="\"@s2texts\");\n";
1135: }
1136: $"=' ';
1137: $result.= <<"END";
1138:
1139: function select1_changed() {
1140: // Determine new choice
1141: var newvalue = "d_" + $first.value;
1142: // update select2
1143: var values = select2data[newvalue].values;
1144: var texts = select2data[newvalue].texts;
1145: var select2def = select2data[newvalue].def;
1146: var i;
1147: // out with the old
1148: for (i = 0; i < $second.options.length; i++) {
1149: $second.options[i] = null;
1150: }
1151: // in with the nuclear
1152: for (i=0;i<values.length; i++) {
1153: $second.options[i] = new Option(values[i]);
1.143 matthew 1154: $second.options[i].value = values[i];
1.36 matthew 1155: $second.options[i].text = texts[i];
1156: if (values[i] == select2def) {
1157: $second.options[i].selected = true;
1158: }
1159: }
1160: }
1.824 bisitz 1161: // ]]>
1.36 matthew 1162: </script>
1163: END
1164: # output the initial values for the selection lists
1.1075.2.31 raeburn 1165: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1166: my @order = sort(keys(%{$hashref}));
1167: if (ref($menuorder) eq 'ARRAY') {
1168: @order = @{$menuorder};
1169: }
1170: foreach my $value (@order) {
1.36 matthew 1171: $result.=" <option value=\"$value\" ";
1.253 albertel 1172: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1173: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1174: }
1175: $result .= "</select>\n";
1176: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1177: $result .= $middletext;
1.1075.2.31 raeburn 1178: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1179: if ($onchangesecond) {
1180: $result .= ' onchange="'.$onchangesecond.'"';
1181: }
1182: $result .= ">\n";
1.36 matthew 1183: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1184:
1185: my @secondorder = sort(keys(%select2));
1186: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1187: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1188: }
1189: foreach my $value (@secondorder) {
1.36 matthew 1190: $result.=" <option value=\"$value\" ";
1.253 albertel 1191: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1192: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1193: }
1194: $result .= "</select>\n";
1195: # return $debug;
1196: return $result;
1197: } # end of sub linked_select_forms {
1198:
1.45 matthew 1199: =pod
1.44 bowersj2 1200:
1.973 raeburn 1201: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1202:
1.112 bowersj2 1203: Returns a string corresponding to an HTML link to the given help
1204: $topic, where $topic corresponds to the name of a .tex file in
1205: /home/httpd/html/adm/help/tex, with underscores replaced by
1206: spaces.
1207:
1208: $text will optionally be linked to the same topic, allowing you to
1209: link text in addition to the graphic. If you do not want to link
1210: text, but wish to specify one of the later parameters, pass an
1211: empty string.
1212:
1213: $stayOnPage is a value that will be interpreted as a boolean. If true,
1214: the link will not open a new window. If false, the link will open
1215: a new window using Javascript. (Default is false.)
1216:
1217: $width and $height are optional numerical parameters that will
1218: override the width and height of the popped up window, which may
1.973 raeburn 1219: be useful for certain help topics with big pictures included.
1220:
1221: $imgid is the id of the img tag used for the help icon. This may be
1222: used in a javascript call to switch the image src. See
1223: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1224:
1225: =cut
1226:
1227: sub help_open_topic {
1.973 raeburn 1228: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1229: $text = "" if (not defined $text);
1.44 bowersj2 1230: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1231: $width = 500 if (not defined $width);
1.44 bowersj2 1232: $height = 400 if (not defined $height);
1233: my $filename = $topic;
1234: $filename =~ s/ /_/g;
1235:
1.48 bowersj2 1236: my $template = "";
1237: my $link;
1.572 banghart 1238:
1.159 www 1239: $topic=~s/\W/\_/g;
1.44 bowersj2 1240:
1.572 banghart 1241: if (!$stayOnPage) {
1.1075.2.50 raeburn 1242: if ($env{'browser.mobile'}) {
1243: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1244: } else {
1245: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1246: }
1.1037 www 1247: } elsif ($stayOnPage eq 'popup') {
1248: $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 1249: } else {
1.48 bowersj2 1250: $link = "/adm/help/${filename}.hlp";
1251: }
1252:
1253: # Add the text
1.755 neumanie 1254: if ($text ne "") {
1.763 bisitz 1255: $template.='<span class="LC_help_open_topic">'
1256: .'<a target="_top" href="'.$link.'">'
1257: .$text.'</a>';
1.48 bowersj2 1258: }
1259:
1.763 bisitz 1260: # (Always) Add the graphic
1.179 matthew 1261: my $title = &mt('Online Help');
1.667 raeburn 1262: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1263: if ($imgid ne '') {
1264: $imgid = ' id="'.$imgid.'"';
1265: }
1.763 bisitz 1266: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1267: .'<img src="'.$helpicon.'" border="0"'
1268: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1269: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1270: .' /></a>';
1271: if ($text ne "") {
1272: $template.='</span>';
1273: }
1.44 bowersj2 1274: return $template;
1275:
1.106 bowersj2 1276: }
1277:
1278: # This is a quicky function for Latex cheatsheet editing, since it
1279: # appears in at least four places
1280: sub helpLatexCheatsheet {
1.1037 www 1281: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1282: my $out;
1.106 bowersj2 1283: my $addOther = '';
1.732 raeburn 1284: if ($topic) {
1.1037 www 1285: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1286: }
1287: $out = '<span>' # Start cheatsheet
1288: .$addOther
1289: .'<span>'
1.1037 www 1290: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1291: .'</span> <span>'
1.1037 www 1292: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1293: .'</span>';
1.732 raeburn 1294: unless ($not_author) {
1.763 bisitz 1295: $out .= ' <span>'
1.1037 www 1296: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1297: .'</span> <span>'
1.1075.2.78 raeburn 1298: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1299: .'</span>';
1.732 raeburn 1300: }
1.763 bisitz 1301: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1302: return $out;
1.172 www 1303: }
1304:
1.430 albertel 1305: sub general_help {
1306: my $helptopic='Student_Intro';
1307: if ($env{'request.role'}=~/^(ca|au)/) {
1308: $helptopic='Authoring_Intro';
1.907 raeburn 1309: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1310: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1311: } elsif ($env{'request.role'}=~/^dc/) {
1312: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1313: }
1314: return $helptopic;
1315: }
1316:
1317: sub update_help_link {
1318: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1319: my $origurl = $ENV{'REQUEST_URI'};
1320: $origurl=~s|^/~|/priv/|;
1321: my $timestamp = time;
1322: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1323: $$datum = &escape($$datum);
1324: }
1325:
1326: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1327: my $output .= <<"ENDOUTPUT";
1328: <script type="text/javascript">
1.824 bisitz 1329: // <![CDATA[
1.430 albertel 1330: banner_link = '$banner_link';
1.824 bisitz 1331: // ]]>
1.430 albertel 1332: </script>
1333: ENDOUTPUT
1334: return $output;
1335: }
1336:
1337: # now just updates the help link and generates a blue icon
1.193 raeburn 1338: sub help_open_menu {
1.430 albertel 1339: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1340: = @_;
1.949 droeschl 1341: $stayOnPage = 1;
1.430 albertel 1342: my $output;
1343: if ($component_help) {
1344: if (!$text) {
1345: $output=&help_open_topic($component_help,undef,$stayOnPage,
1346: $width,$height);
1347: } else {
1348: my $help_text;
1349: $help_text=&unescape($topic);
1350: $output='<table><tr><td>'.
1351: &help_open_topic($component_help,$help_text,$stayOnPage,
1352: $width,$height).'</td></tr></table>';
1353: }
1354: }
1355: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1356: return $output.$banner_link;
1357: }
1358:
1359: sub top_nav_help {
1360: my ($text) = @_;
1.436 albertel 1361: $text = &mt($text);
1.1075.2.60 raeburn 1362: my $stay_on_page;
1363: unless ($env{'environment.remote'} eq 'on') {
1364: $stay_on_page = 1;
1365: }
1.1075.2.61 raeburn 1366: my ($link,$banner_link);
1367: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1368: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1369: : "javascript:helpMenu('open')";
1370: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1371: }
1.201 raeburn 1372: my $title = &mt('Get help');
1.1075.2.61 raeburn 1373: if ($link) {
1374: return <<"END";
1.436 albertel 1375: $banner_link
1.1075.2.56 raeburn 1376: <a href="$link" title="$title">$text</a>
1.436 albertel 1377: END
1.1075.2.61 raeburn 1378: } else {
1379: return ' '.$text.' ';
1380: }
1.436 albertel 1381: }
1382:
1383: sub help_menu_js {
1.1075.2.52 raeburn 1384: my ($httphost) = @_;
1.949 droeschl 1385: my $stayOnPage = 1;
1.436 albertel 1386: my $width = 620;
1387: my $height = 600;
1.430 albertel 1388: my $helptopic=&general_help();
1.1075.2.52 raeburn 1389: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1390: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1391: my $start_page =
1392: &Apache::loncommon::start_page('Help Menu', undef,
1393: {'frameset' => 1,
1394: 'js_ready' => 1,
1.1075.2.52 raeburn 1395: 'use_absolute' => $httphost,
1.331 albertel 1396: 'add_entries' => {
1397: 'border' => '0',
1.579 raeburn 1398: 'rows' => "110,*",},});
1.331 albertel 1399: my $end_page =
1400: &Apache::loncommon::end_page({'frameset' => 1,
1401: 'js_ready' => 1,});
1402:
1.436 albertel 1403: my $template .= <<"ENDTEMPLATE";
1404: <script type="text/javascript">
1.877 bisitz 1405: // <![CDATA[
1.253 albertel 1406: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1407: var banner_link = '';
1.243 raeburn 1408: function helpMenu(target) {
1409: var caller = this;
1410: if (target == 'open') {
1411: var newWindow = null;
1412: try {
1.262 albertel 1413: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1414: }
1415: catch(error) {
1416: writeHelp(caller);
1417: return;
1418: }
1419: if (newWindow) {
1420: caller = newWindow;
1421: }
1.193 raeburn 1422: }
1.243 raeburn 1423: writeHelp(caller);
1424: return;
1425: }
1426: function writeHelp(caller) {
1.1075.2.61 raeburn 1427: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1428: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1429: caller.document.close();
1430: caller.focus();
1.193 raeburn 1431: }
1.877 bisitz 1432: // END LON-CAPA Internal -->
1.253 albertel 1433: // ]]>
1.436 albertel 1434: </script>
1.193 raeburn 1435: ENDTEMPLATE
1436: return $template;
1437: }
1438:
1.172 www 1439: sub help_open_bug {
1440: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1441: unless ($env{'user.adv'}) { return ''; }
1.172 www 1442: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1443: $text = "" if (not defined $text);
1444: $stayOnPage=1;
1.184 albertel 1445: $width = 600 if (not defined $width);
1446: $height = 600 if (not defined $height);
1.172 www 1447:
1448: $topic=~s/\W+/\+/g;
1449: my $link='';
1450: my $template='';
1.379 albertel 1451: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1452: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1453: if (!$stayOnPage)
1454: {
1455: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1456: }
1457: else
1458: {
1459: $link = $url;
1460: }
1461: # Add the text
1462: if ($text ne "")
1463: {
1464: $template .=
1465: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1466: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1467: }
1468:
1469: # Add the graphic
1.179 matthew 1470: my $title = &mt('Report a Bug');
1.215 albertel 1471: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1472: $template .= <<"ENDTEMPLATE";
1.436 albertel 1473: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1474: ENDTEMPLATE
1475: if ($text ne '') { $template.='</td></tr></table>' };
1476: return $template;
1477:
1478: }
1479:
1480: sub help_open_faq {
1481: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1482: unless ($env{'user.adv'}) { return ''; }
1.172 www 1483: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1484: $text = "" if (not defined $text);
1485: $stayOnPage=1;
1486: $width = 350 if (not defined $width);
1487: $height = 400 if (not defined $height);
1488:
1489: $topic=~s/\W+/\+/g;
1490: my $link='';
1491: my $template='';
1492: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1493: if (!$stayOnPage)
1494: {
1495: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1496: }
1497: else
1498: {
1499: $link = $url;
1500: }
1501:
1502: # Add the text
1503: if ($text ne "")
1504: {
1505: $template .=
1.173 www 1506: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1507: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1508: }
1509:
1510: # Add the graphic
1.179 matthew 1511: my $title = &mt('View the FAQ');
1.215 albertel 1512: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1513: $template .= <<"ENDTEMPLATE";
1.436 albertel 1514: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1515: ENDTEMPLATE
1516: if ($text ne '') { $template.='</td></tr></table>' };
1517: return $template;
1518:
1.44 bowersj2 1519: }
1.37 matthew 1520:
1.180 matthew 1521: ###############################################################
1522: ###############################################################
1523:
1.45 matthew 1524: =pod
1525:
1.648 raeburn 1526: =item * &change_content_javascript():
1.256 matthew 1527:
1528: This and the next function allow you to create small sections of an
1529: otherwise static HTML page that you can update on the fly with
1530: Javascript, even in Netscape 4.
1531:
1532: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1533: must be written to the HTML page once. It will prove the Javascript
1534: function "change(name, content)". Calling the change function with the
1535: name of the section
1536: you want to update, matching the name passed to C<changable_area>, and
1537: the new content you want to put in there, will put the content into
1538: that area.
1539:
1540: B<Note>: Netscape 4 only reserves enough space for the changable area
1541: to contain room for the original contents. You need to "make space"
1542: for whatever changes you wish to make, and be B<sure> to check your
1543: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1544: it's adequate for updating a one-line status display, but little more.
1545: This script will set the space to 100% width, so you only need to
1546: worry about height in Netscape 4.
1547:
1548: Modern browsers are much less limiting, and if you can commit to the
1549: user not using Netscape 4, this feature may be used freely with
1550: pretty much any HTML.
1551:
1552: =cut
1553:
1554: sub change_content_javascript {
1555: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1556: if ($env{'browser.type'} eq 'netscape' &&
1557: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1558: return (<<NETSCAPE4);
1559: function change(name, content) {
1560: doc = document.layers[name+"___escape"].layers[0].document;
1561: doc.open();
1562: doc.write(content);
1563: doc.close();
1564: }
1565: NETSCAPE4
1566: } else {
1567: # Otherwise, we need to use semi-standards-compliant code
1568: # (technically, "innerHTML" isn't standard but the equivalent
1569: # is really scary, and every useful browser supports it
1570: return (<<DOMBASED);
1571: function change(name, content) {
1572: element = document.getElementById(name);
1573: element.innerHTML = content;
1574: }
1575: DOMBASED
1576: }
1577: }
1578:
1579: =pod
1580:
1.648 raeburn 1581: =item * &changable_area($name,$origContent):
1.256 matthew 1582:
1583: This provides a "changable area" that can be modified on the fly via
1584: the Javascript code provided in C<change_content_javascript>. $name is
1585: the name you will use to reference the area later; do not repeat the
1586: same name on a given HTML page more then once. $origContent is what
1587: the area will originally contain, which can be left blank.
1588:
1589: =cut
1590:
1591: sub changable_area {
1592: my ($name, $origContent) = @_;
1593:
1.258 albertel 1594: if ($env{'browser.type'} eq 'netscape' &&
1595: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1596: # If this is netscape 4, we need to use the Layer tag
1597: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1598: } else {
1599: return "<span id='$name'>$origContent</span>";
1600: }
1601: }
1602:
1603: =pod
1604:
1.648 raeburn 1605: =item * &viewport_geometry_js
1.590 raeburn 1606:
1607: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1608:
1609: =cut
1610:
1611:
1612: sub viewport_geometry_js {
1613: return <<"GEOMETRY";
1614: var Geometry = {};
1615: function init_geometry() {
1616: if (Geometry.init) { return };
1617: Geometry.init=1;
1618: if (window.innerHeight) {
1619: Geometry.getViewportHeight = function() { return window.innerHeight; };
1620: Geometry.getViewportWidth = function() { return window.innerWidth; };
1621: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1622: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1623: }
1624: else if (document.documentElement && document.documentElement.clientHeight) {
1625: Geometry.getViewportHeight =
1626: function() { return document.documentElement.clientHeight; };
1627: Geometry.getViewportWidth =
1628: function() { return document.documentElement.clientWidth; };
1629:
1630: Geometry.getHorizontalScroll =
1631: function() { return document.documentElement.scrollLeft; };
1632: Geometry.getVerticalScroll =
1633: function() { return document.documentElement.scrollTop; };
1634: }
1635: else if (document.body.clientHeight) {
1636: Geometry.getViewportHeight =
1637: function() { return document.body.clientHeight; };
1638: Geometry.getViewportWidth =
1639: function() { return document.body.clientWidth; };
1640: Geometry.getHorizontalScroll =
1641: function() { return document.body.scrollLeft; };
1642: Geometry.getVerticalScroll =
1643: function() { return document.body.scrollTop; };
1644: }
1645: }
1646:
1647: GEOMETRY
1648: }
1649:
1650: =pod
1651:
1.648 raeburn 1652: =item * &viewport_size_js()
1.590 raeburn 1653:
1654: 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.
1655:
1656: =cut
1657:
1658: sub viewport_size_js {
1659: my $geometry = &viewport_geometry_js();
1660: return <<"DIMS";
1661:
1662: $geometry
1663:
1664: function getViewportDims(width,height) {
1665: init_geometry();
1666: width.value = Geometry.getViewportWidth();
1667: height.value = Geometry.getViewportHeight();
1668: return;
1669: }
1670:
1671: DIMS
1672: }
1673:
1674: =pod
1675:
1.648 raeburn 1676: =item * &resize_textarea_js()
1.565 albertel 1677:
1678: emits the needed javascript to resize a textarea to be as big as possible
1679:
1680: creates a function resize_textrea that takes two IDs first should be
1681: the id of the element to resize, second should be the id of a div that
1682: surrounds everything that comes after the textarea, this routine needs
1683: to be attached to the <body> for the onload and onresize events.
1684:
1.648 raeburn 1685: =back
1.565 albertel 1686:
1687: =cut
1688:
1689: sub resize_textarea_js {
1.590 raeburn 1690: my $geometry = &viewport_geometry_js();
1.565 albertel 1691: return <<"RESIZE";
1692: <script type="text/javascript">
1.824 bisitz 1693: // <![CDATA[
1.590 raeburn 1694: $geometry
1.565 albertel 1695:
1.588 albertel 1696: function getX(element) {
1697: var x = 0;
1698: while (element) {
1699: x += element.offsetLeft;
1700: element = element.offsetParent;
1701: }
1702: return x;
1703: }
1704: function getY(element) {
1705: var y = 0;
1706: while (element) {
1707: y += element.offsetTop;
1708: element = element.offsetParent;
1709: }
1710: return y;
1711: }
1712:
1713:
1.565 albertel 1714: function resize_textarea(textarea_id,bottom_id) {
1715: init_geometry();
1716: var textarea = document.getElementById(textarea_id);
1717: //alert(textarea);
1718:
1.588 albertel 1719: var textarea_top = getY(textarea);
1.565 albertel 1720: var textarea_height = textarea.offsetHeight;
1721: var bottom = document.getElementById(bottom_id);
1.588 albertel 1722: var bottom_top = getY(bottom);
1.565 albertel 1723: var bottom_height = bottom.offsetHeight;
1724: var window_height = Geometry.getViewportHeight();
1.588 albertel 1725: var fudge = 23;
1.565 albertel 1726: var new_height = window_height-fudge-textarea_top-bottom_height;
1727: if (new_height < 300) {
1728: new_height = 300;
1729: }
1730: textarea.style.height=new_height+'px';
1731: }
1.824 bisitz 1732: // ]]>
1.565 albertel 1733: </script>
1734: RESIZE
1735:
1736: }
1737:
1738: =pod
1739:
1.256 matthew 1740: =head1 Excel and CSV file utility routines
1741:
1742: =cut
1743:
1744: ###############################################################
1745: ###############################################################
1746:
1747: =pod
1748:
1.1075.2.56 raeburn 1749: =over 4
1750:
1.648 raeburn 1751: =item * &csv_translate($text)
1.37 matthew 1752:
1.185 www 1753: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1754: format.
1755:
1756: =cut
1757:
1.180 matthew 1758: ###############################################################
1759: ###############################################################
1.37 matthew 1760: sub csv_translate {
1761: my $text = shift;
1762: $text =~ s/\"/\"\"/g;
1.209 albertel 1763: $text =~ s/\n/ /g;
1.37 matthew 1764: return $text;
1765: }
1.180 matthew 1766:
1767: ###############################################################
1768: ###############################################################
1769:
1770: =pod
1771:
1.648 raeburn 1772: =item * &define_excel_formats()
1.180 matthew 1773:
1774: Define some commonly used Excel cell formats.
1775:
1776: Currently supported formats:
1777:
1778: =over 4
1779:
1780: =item header
1781:
1782: =item bold
1783:
1784: =item h1
1785:
1786: =item h2
1787:
1788: =item h3
1789:
1.256 matthew 1790: =item h4
1791:
1792: =item i
1793:
1.180 matthew 1794: =item date
1795:
1796: =back
1797:
1798: Inputs: $workbook
1799:
1800: Returns: $format, a hash reference.
1801:
1.1057 foxr 1802:
1.180 matthew 1803: =cut
1804:
1805: ###############################################################
1806: ###############################################################
1807: sub define_excel_formats {
1808: my ($workbook) = @_;
1809: my $format;
1810: $format->{'header'} = $workbook->add_format(bold => 1,
1811: bottom => 1,
1812: align => 'center');
1813: $format->{'bold'} = $workbook->add_format(bold=>1);
1814: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1815: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1816: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1817: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1818: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1819: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1820: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1821: return $format;
1822: }
1823:
1824: ###############################################################
1825: ###############################################################
1.113 bowersj2 1826:
1827: =pod
1828:
1.648 raeburn 1829: =item * &create_workbook()
1.255 matthew 1830:
1831: Create an Excel worksheet. If it fails, output message on the
1832: request object and return undefs.
1833:
1834: Inputs: Apache request object
1835:
1836: Returns (undef) on failure,
1837: Excel worksheet object, scalar with filename, and formats
1838: from &Apache::loncommon::define_excel_formats on success
1839:
1840: =cut
1841:
1842: ###############################################################
1843: ###############################################################
1844: sub create_workbook {
1845: my ($r) = @_;
1846: #
1847: # Create the excel spreadsheet
1848: my $filename = '/prtspool/'.
1.258 albertel 1849: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1850: time.'_'.rand(1000000000).'.xls';
1851: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1852: if (! defined($workbook)) {
1853: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1854: $r->print(
1855: '<p class="LC_error">'
1856: .&mt('Problems occurred in creating the new Excel file.')
1857: .' '.&mt('This error has been logged.')
1858: .' '.&mt('Please alert your LON-CAPA administrator.')
1859: .'</p>'
1860: );
1.255 matthew 1861: return (undef);
1862: }
1863: #
1.1014 foxr 1864: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1865: #
1866: my $format = &Apache::loncommon::define_excel_formats($workbook);
1867: return ($workbook,$filename,$format);
1868: }
1869:
1870: ###############################################################
1871: ###############################################################
1872:
1873: =pod
1874:
1.648 raeburn 1875: =item * &create_text_file()
1.113 bowersj2 1876:
1.542 raeburn 1877: Create a file to write to and eventually make available to the user.
1.256 matthew 1878: If file creation fails, outputs an error message on the request object and
1879: return undefs.
1.113 bowersj2 1880:
1.256 matthew 1881: Inputs: Apache request object, and file suffix
1.113 bowersj2 1882:
1.256 matthew 1883: Returns (undef) on failure,
1884: Filehandle and filename on success.
1.113 bowersj2 1885:
1886: =cut
1887:
1.256 matthew 1888: ###############################################################
1889: ###############################################################
1890: sub create_text_file {
1891: my ($r,$suffix) = @_;
1892: if (! defined($suffix)) { $suffix = 'txt'; };
1893: my $fh;
1894: my $filename = '/prtspool/'.
1.258 albertel 1895: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1896: time.'_'.rand(1000000000).'.'.$suffix;
1897: $fh = Apache::File->new('>/home/httpd'.$filename);
1898: if (! defined($fh)) {
1899: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1900: $r->print(
1901: '<p class="LC_error">'
1902: .&mt('Problems occurred in creating the output file.')
1903: .' '.&mt('This error has been logged.')
1904: .' '.&mt('Please alert your LON-CAPA administrator.')
1905: .'</p>'
1906: );
1.113 bowersj2 1907: }
1.256 matthew 1908: return ($fh,$filename)
1.113 bowersj2 1909: }
1910:
1911:
1.256 matthew 1912: =pod
1.113 bowersj2 1913:
1914: =back
1915:
1916: =cut
1.37 matthew 1917:
1918: ###############################################################
1.33 matthew 1919: ## Home server <option> list generating code ##
1920: ###############################################################
1.35 matthew 1921:
1.169 www 1922: # ------------------------------------------
1923:
1924: sub domain_select {
1925: my ($name,$value,$multiple)=@_;
1926: my %domains=map {
1.514 albertel 1927: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1928: } &Apache::lonnet::all_domains();
1.169 www 1929: if ($multiple) {
1930: $domains{''}=&mt('Any domain');
1.550 albertel 1931: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1932: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1933: } else {
1.550 albertel 1934: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1935: return &select_form($name,$value,\%domains);
1.169 www 1936: }
1937: }
1938:
1.282 albertel 1939: #-------------------------------------------
1940:
1941: =pod
1942:
1.519 raeburn 1943: =head1 Routines for form select boxes
1944:
1945: =over 4
1946:
1.648 raeburn 1947: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1948:
1949: Returns a string containing a <select> element int multiple mode
1950:
1951:
1952: Args:
1953: $name - name of the <select> element
1.506 raeburn 1954: $value - scalar or array ref of values that should already be selected
1.282 albertel 1955: $size - number of rows long the select element is
1.283 albertel 1956: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1957: (shown text should already have been &mt())
1.506 raeburn 1958: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1959:
1.282 albertel 1960: =cut
1961:
1962: #-------------------------------------------
1.169 www 1963: sub multiple_select_form {
1.284 albertel 1964: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1965: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1966: my $output='';
1.191 matthew 1967: if (! defined($size)) {
1968: $size = 4;
1.283 albertel 1969: if (scalar(keys(%$hash))<4) {
1970: $size = scalar(keys(%$hash));
1.191 matthew 1971: }
1972: }
1.734 bisitz 1973: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1974: my @order;
1.506 raeburn 1975: if (ref($order) eq 'ARRAY') {
1976: @order = @{$order};
1977: } else {
1978: @order = sort(keys(%$hash));
1.501 banghart 1979: }
1980: if (exists($$hash{'select_form_order'})) {
1981: @order = @{$$hash{'select_form_order'}};
1982: }
1983:
1.284 albertel 1984: foreach my $key (@order) {
1.356 albertel 1985: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1986: $output.='selected="selected" ' if ($selected{$key});
1987: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1988: }
1989: $output.="</select>\n";
1990: return $output;
1991: }
1992:
1.88 www 1993: #-------------------------------------------
1994:
1995: =pod
1996:
1.970 raeburn 1997: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 1998:
1999: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2000: allow a user to select options from a ref to a hash containing:
2001: option_name => displayed text. An optional $onchange can include
2002: a javascript onchange item, e.g., onchange="this.form.submit();"
2003:
1.88 www 2004: See lonrights.pm for an example invocation and use.
2005:
2006: =cut
2007:
2008: #-------------------------------------------
2009: sub select_form {
1.970 raeburn 2010: my ($def,$name,$hashref,$onchange) = @_;
2011: return unless (ref($hashref) eq 'HASH');
2012: if ($onchange) {
2013: $onchange = ' onchange="'.$onchange.'"';
2014: }
2015: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2016: my @keys;
1.970 raeburn 2017: if (exists($hashref->{'select_form_order'})) {
2018: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2019: } else {
1.970 raeburn 2020: @keys=sort(keys(%{$hashref}));
1.128 albertel 2021: }
1.356 albertel 2022: foreach my $key (@keys) {
2023: $selectform.=
2024: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2025: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2026: ">".$hashref->{$key}."</option>\n";
1.88 www 2027: }
2028: $selectform.="</select>";
2029: return $selectform;
2030: }
2031:
1.475 www 2032: # For display filters
2033:
2034: sub display_filter {
1.1074 raeburn 2035: my ($context) = @_;
1.475 www 2036: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2037: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2038: my $phraseinput = 'hidden';
2039: my $includeinput = 'hidden';
2040: my ($checked,$includetypestext);
2041: if ($env{'form.displayfilter'} eq 'containing') {
2042: $phraseinput = 'text';
2043: if ($context eq 'parmslog') {
2044: $includeinput = 'checkbox';
2045: if ($env{'form.includetypes'}) {
2046: $checked = ' checked="checked"';
2047: }
2048: $includetypestext = &mt('Include parameter types');
2049: }
2050: } else {
2051: $includetypestext = ' ';
2052: }
2053: my ($additional,$secondid,$thirdid);
2054: if ($context eq 'parmslog') {
2055: $additional =
2056: '<label><input type="'.$includeinput.'" name="includetypes"'.
2057: $checked.' name="includetypes" value="1" id="includetypes" />'.
2058: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2059: '</label>';
2060: $secondid = 'includetypes';
2061: $thirdid = 'includetypestext';
2062: }
2063: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2064: '$secondid','$thirdid')";
2065: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2066: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2067: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2068: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2069: &mt('Filter: [_1]',
1.477 www 2070: &select_form($env{'form.displayfilter'},
2071: 'displayfilter',
1.970 raeburn 2072: {'currentfolder' => 'Current folder/page',
1.477 www 2073: 'containing' => 'Containing phrase',
1.1074 raeburn 2074: 'none' => 'None'},$onchange)).' '.
2075: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2076: &HTML::Entities::encode($env{'form.containingphrase'}).
2077: '" />'.$additional;
2078: }
2079:
2080: sub display_filter_js {
2081: my $includetext = &mt('Include parameter types');
2082: return <<"ENDJS";
2083:
2084: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2085: var firstType = 'hidden';
2086: if (setter.options[setter.selectedIndex].value == 'containing') {
2087: firstType = 'text';
2088: }
2089: firstObject = document.getElementById(firstid);
2090: if (typeof(firstObject) == 'object') {
2091: if (firstObject.type != firstType) {
2092: changeInputType(firstObject,firstType);
2093: }
2094: }
2095: if (context == 'parmslog') {
2096: var secondType = 'hidden';
2097: if (firstType == 'text') {
2098: secondType = 'checkbox';
2099: }
2100: secondObject = document.getElementById(secondid);
2101: if (typeof(secondObject) == 'object') {
2102: if (secondObject.type != secondType) {
2103: changeInputType(secondObject,secondType);
2104: }
2105: }
2106: var textItem = document.getElementById(thirdid);
2107: var currtext = textItem.innerHTML;
2108: var newtext;
2109: if (firstType == 'text') {
2110: newtext = '$includetext';
2111: } else {
2112: newtext = ' ';
2113: }
2114: if (currtext != newtext) {
2115: textItem.innerHTML = newtext;
2116: }
2117: }
2118: return;
2119: }
2120:
2121: function changeInputType(oldObject,newType) {
2122: var newObject = document.createElement('input');
2123: newObject.type = newType;
2124: if (oldObject.size) {
2125: newObject.size = oldObject.size;
2126: }
2127: if (oldObject.value) {
2128: newObject.value = oldObject.value;
2129: }
2130: if (oldObject.name) {
2131: newObject.name = oldObject.name;
2132: }
2133: if (oldObject.id) {
2134: newObject.id = oldObject.id;
2135: }
2136: oldObject.parentNode.replaceChild(newObject,oldObject);
2137: return;
2138: }
2139:
2140: ENDJS
1.475 www 2141: }
2142:
1.167 www 2143: sub gradeleveldescription {
2144: my $gradelevel=shift;
2145: my %gradelevels=(0 => 'Not specified',
2146: 1 => 'Grade 1',
2147: 2 => 'Grade 2',
2148: 3 => 'Grade 3',
2149: 4 => 'Grade 4',
2150: 5 => 'Grade 5',
2151: 6 => 'Grade 6',
2152: 7 => 'Grade 7',
2153: 8 => 'Grade 8',
2154: 9 => 'Grade 9',
2155: 10 => 'Grade 10',
2156: 11 => 'Grade 11',
2157: 12 => 'Grade 12',
2158: 13 => 'Grade 13',
2159: 14 => '100 Level',
2160: 15 => '200 Level',
2161: 16 => '300 Level',
2162: 17 => '400 Level',
2163: 18 => 'Graduate Level');
2164: return &mt($gradelevels{$gradelevel});
2165: }
2166:
1.163 www 2167: sub select_level_form {
2168: my ($deflevel,$name)=@_;
2169: unless ($deflevel) { $deflevel=0; }
1.167 www 2170: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2171: for (my $i=0; $i<=18; $i++) {
2172: $selectform.="<option value=\"$i\" ".
1.253 albertel 2173: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2174: ">".&gradeleveldescription($i)."</option>\n";
2175: }
2176: $selectform.="</select>";
2177: return $selectform;
1.163 www 2178: }
1.167 www 2179:
1.35 matthew 2180: #-------------------------------------------
2181:
1.45 matthew 2182: =pod
2183:
1.1075.2.42 raeburn 2184: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2185:
2186: Returns a string containing a <select name='$name' size='1'> form to
2187: allow a user to select the domain to preform an operation in.
2188: See loncreateuser.pm for an example invocation and use.
2189:
1.90 www 2190: If the $includeempty flag is set, it also includes an empty choice ("no domain
2191: selected");
2192:
1.743 raeburn 2193: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2194:
1.910 raeburn 2195: 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.
2196:
1.1075.2.36 raeburn 2197: The optional $incdoms is a reference to an array of domains which will be the only available options.
2198:
2199: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2200:
1.35 matthew 2201: =cut
2202:
2203: #-------------------------------------------
1.34 matthew 2204: sub select_dom_form {
1.1075.2.36 raeburn 2205: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2206: if ($onchange) {
1.874 raeburn 2207: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2208: }
1.1075.2.36 raeburn 2209: my (@domains,%exclude);
1.910 raeburn 2210: if (ref($incdoms) eq 'ARRAY') {
2211: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2212: } else {
2213: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2214: }
1.90 www 2215: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2216: if (ref($excdoms) eq 'ARRAY') {
2217: map { $exclude{$_} = 1; } @{$excdoms};
2218: }
1.743 raeburn 2219: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2220: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2221: next if ($exclude{$dom});
1.356 albertel 2222: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2223: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2224: if ($showdomdesc) {
2225: if ($dom ne '') {
2226: my $domdesc = &Apache::lonnet::domain($dom,'description');
2227: if ($domdesc ne '') {
2228: $selectdomain .= ' ('.$domdesc.')';
2229: }
2230: }
2231: }
2232: $selectdomain .= "</option>\n";
1.34 matthew 2233: }
2234: $selectdomain.="</select>";
2235: return $selectdomain;
2236: }
2237:
1.35 matthew 2238: #-------------------------------------------
2239:
1.45 matthew 2240: =pod
2241:
1.648 raeburn 2242: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2243:
1.586 raeburn 2244: input: 4 arguments (two required, two optional) -
2245: $domain - domain of new user
2246: $name - name of form element
2247: $default - Value of 'default' causes a default item to be first
2248: option, and selected by default.
2249: $hide - Value of 'hide' causes hiding of the name of the server,
2250: if 1 server found, or default, if 0 found.
1.594 raeburn 2251: output: returns 2 items:
1.586 raeburn 2252: (a) form element which contains either:
2253: (i) <select name="$name">
2254: <option value="$hostid1">$hostid $servers{$hostid}</option>
2255: <option value="$hostid2">$hostid $servers{$hostid}</option>
2256: </select>
2257: form item if there are multiple library servers in $domain, or
2258: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2259: if there is only one library server in $domain.
2260:
2261: (b) number of library servers found.
2262:
2263: See loncreateuser.pm for example of use.
1.35 matthew 2264:
2265: =cut
2266:
2267: #-------------------------------------------
1.586 raeburn 2268: sub home_server_form_item {
2269: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2270: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2271: my $result;
2272: my $numlib = keys(%servers);
2273: if ($numlib > 1) {
2274: $result .= '<select name="'.$name.'" />'."\n";
2275: if ($default) {
1.804 bisitz 2276: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2277: '</option>'."\n";
2278: }
2279: foreach my $hostid (sort(keys(%servers))) {
2280: $result.= '<option value="'.$hostid.'">'.
2281: $hostid.' '.$servers{$hostid}."</option>\n";
2282: }
2283: $result .= '</select>'."\n";
2284: } elsif ($numlib == 1) {
2285: my $hostid;
2286: foreach my $item (keys(%servers)) {
2287: $hostid = $item;
2288: }
2289: $result .= '<input type="hidden" name="'.$name.'" value="'.
2290: $hostid.'" />';
2291: if (!$hide) {
2292: $result .= $hostid.' '.$servers{$hostid};
2293: }
2294: $result .= "\n";
2295: } elsif ($default) {
2296: $result .= '<input type="hidden" name="'.$name.
2297: '" value="default" />';
2298: if (!$hide) {
2299: $result .= &mt('default');
2300: }
2301: $result .= "\n";
1.33 matthew 2302: }
1.586 raeburn 2303: return ($result,$numlib);
1.33 matthew 2304: }
1.112 bowersj2 2305:
2306: =pod
2307:
1.534 albertel 2308: =back
2309:
1.112 bowersj2 2310: =cut
1.87 matthew 2311:
2312: ###############################################################
1.112 bowersj2 2313: ## Decoding User Agent ##
1.87 matthew 2314: ###############################################################
2315:
2316: =pod
2317:
1.112 bowersj2 2318: =head1 Decoding the User Agent
2319:
2320: =over 4
2321:
2322: =item * &decode_user_agent()
1.87 matthew 2323:
2324: Inputs: $r
2325:
2326: Outputs:
2327:
2328: =over 4
2329:
1.112 bowersj2 2330: =item * $httpbrowser
1.87 matthew 2331:
1.112 bowersj2 2332: =item * $clientbrowser
1.87 matthew 2333:
1.112 bowersj2 2334: =item * $clientversion
1.87 matthew 2335:
1.112 bowersj2 2336: =item * $clientmathml
1.87 matthew 2337:
1.112 bowersj2 2338: =item * $clientunicode
1.87 matthew 2339:
1.112 bowersj2 2340: =item * $clientos
1.87 matthew 2341:
1.1075.2.42 raeburn 2342: =item * $clientmobile
2343:
2344: =item * $clientinfo
2345:
1.1075.2.77 raeburn 2346: =item * $clientosversion
2347:
1.87 matthew 2348: =back
2349:
1.157 matthew 2350: =back
2351:
1.87 matthew 2352: =cut
2353:
2354: ###############################################################
2355: ###############################################################
2356: sub decode_user_agent {
1.247 albertel 2357: my ($r)=@_;
1.87 matthew 2358: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2359: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2360: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2361: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2362: my $clientbrowser='unknown';
2363: my $clientversion='0';
2364: my $clientmathml='';
2365: my $clientunicode='0';
1.1075.2.42 raeburn 2366: my $clientmobile=0;
1.1075.2.77 raeburn 2367: my $clientosversion='';
1.87 matthew 2368: for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76 raeburn 2369: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2370: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2371: $clientbrowser=$bname;
2372: $httpbrowser=~/$vreg/i;
2373: $clientversion=$1;
2374: $clientmathml=($clientversion>=$minv);
2375: $clientunicode=($clientversion>=$univ);
2376: }
2377: }
2378: my $clientos='unknown';
1.1075.2.42 raeburn 2379: my $clientinfo;
1.87 matthew 2380: if (($httpbrowser=~/linux/i) ||
2381: ($httpbrowser=~/unix/i) ||
2382: ($httpbrowser=~/ux/i) ||
2383: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2384: if (($httpbrowser=~/vax/i) ||
2385: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2386: if ($httpbrowser=~/next/i) { $clientos='next'; }
2387: if (($httpbrowser=~/mac/i) ||
2388: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77 raeburn 2389: if ($httpbrowser=~/win/i) {
2390: $clientos='win';
2391: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2392: $clientosversion = $1;
2393: }
2394: }
1.87 matthew 2395: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2396: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2397: $clientmobile=lc($1);
2398: }
2399: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2400: $clientinfo = 'firefox-'.$1;
2401: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2402: $clientinfo = 'chromeframe-'.$1;
2403: }
1.87 matthew 2404: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77 raeburn 2405: $clientunicode,$clientos,$clientmobile,$clientinfo,
2406: $clientosversion);
1.87 matthew 2407: }
2408:
1.32 matthew 2409: ###############################################################
2410: ## Authentication changing form generation subroutines ##
2411: ###############################################################
2412: ##
2413: ## All of the authform_xxxxxxx subroutines take their inputs in a
2414: ## hash, and have reasonable default values.
2415: ##
2416: ## formname = the name given in the <form> tag.
1.35 matthew 2417: #-------------------------------------------
2418:
1.45 matthew 2419: =pod
2420:
1.112 bowersj2 2421: =head1 Authentication Routines
2422:
2423: =over 4
2424:
1.648 raeburn 2425: =item * &authform_xxxxxx()
1.35 matthew 2426:
2427: The authform_xxxxxx subroutines provide javascript and html forms which
2428: handle some of the conveniences required for authentication forms.
2429: This is not an optimal method, but it works.
2430:
2431: =over 4
2432:
1.112 bowersj2 2433: =item * authform_header
1.35 matthew 2434:
1.112 bowersj2 2435: =item * authform_authorwarning
1.35 matthew 2436:
1.112 bowersj2 2437: =item * authform_nochange
1.35 matthew 2438:
1.112 bowersj2 2439: =item * authform_kerberos
1.35 matthew 2440:
1.112 bowersj2 2441: =item * authform_internal
1.35 matthew 2442:
1.112 bowersj2 2443: =item * authform_filesystem
1.35 matthew 2444:
2445: =back
2446:
1.648 raeburn 2447: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2448:
1.35 matthew 2449: =cut
2450:
2451: #-------------------------------------------
1.32 matthew 2452: sub authform_header{
2453: my %in = (
2454: formname => 'cu',
1.80 albertel 2455: kerb_def_dom => '',
1.32 matthew 2456: @_,
2457: );
2458: $in{'formname'} = 'document.' . $in{'formname'};
2459: my $result='';
1.80 albertel 2460:
2461: #---------------------------------------------- Code for upper case translation
2462: my $Javascript_toUpperCase;
2463: unless ($in{kerb_def_dom}) {
2464: $Javascript_toUpperCase =<<"END";
2465: switch (choice) {
2466: case 'krb': currentform.elements[choicearg].value =
2467: currentform.elements[choicearg].value.toUpperCase();
2468: break;
2469: default:
2470: }
2471: END
2472: } else {
2473: $Javascript_toUpperCase = "";
2474: }
2475:
1.165 raeburn 2476: my $radioval = "'nochange'";
1.591 raeburn 2477: if (defined($in{'curr_authtype'})) {
2478: if ($in{'curr_authtype'} ne '') {
2479: $radioval = "'".$in{'curr_authtype'}."arg'";
2480: }
1.174 matthew 2481: }
1.165 raeburn 2482: my $argfield = 'null';
1.591 raeburn 2483: if (defined($in{'mode'})) {
1.165 raeburn 2484: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2485: if (defined($in{'curr_autharg'})) {
2486: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2487: $argfield = "'$in{'curr_autharg'}'";
2488: }
2489: }
2490: }
2491: }
2492:
1.32 matthew 2493: $result.=<<"END";
2494: var current = new Object();
1.165 raeburn 2495: current.radiovalue = $radioval;
2496: current.argfield = $argfield;
1.32 matthew 2497:
2498: function changed_radio(choice,currentform) {
2499: var choicearg = choice + 'arg';
2500: // If a radio button in changed, we need to change the argfield
2501: if (current.radiovalue != choice) {
2502: current.radiovalue = choice;
2503: if (current.argfield != null) {
2504: currentform.elements[current.argfield].value = '';
2505: }
2506: if (choice == 'nochange') {
2507: current.argfield = null;
2508: } else {
2509: current.argfield = choicearg;
2510: switch(choice) {
2511: case 'krb':
2512: currentform.elements[current.argfield].value =
2513: "$in{'kerb_def_dom'}";
2514: break;
2515: default:
2516: break;
2517: }
2518: }
2519: }
2520: return;
2521: }
1.22 www 2522:
1.32 matthew 2523: function changed_text(choice,currentform) {
2524: var choicearg = choice + 'arg';
2525: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2526: $Javascript_toUpperCase
1.32 matthew 2527: // clear old field
2528: if ((current.argfield != choicearg) && (current.argfield != null)) {
2529: currentform.elements[current.argfield].value = '';
2530: }
2531: current.argfield = choicearg;
2532: }
2533: set_auth_radio_buttons(choice,currentform);
2534: return;
1.20 www 2535: }
1.32 matthew 2536:
2537: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2538: var numauthchoices = currentform.login.length;
2539: if (typeof numauthchoices == "undefined") {
2540: return;
2541: }
1.32 matthew 2542: var i=0;
1.986 raeburn 2543: while (i < numauthchoices) {
1.32 matthew 2544: if (currentform.login[i].value == newvalue) { break; }
2545: i++;
2546: }
1.986 raeburn 2547: if (i == numauthchoices) {
1.32 matthew 2548: return;
2549: }
2550: current.radiovalue = newvalue;
2551: currentform.login[i].checked = true;
2552: return;
2553: }
2554: END
2555: return $result;
2556: }
2557:
1.1075.2.20 raeburn 2558: sub authform_authorwarning {
1.32 matthew 2559: my $result='';
1.144 matthew 2560: $result='<i>'.
2561: &mt('As a general rule, only authors or co-authors should be '.
2562: 'filesystem authenticated '.
2563: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2564: return $result;
2565: }
2566:
1.1075.2.20 raeburn 2567: sub authform_nochange {
1.32 matthew 2568: my %in = (
2569: formname => 'document.cu',
2570: kerb_def_dom => 'MSU.EDU',
2571: @_,
2572: );
1.1075.2.20 raeburn 2573: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2574: my $result;
1.1075.2.20 raeburn 2575: if (!$authnum) {
2576: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2577: } else {
2578: $result = '<label>'.&mt('[_1] Do not change login data',
2579: '<input type="radio" name="login" value="nochange" '.
2580: 'checked="checked" onclick="'.
1.281 albertel 2581: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2582: '</label>';
1.586 raeburn 2583: }
1.32 matthew 2584: return $result;
2585: }
2586:
1.591 raeburn 2587: sub authform_kerberos {
1.32 matthew 2588: my %in = (
2589: formname => 'document.cu',
2590: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2591: kerb_def_auth => 'krb4',
1.32 matthew 2592: @_,
2593: );
1.586 raeburn 2594: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2595: $autharg,$jscall);
1.1075.2.20 raeburn 2596: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2597: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2598: $check5 = ' checked="checked"';
1.80 albertel 2599: } else {
1.772 bisitz 2600: $check4 = ' checked="checked"';
1.80 albertel 2601: }
1.165 raeburn 2602: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2603: if (defined($in{'curr_authtype'})) {
2604: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2605: $krbcheck = ' checked="checked"';
1.623 raeburn 2606: if (defined($in{'mode'})) {
2607: if ($in{'mode'} eq 'modifyuser') {
2608: $krbcheck = '';
2609: }
2610: }
1.591 raeburn 2611: if (defined($in{'curr_kerb_ver'})) {
2612: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2613: $check5 = ' checked="checked"';
1.591 raeburn 2614: $check4 = '';
2615: } else {
1.772 bisitz 2616: $check4 = ' checked="checked"';
1.591 raeburn 2617: $check5 = '';
2618: }
1.586 raeburn 2619: }
1.591 raeburn 2620: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2621: $krbarg = $in{'curr_autharg'};
2622: }
1.586 raeburn 2623: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2624: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2625: $result =
2626: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2627: $in{'curr_autharg'},$krbver);
2628: } else {
2629: $result =
2630: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2631: }
2632: return $result;
2633: }
2634: }
2635: } else {
2636: if ($authnum == 1) {
1.784 bisitz 2637: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2638: }
2639: }
1.586 raeburn 2640: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2641: return;
1.587 raeburn 2642: } elsif ($authtype eq '') {
1.591 raeburn 2643: if (defined($in{'mode'})) {
1.587 raeburn 2644: if ($in{'mode'} eq 'modifycourse') {
2645: if ($authnum == 1) {
1.1075.2.20 raeburn 2646: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2647: }
2648: }
2649: }
1.586 raeburn 2650: }
2651: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2652: if ($authtype eq '') {
2653: $authtype = '<input type="radio" name="login" value="krb" '.
2654: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2655: $krbcheck.' />';
2656: }
2657: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2658: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2659: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2660: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2661: $in{'curr_authtype'} eq 'krb4')) {
2662: $result .= &mt
1.144 matthew 2663: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2664: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2665: '<label>'.$authtype,
1.281 albertel 2666: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2667: 'value="'.$krbarg.'" '.
1.144 matthew 2668: 'onchange="'.$jscall.'" />',
1.281 albertel 2669: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2670: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2671: '</label>');
1.586 raeburn 2672: } elsif ($can_assign{'krb4'}) {
2673: $result .= &mt
2674: ('[_1] Kerberos authenticated with domain [_2] '.
2675: '[_3] Version 4 [_4]',
2676: '<label>'.$authtype,
2677: '</label><input type="text" size="10" name="krbarg" '.
2678: 'value="'.$krbarg.'" '.
2679: 'onchange="'.$jscall.'" />',
2680: '<label><input type="hidden" name="krbver" value="4" />',
2681: '</label>');
2682: } elsif ($can_assign{'krb5'}) {
2683: $result .= &mt
2684: ('[_1] Kerberos authenticated with domain [_2] '.
2685: '[_3] Version 5 [_4]',
2686: '<label>'.$authtype,
2687: '</label><input type="text" size="10" name="krbarg" '.
2688: 'value="'.$krbarg.'" '.
2689: 'onchange="'.$jscall.'" />',
2690: '<label><input type="hidden" name="krbver" value="5" />',
2691: '</label>');
2692: }
1.32 matthew 2693: return $result;
2694: }
2695:
1.1075.2.20 raeburn 2696: sub authform_internal {
1.586 raeburn 2697: my %in = (
1.32 matthew 2698: formname => 'document.cu',
2699: kerb_def_dom => 'MSU.EDU',
2700: @_,
2701: );
1.586 raeburn 2702: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2703: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2704: if (defined($in{'curr_authtype'})) {
2705: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2706: if ($can_assign{'int'}) {
1.772 bisitz 2707: $intcheck = 'checked="checked" ';
1.623 raeburn 2708: if (defined($in{'mode'})) {
2709: if ($in{'mode'} eq 'modifyuser') {
2710: $intcheck = '';
2711: }
2712: }
1.591 raeburn 2713: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2714: $intarg = $in{'curr_autharg'};
2715: }
2716: } else {
2717: $result = &mt('Currently internally authenticated.');
2718: return $result;
1.165 raeburn 2719: }
2720: }
1.586 raeburn 2721: } else {
2722: if ($authnum == 1) {
1.784 bisitz 2723: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2724: }
2725: }
2726: if (!$can_assign{'int'}) {
2727: return;
1.587 raeburn 2728: } elsif ($authtype eq '') {
1.591 raeburn 2729: if (defined($in{'mode'})) {
1.587 raeburn 2730: if ($in{'mode'} eq 'modifycourse') {
2731: if ($authnum == 1) {
1.1075.2.20 raeburn 2732: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2733: }
2734: }
2735: }
1.165 raeburn 2736: }
1.586 raeburn 2737: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2738: if ($authtype eq '') {
2739: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2740: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2741: }
1.605 bisitz 2742: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2743: $intarg.'" onchange="'.$jscall.'" />';
2744: $result = &mt
1.144 matthew 2745: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2746: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2747: $result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';
1.32 matthew 2748: return $result;
2749: }
2750:
1.1075.2.20 raeburn 2751: sub authform_local {
1.32 matthew 2752: my %in = (
2753: formname => 'document.cu',
2754: kerb_def_dom => 'MSU.EDU',
2755: @_,
2756: );
1.586 raeburn 2757: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2758: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2759: if (defined($in{'curr_authtype'})) {
2760: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2761: if ($can_assign{'loc'}) {
1.772 bisitz 2762: $loccheck = 'checked="checked" ';
1.623 raeburn 2763: if (defined($in{'mode'})) {
2764: if ($in{'mode'} eq 'modifyuser') {
2765: $loccheck = '';
2766: }
2767: }
1.591 raeburn 2768: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2769: $locarg = $in{'curr_autharg'};
2770: }
2771: } else {
2772: $result = &mt('Currently using local (institutional) authentication.');
2773: return $result;
1.165 raeburn 2774: }
2775: }
1.586 raeburn 2776: } else {
2777: if ($authnum == 1) {
1.784 bisitz 2778: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2779: }
2780: }
2781: if (!$can_assign{'loc'}) {
2782: return;
1.587 raeburn 2783: } elsif ($authtype eq '') {
1.591 raeburn 2784: if (defined($in{'mode'})) {
1.587 raeburn 2785: if ($in{'mode'} eq 'modifycourse') {
2786: if ($authnum == 1) {
1.1075.2.20 raeburn 2787: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 2788: }
2789: }
2790: }
1.165 raeburn 2791: }
1.586 raeburn 2792: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2793: if ($authtype eq '') {
2794: $authtype = '<input type="radio" name="login" value="loc" '.
2795: $loccheck.' onchange="'.$jscall.'" onclick="'.
2796: $jscall.'" />';
2797: }
2798: $autharg = '<input type="text" size="10" name="locarg" value="'.
2799: $locarg.'" onchange="'.$jscall.'" />';
2800: $result = &mt('[_1] Local Authentication with argument [_2]',
2801: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2802: return $result;
2803: }
2804:
1.1075.2.20 raeburn 2805: sub authform_filesystem {
1.32 matthew 2806: my %in = (
2807: formname => 'document.cu',
2808: kerb_def_dom => 'MSU.EDU',
2809: @_,
2810: );
1.586 raeburn 2811: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2812: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2813: if (defined($in{'curr_authtype'})) {
2814: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2815: if ($can_assign{'fsys'}) {
1.772 bisitz 2816: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2817: if (defined($in{'mode'})) {
2818: if ($in{'mode'} eq 'modifyuser') {
2819: $fsyscheck = '';
2820: }
2821: }
1.586 raeburn 2822: } else {
2823: $result = &mt('Currently Filesystem Authenticated.');
2824: return $result;
2825: }
2826: }
2827: } else {
2828: if ($authnum == 1) {
1.784 bisitz 2829: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2830: }
2831: }
2832: if (!$can_assign{'fsys'}) {
2833: return;
1.587 raeburn 2834: } elsif ($authtype eq '') {
1.591 raeburn 2835: if (defined($in{'mode'})) {
1.587 raeburn 2836: if ($in{'mode'} eq 'modifycourse') {
2837: if ($authnum == 1) {
1.1075.2.20 raeburn 2838: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 2839: }
2840: }
2841: }
1.586 raeburn 2842: }
2843: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2844: if ($authtype eq '') {
2845: $authtype = '<input type="radio" name="login" value="fsys" '.
2846: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2847: $jscall.'" />';
2848: }
2849: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2850: ' onchange="'.$jscall.'" />';
2851: $result = &mt
1.144 matthew 2852: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2853: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2854: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2855: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2856: 'onchange="'.$jscall.'" />');
1.32 matthew 2857: return $result;
2858: }
2859:
1.586 raeburn 2860: sub get_assignable_auth {
2861: my ($dom) = @_;
2862: if ($dom eq '') {
2863: $dom = $env{'request.role.domain'};
2864: }
2865: my %can_assign = (
2866: krb4 => 1,
2867: krb5 => 1,
2868: int => 1,
2869: loc => 1,
2870: );
2871: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2872: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2873: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2874: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2875: my $context;
2876: if ($env{'request.role'} =~ /^au/) {
2877: $context = 'author';
2878: } elsif ($env{'request.role'} =~ /^dc/) {
2879: $context = 'domain';
2880: } elsif ($env{'request.course.id'}) {
2881: $context = 'course';
2882: }
2883: if ($context) {
2884: if (ref($authhash->{$context}) eq 'HASH') {
2885: %can_assign = %{$authhash->{$context}};
2886: }
2887: }
2888: }
2889: }
2890: my $authnum = 0;
2891: foreach my $key (keys(%can_assign)) {
2892: if ($can_assign{$key}) {
2893: $authnum ++;
2894: }
2895: }
2896: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2897: $authnum --;
2898: }
2899: return ($authnum,%can_assign);
2900: }
2901:
1.80 albertel 2902: ###############################################################
2903: ## Get Kerberos Defaults for Domain ##
2904: ###############################################################
2905: ##
2906: ## Returns default kerberos version and an associated argument
2907: ## as listed in file domain.tab. If not listed, provides
2908: ## appropriate default domain and kerberos version.
2909: ##
2910: #-------------------------------------------
2911:
2912: =pod
2913:
1.648 raeburn 2914: =item * &get_kerberos_defaults()
1.80 albertel 2915:
2916: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2917: version and domain. If not found, it defaults to version 4 and the
2918: domain of the server.
1.80 albertel 2919:
1.648 raeburn 2920: =over 4
2921:
1.80 albertel 2922: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2923:
1.648 raeburn 2924: =back
2925:
2926: =back
2927:
1.80 albertel 2928: =cut
2929:
2930: #-------------------------------------------
2931: sub get_kerberos_defaults {
2932: my $domain=shift;
1.641 raeburn 2933: my ($krbdef,$krbdefdom);
2934: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2935: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2936: $krbdef = $domdefaults{'auth_def'};
2937: $krbdefdom = $domdefaults{'auth_arg_def'};
2938: } else {
1.80 albertel 2939: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2940: my $krbdefdom=$1;
2941: $krbdefdom=~tr/a-z/A-Z/;
2942: $krbdef = "krb4";
2943: }
2944: return ($krbdef,$krbdefdom);
2945: }
1.112 bowersj2 2946:
1.32 matthew 2947:
1.46 matthew 2948: ###############################################################
2949: ## Thesaurus Functions ##
2950: ###############################################################
1.20 www 2951:
1.46 matthew 2952: =pod
1.20 www 2953:
1.112 bowersj2 2954: =head1 Thesaurus Functions
2955:
2956: =over 4
2957:
1.648 raeburn 2958: =item * &initialize_keywords()
1.46 matthew 2959:
2960: Initializes the package variable %Keywords if it is empty. Uses the
2961: package variable $thesaurus_db_file.
2962:
2963: =cut
2964:
2965: ###################################################
2966:
2967: sub initialize_keywords {
2968: return 1 if (scalar keys(%Keywords));
2969: # If we are here, %Keywords is empty, so fill it up
2970: # Make sure the file we need exists...
2971: if (! -e $thesaurus_db_file) {
2972: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2973: " failed because it does not exist");
2974: return 0;
2975: }
2976: # Set up the hash as a database
2977: my %thesaurus_db;
2978: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2979: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2980: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2981: $thesaurus_db_file);
2982: return 0;
2983: }
2984: # Get the average number of appearances of a word.
2985: my $avecount = $thesaurus_db{'average.count'};
2986: # Put keywords (those that appear > average) into %Keywords
2987: while (my ($word,$data)=each (%thesaurus_db)) {
2988: my ($count,undef) = split /:/,$data;
2989: $Keywords{$word}++ if ($count > $avecount);
2990: }
2991: untie %thesaurus_db;
2992: # Remove special values from %Keywords.
1.356 albertel 2993: foreach my $value ('total.count','average.count') {
2994: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 2995: }
1.46 matthew 2996: return 1;
2997: }
2998:
2999: ###################################################
3000:
3001: =pod
3002:
1.648 raeburn 3003: =item * &keyword($word)
1.46 matthew 3004:
3005: Returns true if $word is a keyword. A keyword is a word that appears more
3006: than the average number of times in the thesaurus database. Calls
3007: &initialize_keywords
3008:
3009: =cut
3010:
3011: ###################################################
1.20 www 3012:
3013: sub keyword {
1.46 matthew 3014: return if (!&initialize_keywords());
3015: my $word=lc(shift());
3016: $word=~s/\W//g;
3017: return exists($Keywords{$word});
1.20 www 3018: }
1.46 matthew 3019:
3020: ###############################################################
3021:
3022: =pod
1.20 www 3023:
1.648 raeburn 3024: =item * &get_related_words()
1.46 matthew 3025:
1.160 matthew 3026: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3027: an array of words. If the keyword is not in the thesaurus, an empty array
3028: will be returned. The order of the words returned is determined by the
3029: database which holds them.
3030:
3031: Uses global $thesaurus_db_file.
3032:
1.1057 foxr 3033:
1.46 matthew 3034: =cut
3035:
3036: ###############################################################
3037: sub get_related_words {
3038: my $keyword = shift;
3039: my %thesaurus_db;
3040: if (! -e $thesaurus_db_file) {
3041: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3042: "failed because the file does not exist");
3043: return ();
3044: }
3045: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3046: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3047: return ();
3048: }
3049: my @Words=();
1.429 www 3050: my $count=0;
1.46 matthew 3051: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3052: # The first element is the number of times
3053: # the word appears. We do not need it now.
1.429 www 3054: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3055: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3056: my $threshold=$mostfrequentcount/10;
3057: foreach my $possibleword (@RelatedWords) {
3058: my ($word,$wordcount)=split(/\,/,$possibleword);
3059: if ($wordcount>$threshold) {
3060: push(@Words,$word);
3061: $count++;
3062: if ($count>10) { last; }
3063: }
1.20 www 3064: }
3065: }
1.46 matthew 3066: untie %thesaurus_db;
3067: return @Words;
1.14 harris41 3068: }
1.46 matthew 3069:
1.112 bowersj2 3070: =pod
3071:
3072: =back
3073:
3074: =cut
1.61 www 3075:
3076: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3077: =pod
3078:
1.112 bowersj2 3079: =head1 User Name Functions
3080:
3081: =over 4
3082:
1.648 raeburn 3083: =item * &plainname($uname,$udom,$first)
1.81 albertel 3084:
1.112 bowersj2 3085: Takes a users logon name and returns it as a string in
1.226 albertel 3086: "first middle last generation" form
3087: if $first is set to 'lastname' then it returns it as
3088: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3089:
3090: =cut
1.61 www 3091:
1.295 www 3092:
1.81 albertel 3093: ###############################################################
1.61 www 3094: sub plainname {
1.226 albertel 3095: my ($uname,$udom,$first)=@_;
1.537 albertel 3096: return if (!defined($uname) || !defined($udom));
1.295 www 3097: my %names=&getnames($uname,$udom);
1.226 albertel 3098: my $name=&Apache::lonnet::format_name($names{'firstname'},
3099: $names{'middlename'},
3100: $names{'lastname'},
3101: $names{'generation'},$first);
3102: $name=~s/^\s+//;
1.62 www 3103: $name=~s/\s+$//;
3104: $name=~s/\s+/ /g;
1.353 albertel 3105: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3106: return $name;
1.61 www 3107: }
1.66 www 3108:
3109: # -------------------------------------------------------------------- Nickname
1.81 albertel 3110: =pod
3111:
1.648 raeburn 3112: =item * &nickname($uname,$udom)
1.81 albertel 3113:
3114: Gets a users name and returns it as a string as
3115:
3116: ""nickname""
1.66 www 3117:
1.81 albertel 3118: if the user has a nickname or
3119:
3120: "first middle last generation"
3121:
3122: if the user does not
3123:
3124: =cut
1.66 www 3125:
3126: sub nickname {
3127: my ($uname,$udom)=@_;
1.537 albertel 3128: return if (!defined($uname) || !defined($udom));
1.295 www 3129: my %names=&getnames($uname,$udom);
1.68 albertel 3130: my $name=$names{'nickname'};
1.66 www 3131: if ($name) {
3132: $name='"'.$name.'"';
3133: } else {
3134: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3135: $names{'lastname'}.' '.$names{'generation'};
3136: $name=~s/\s+$//;
3137: $name=~s/\s+/ /g;
3138: }
3139: return $name;
3140: }
3141:
1.295 www 3142: sub getnames {
3143: my ($uname,$udom)=@_;
1.537 albertel 3144: return if (!defined($uname) || !defined($udom));
1.433 albertel 3145: if ($udom eq 'public' && $uname eq 'public') {
3146: return ('lastname' => &mt('Public'));
3147: }
1.295 www 3148: my $id=$uname.':'.$udom;
3149: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3150: if ($cached) {
3151: return %{$names};
3152: } else {
3153: my %loadnames=&Apache::lonnet::get('environment',
3154: ['firstname','middlename','lastname','generation','nickname'],
3155: $udom,$uname);
3156: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3157: return %loadnames;
3158: }
3159: }
1.61 www 3160:
1.542 raeburn 3161: # -------------------------------------------------------------------- getemails
1.648 raeburn 3162:
1.542 raeburn 3163: =pod
3164:
1.648 raeburn 3165: =item * &getemails($uname,$udom)
1.542 raeburn 3166:
3167: Gets a user's email information and returns it as a hash with keys:
3168: notification, critnotification, permanentemail
3169:
3170: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3171: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3172:
1.648 raeburn 3173:
1.542 raeburn 3174: =cut
3175:
1.648 raeburn 3176:
1.466 albertel 3177: sub getemails {
3178: my ($uname,$udom)=@_;
3179: if ($udom eq 'public' && $uname eq 'public') {
3180: return;
3181: }
1.467 www 3182: if (!$udom) { $udom=$env{'user.domain'}; }
3183: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3184: my $id=$uname.':'.$udom;
3185: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3186: if ($cached) {
3187: return %{$names};
3188: } else {
3189: my %loadnames=&Apache::lonnet::get('environment',
3190: ['notification','critnotification',
3191: 'permanentemail'],
3192: $udom,$uname);
3193: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3194: return %loadnames;
3195: }
3196: }
3197:
1.551 albertel 3198: sub flush_email_cache {
3199: my ($uname,$udom)=@_;
3200: if (!$udom) { $udom =$env{'user.domain'}; }
3201: if (!$uname) { $uname=$env{'user.name'}; }
3202: return if ($udom eq 'public' && $uname eq 'public');
3203: my $id=$uname.':'.$udom;
3204: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3205: }
3206:
1.728 raeburn 3207: # -------------------------------------------------------------------- getlangs
3208:
3209: =pod
3210:
3211: =item * &getlangs($uname,$udom)
3212:
3213: Gets a user's language preference and returns it as a hash with key:
3214: language.
3215:
3216: =cut
3217:
3218:
3219: sub getlangs {
3220: my ($uname,$udom) = @_;
3221: if (!$udom) { $udom =$env{'user.domain'}; }
3222: if (!$uname) { $uname=$env{'user.name'}; }
3223: my $id=$uname.':'.$udom;
3224: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3225: if ($cached) {
3226: return %{$langs};
3227: } else {
3228: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3229: $udom,$uname);
3230: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3231: return %loadlangs;
3232: }
3233: }
3234:
3235: sub flush_langs_cache {
3236: my ($uname,$udom)=@_;
3237: if (!$udom) { $udom =$env{'user.domain'}; }
3238: if (!$uname) { $uname=$env{'user.name'}; }
3239: return if ($udom eq 'public' && $uname eq 'public');
3240: my $id=$uname.':'.$udom;
3241: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3242: }
3243:
1.61 www 3244: # ------------------------------------------------------------------ Screenname
1.81 albertel 3245:
3246: =pod
3247:
1.648 raeburn 3248: =item * &screenname($uname,$udom)
1.81 albertel 3249:
3250: Gets a users screenname and returns it as a string
3251:
3252: =cut
1.61 www 3253:
3254: sub screenname {
3255: my ($uname,$udom)=@_;
1.258 albertel 3256: if ($uname eq $env{'user.name'} &&
3257: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3258: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3259: return $names{'screenname'};
1.62 www 3260: }
3261:
1.212 albertel 3262:
1.802 bisitz 3263: # ------------------------------------------------------------- Confirm Wrapper
3264: =pod
3265:
1.1075.2.42 raeburn 3266: =item * &confirmwrapper($message)
1.802 bisitz 3267:
3268: Wrap messages about completion of operation in box
3269:
3270: =cut
3271:
3272: sub confirmwrapper {
3273: my ($message)=@_;
3274: if ($message) {
3275: return "\n".'<div class="LC_confirm_box">'."\n"
3276: .$message."\n"
3277: .'</div>'."\n";
3278: } else {
3279: return $message;
3280: }
3281: }
3282:
1.62 www 3283: # ------------------------------------------------------------- Message Wrapper
3284:
3285: sub messagewrapper {
1.369 www 3286: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3287: return
1.441 albertel 3288: '<a href="/adm/email?compose=individual&'.
3289: 'recname='.$username.'&recdom='.$domain.
3290: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3291: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3292: }
1.802 bisitz 3293:
1.74 www 3294: # --------------------------------------------------------------- Notes Wrapper
3295:
3296: sub noteswrapper {
3297: my ($link,$un,$do)=@_;
3298: return
1.896 amueller 3299: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3300: }
1.802 bisitz 3301:
1.62 www 3302: # ------------------------------------------------------------- Aboutme Wrapper
3303:
3304: sub aboutmewrapper {
1.1070 raeburn 3305: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3306: if (!defined($username) && !defined($domain)) {
3307: return;
3308: }
1.1075.2.15 raeburn 3309: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3310: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3311: }
3312:
3313: # ------------------------------------------------------------ Syllabus Wrapper
3314:
3315: sub syllabuswrapper {
1.707 bisitz 3316: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3317: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3318: }
1.14 harris41 3319:
1.802 bisitz 3320: # -----------------------------------------------------------------------------
3321:
1.208 matthew 3322: sub track_student_link {
1.887 raeburn 3323: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3324: my $link ="/adm/trackstudent?";
1.208 matthew 3325: my $title = 'View recent activity';
3326: if (defined($sname) && $sname !~ /^\s*$/ &&
3327: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3328: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3329: $title .= ' of this student';
1.268 albertel 3330: }
1.208 matthew 3331: if (defined($target) && $target !~ /^\s*$/) {
3332: $target = qq{target="$target"};
3333: } else {
3334: $target = '';
3335: }
1.268 albertel 3336: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3337: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3338: $title = &mt($title);
3339: $linktext = &mt($linktext);
1.448 albertel 3340: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3341: &help_open_topic('View_recent_activity');
1.208 matthew 3342: }
3343:
1.781 raeburn 3344: sub slot_reservations_link {
3345: my ($linktext,$sname,$sdom,$target) = @_;
3346: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3347: my $title = 'View slot reservation history';
3348: if (defined($sname) && $sname !~ /^\s*$/ &&
3349: defined($sdom) && $sdom !~ /^\s*$/) {
3350: $link .= "&uname=$sname&udom=$sdom";
3351: $title .= ' of this student';
3352: }
3353: if (defined($target) && $target !~ /^\s*$/) {
3354: $target = qq{target="$target"};
3355: } else {
3356: $target = '';
3357: }
3358: $title = &mt($title);
3359: $linktext = &mt($linktext);
3360: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3361: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3362:
3363: }
3364:
1.508 www 3365: # ===================================================== Display a student photo
3366:
3367:
1.509 albertel 3368: sub student_image_tag {
1.508 www 3369: my ($domain,$user)=@_;
3370: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3371: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3372: return '<img src="'.$imgsrc.'" align="right" />';
3373: } else {
3374: return '';
3375: }
3376: }
3377:
1.112 bowersj2 3378: =pod
3379:
3380: =back
3381:
3382: =head1 Access .tab File Data
3383:
3384: =over 4
3385:
1.648 raeburn 3386: =item * &languageids()
1.112 bowersj2 3387:
3388: returns list of all language ids
3389:
3390: =cut
3391:
1.14 harris41 3392: sub languageids {
1.16 harris41 3393: return sort(keys(%language));
1.14 harris41 3394: }
3395:
1.112 bowersj2 3396: =pod
3397:
1.648 raeburn 3398: =item * &languagedescription()
1.112 bowersj2 3399:
3400: returns description of a specified language id
3401:
3402: =cut
3403:
1.14 harris41 3404: sub languagedescription {
1.125 www 3405: my $code=shift;
3406: return ($supported_language{$code}?'* ':'').
3407: $language{$code}.
1.126 www 3408: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3409: }
3410:
1.1048 foxr 3411: =pod
3412:
3413: =item * &plainlanguagedescription
3414:
3415: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3416: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3417:
3418: =cut
3419:
1.145 www 3420: sub plainlanguagedescription {
3421: my $code=shift;
3422: return $language{$code};
3423: }
3424:
1.1048 foxr 3425: =pod
3426:
3427: =item * &supportedlanguagecode
3428:
3429: Returns the supported language code (e.g. sptutf maps to pt) given a language
3430: code.
3431:
3432: =cut
3433:
1.145 www 3434: sub supportedlanguagecode {
3435: my $code=shift;
3436: return $supported_language{$code};
1.97 www 3437: }
3438:
1.112 bowersj2 3439: =pod
3440:
1.1048 foxr 3441: =item * &latexlanguage()
3442:
3443: Given a language key code returns the correspondnig language to use
3444: to select the correct hyphenation on LaTeX printouts. This is undef if there
3445: is no supported hyphenation for the language code.
3446:
3447: =cut
3448:
3449: sub latexlanguage {
3450: my $code = shift;
3451: return $latex_language{$code};
3452: }
3453:
3454: =pod
3455:
3456: =item * &latexhyphenation()
3457:
3458: Same as above but what's supplied is the language as it might be stored
3459: in the metadata.
3460:
3461: =cut
3462:
3463: sub latexhyphenation {
3464: my $key = shift;
3465: return $latex_language_bykey{$key};
3466: }
3467:
3468: =pod
3469:
1.648 raeburn 3470: =item * ©rightids()
1.112 bowersj2 3471:
3472: returns list of all copyrights
3473:
3474: =cut
3475:
3476: sub copyrightids {
3477: return sort(keys(%cprtag));
3478: }
3479:
3480: =pod
3481:
1.648 raeburn 3482: =item * ©rightdescription()
1.112 bowersj2 3483:
3484: returns description of a specified copyright id
3485:
3486: =cut
3487:
3488: sub copyrightdescription {
1.166 www 3489: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3490: }
1.197 matthew 3491:
3492: =pod
3493:
1.648 raeburn 3494: =item * &source_copyrightids()
1.192 taceyjo1 3495:
3496: returns list of all source copyrights
3497:
3498: =cut
3499:
3500: sub source_copyrightids {
3501: return sort(keys(%scprtag));
3502: }
3503:
3504: =pod
3505:
1.648 raeburn 3506: =item * &source_copyrightdescription()
1.192 taceyjo1 3507:
3508: returns description of a specified source copyright id
3509:
3510: =cut
3511:
3512: sub source_copyrightdescription {
3513: return &mt($scprtag{shift(@_)});
3514: }
1.112 bowersj2 3515:
3516: =pod
3517:
1.648 raeburn 3518: =item * &filecategories()
1.112 bowersj2 3519:
3520: returns list of all file categories
3521:
3522: =cut
3523:
3524: sub filecategories {
3525: return sort(keys(%category_extensions));
3526: }
3527:
3528: =pod
3529:
1.648 raeburn 3530: =item * &filecategorytypes()
1.112 bowersj2 3531:
3532: returns list of file types belonging to a given file
3533: category
3534:
3535: =cut
3536:
3537: sub filecategorytypes {
1.356 albertel 3538: my ($cat) = @_;
3539: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3540: }
3541:
3542: =pod
3543:
1.648 raeburn 3544: =item * &fileembstyle()
1.112 bowersj2 3545:
3546: returns embedding style for a specified file type
3547:
3548: =cut
3549:
3550: sub fileembstyle {
3551: return $fe{lc(shift(@_))};
1.169 www 3552: }
3553:
1.351 www 3554: sub filemimetype {
3555: return $fm{lc(shift(@_))};
3556: }
3557:
1.169 www 3558:
3559: sub filecategoryselect {
3560: my ($name,$value)=@_;
1.189 matthew 3561: return &select_form($value,$name,
1.970 raeburn 3562: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3563: }
3564:
3565: =pod
3566:
1.648 raeburn 3567: =item * &filedescription()
1.112 bowersj2 3568:
3569: returns description for a specified file type
3570:
3571: =cut
3572:
3573: sub filedescription {
1.188 matthew 3574: my $file_description = $fd{lc(shift())};
3575: $file_description =~ s:([\[\]]):~$1:g;
3576: return &mt($file_description);
1.112 bowersj2 3577: }
3578:
3579: =pod
3580:
1.648 raeburn 3581: =item * &filedescriptionex()
1.112 bowersj2 3582:
3583: returns description for a specified file type with
3584: extra formatting
3585:
3586: =cut
3587:
3588: sub filedescriptionex {
3589: my $ex=shift;
1.188 matthew 3590: my $file_description = $fd{lc($ex)};
3591: $file_description =~ s:([\[\]]):~$1:g;
3592: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3593: }
3594:
3595: # End of .tab access
3596: =pod
3597:
3598: =back
3599:
3600: =cut
3601:
3602: # ------------------------------------------------------------------ File Types
3603: sub fileextensions {
3604: return sort(keys(%fe));
3605: }
3606:
1.97 www 3607: # ----------------------------------------------------------- Display Languages
3608: # returns a hash with all desired display languages
3609: #
3610:
3611: sub display_languages {
3612: my %languages=();
1.695 raeburn 3613: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3614: $languages{$lang}=1;
1.97 www 3615: }
3616: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3617: if ($env{'form.displaylanguage'}) {
1.356 albertel 3618: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3619: $languages{$lang}=1;
1.97 www 3620: }
3621: }
3622: return %languages;
1.14 harris41 3623: }
3624:
1.582 albertel 3625: sub languages {
3626: my ($possible_langs) = @_;
1.695 raeburn 3627: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3628: if (!ref($possible_langs)) {
3629: if( wantarray ) {
3630: return @preferred_langs;
3631: } else {
3632: return $preferred_langs[0];
3633: }
3634: }
3635: my %possibilities = map { $_ => 1 } (@$possible_langs);
3636: my @preferred_possibilities;
3637: foreach my $preferred_lang (@preferred_langs) {
3638: if (exists($possibilities{$preferred_lang})) {
3639: push(@preferred_possibilities, $preferred_lang);
3640: }
3641: }
3642: if( wantarray ) {
3643: return @preferred_possibilities;
3644: }
3645: return $preferred_possibilities[0];
3646: }
3647:
1.742 raeburn 3648: sub user_lang {
3649: my ($touname,$toudom,$fromcid) = @_;
3650: my @userlangs;
3651: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3652: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3653: $env{'course.'.$fromcid.'.languages'}));
3654: } else {
3655: my %langhash = &getlangs($touname,$toudom);
3656: if ($langhash{'languages'} ne '') {
3657: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3658: } else {
3659: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3660: if ($domdefs{'lang_def'} ne '') {
3661: @userlangs = ($domdefs{'lang_def'});
3662: }
3663: }
3664: }
3665: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3666: my $user_lh = Apache::localize->get_handle(@languages);
3667: return $user_lh;
3668: }
3669:
3670:
1.112 bowersj2 3671: ###############################################################
3672: ## Student Answer Attempts ##
3673: ###############################################################
3674:
3675: =pod
3676:
3677: =head1 Alternate Problem Views
3678:
3679: =over 4
3680:
1.648 raeburn 3681: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86 raeburn 3682: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 3683:
3684: Return string with previous attempt on problem. Arguments:
3685:
3686: =over 4
3687:
3688: =item * $symb: Problem, including path
3689:
3690: =item * $username: username of the desired student
3691:
3692: =item * $domain: domain of the desired student
1.14 harris41 3693:
1.112 bowersj2 3694: =item * $course: Course ID
1.14 harris41 3695:
1.112 bowersj2 3696: =item * $getattempt: Leave blank for all attempts, otherwise put
3697: something
1.14 harris41 3698:
1.112 bowersj2 3699: =item * $regexp: if string matches this regexp, the string will be
3700: sent to $gradesub
1.14 harris41 3701:
1.112 bowersj2 3702: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3703:
1.1075.2.86 raeburn 3704: =item * $usec: section of the desired student
3705:
3706: =item * $identifier: counter for student (multiple students one problem) or
3707: problem (one student; whole sequence).
3708:
1.112 bowersj2 3709: =back
1.14 harris41 3710:
1.112 bowersj2 3711: The output string is a table containing all desired attempts, if any.
1.16 harris41 3712:
1.112 bowersj2 3713: =cut
1.1 albertel 3714:
3715: sub get_previous_attempt {
1.1075.2.86 raeburn 3716: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 3717: my $prevattempts='';
1.43 ng 3718: no strict 'refs';
1.1 albertel 3719: if ($symb) {
1.3 albertel 3720: my (%returnhash)=
3721: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3722: if ($returnhash{'version'}) {
3723: my %lasthash=();
3724: my $version;
3725: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91 raeburn 3726: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
3727: if ($key =~ /\.rawrndseed$/) {
3728: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
3729: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
3730: } else {
3731: $lasthash{$key}=$returnhash{$version.':'.$key};
3732: }
1.19 harris41 3733: }
1.1 albertel 3734: }
1.596 albertel 3735: $prevattempts=&start_data_table().&start_data_table_header_row();
3736: $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86 raeburn 3737: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 3738: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3739: foreach my $key (sort(keys(%lasthash))) {
3740: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3741: if ($#parts > 0) {
1.31 albertel 3742: my $data=$parts[-1];
1.989 raeburn 3743: next if ($data eq 'foilorder');
1.31 albertel 3744: pop(@parts);
1.1010 www 3745: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3746: if ($data eq 'type') {
3747: unless ($showsurv) {
3748: my $id = join(',',@parts);
3749: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3750: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3751: $lasthidden{$ign.'.'.$id} = 1;
3752: }
1.945 raeburn 3753: }
1.1075.2.86 raeburn 3754: if ($identifier ne '') {
3755: my $id = join(',',@parts);
3756: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
3757: $domain,$username,$usec,undef,$course) =~ /^no/) {
3758: $hidestatus{$ign.'.'.$id} = 1;
3759: }
3760: }
3761: } elsif ($data eq 'regrader') {
3762: if (($identifier ne '') && (@parts)) {
3763: my $id = join(',',@parts);
3764: $regraded{$ign.'.'.$id} = 1;
3765: }
1.1010 www 3766: }
1.31 albertel 3767: } else {
1.41 ng 3768: if ($#parts == 0) {
3769: $prevattempts.='<th>'.$parts[0].'</th>';
3770: } else {
3771: $prevattempts.='<th>'.$ign.'</th>';
3772: }
1.31 albertel 3773: }
1.16 harris41 3774: }
1.596 albertel 3775: $prevattempts.=&end_data_table_header_row();
1.40 ng 3776: if ($getattempt eq '') {
1.1075.2.86 raeburn 3777: my (%solved,%resets,%probstatus);
3778: if (($identifier ne '') && (keys(%regraded) > 0)) {
3779: for ($version=1;$version<=$returnhash{'version'};$version++) {
3780: foreach my $id (keys(%regraded)) {
3781: if (($returnhash{$version.':'.$id.'.regrader'}) &&
3782: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
3783: ($returnhash{$version.':'.$id.'.award'} eq '')) {
3784: push(@{$resets{$id}},$version);
3785: }
3786: }
3787: }
3788: }
1.40 ng 3789: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86 raeburn 3790: my (@hidden,@unsolved);
1.945 raeburn 3791: if (%typeparts) {
3792: foreach my $id (keys(%typeparts)) {
1.1075.2.86 raeburn 3793: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
3794: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 3795: push(@hidden,$id);
1.1075.2.86 raeburn 3796: } elsif ($identifier ne '') {
3797: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
3798: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
3799: ($hidestatus{$id})) {
3800: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
3801: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
3802: push(@{$solved{$id}},$version);
3803: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
3804: (ref($solved{$id}) eq 'ARRAY')) {
3805: my $skip;
3806: if (ref($resets{$id}) eq 'ARRAY') {
3807: foreach my $reset (@{$resets{$id}}) {
3808: if ($reset > $solved{$id}[-1]) {
3809: $skip=1;
3810: last;
3811: }
3812: }
3813: }
3814: unless ($skip) {
3815: my ($ign,$partslist) = split(/\./,$id,2);
3816: push(@unsolved,$partslist);
3817: }
3818: }
3819: }
1.945 raeburn 3820: }
3821: }
3822: }
3823: $prevattempts.=&start_data_table_row().
1.1075.2.86 raeburn 3824: '<td>'.&mt('Transaction [_1]',$version);
3825: if (@unsolved) {
3826: $prevattempts .= '<span class="LC_nobreak"><label>'.
3827: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
3828: &mt('Hide').'</label></span>';
3829: }
3830: $prevattempts .= '</td>';
1.945 raeburn 3831: if (@hidden) {
3832: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3833: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3834: my $hide;
3835: foreach my $id (@hidden) {
3836: if ($key =~ /^\Q$id\E/) {
3837: $hide = 1;
3838: last;
3839: }
3840: }
3841: if ($hide) {
3842: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3843: if (($data eq 'award') || ($data eq 'awarddetail')) {
3844: my $value = &format_previous_attempt_value($key,
3845: $returnhash{$version.':'.$key});
3846: $prevattempts.='<td>'.$value.' </td>';
3847: } else {
3848: $prevattempts.='<td> </td>';
3849: }
3850: } else {
3851: if ($key =~ /\./) {
1.1075.2.91 raeburn 3852: my $value = $returnhash{$version.':'.$key};
3853: if ($key =~ /\.rndseed$/) {
3854: my ($id) = ($key =~ /^(.+)\.rndseed$/);
3855: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
3856: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
3857: }
3858: }
3859: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
3860: ' </td>';
1.945 raeburn 3861: } else {
3862: $prevattempts.='<td> </td>';
3863: }
3864: }
3865: }
3866: } else {
3867: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3868: next if ($key =~ /\.foilorder$/);
1.1075.2.91 raeburn 3869: my $value = $returnhash{$version.':'.$key};
3870: if ($key =~ /\.rndseed$/) {
3871: my ($id) = ($key =~ /^(.+)\.rndseed$/);
3872: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
3873: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
3874: }
3875: }
3876: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
3877: ' </td>';
1.945 raeburn 3878: }
3879: }
3880: $prevattempts.=&end_data_table_row();
1.40 ng 3881: }
1.1 albertel 3882: }
1.945 raeburn 3883: my @currhidden = keys(%lasthidden);
1.596 albertel 3884: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3885: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3886: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3887: if (%typeparts) {
3888: my $hidden;
3889: foreach my $id (@currhidden) {
3890: if ($key =~ /^\Q$id\E/) {
3891: $hidden = 1;
3892: last;
3893: }
3894: }
3895: if ($hidden) {
3896: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3897: if (($data eq 'award') || ($data eq 'awarddetail')) {
3898: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3899: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3900: $value = &$gradesub($value);
3901: }
3902: $prevattempts.='<td>'.$value.' </td>';
3903: } else {
3904: $prevattempts.='<td> </td>';
3905: }
3906: } else {
3907: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3908: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3909: $value = &$gradesub($value);
3910: }
3911: $prevattempts.='<td>'.$value.' </td>';
3912: }
3913: } else {
3914: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3915: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3916: $value = &$gradesub($value);
3917: }
3918: $prevattempts.='<td>'.$value.' </td>';
3919: }
1.16 harris41 3920: }
1.596 albertel 3921: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3922: } else {
1.596 albertel 3923: $prevattempts=
3924: &start_data_table().&start_data_table_row().
3925: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3926: &end_data_table_row().&end_data_table();
1.1 albertel 3927: }
3928: } else {
1.596 albertel 3929: $prevattempts=
3930: &start_data_table().&start_data_table_row().
3931: '<td>'.&mt('No data.').'</td>'.
3932: &end_data_table_row().&end_data_table();
1.1 albertel 3933: }
1.10 albertel 3934: }
3935:
1.581 albertel 3936: sub format_previous_attempt_value {
3937: my ($key,$value) = @_;
1.1011 www 3938: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 3939: $value = &Apache::lonlocal::locallocaltime($value);
3940: } elsif (ref($value) eq 'ARRAY') {
3941: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 3942: } elsif ($key =~ /answerstring$/) {
3943: my %answers = &Apache::lonnet::str2hash($value);
3944: my @anskeys = sort(keys(%answers));
3945: if (@anskeys == 1) {
3946: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3947: if ($answer =~ m{\0}) {
3948: $answer =~ s{\0}{,}g;
1.988 raeburn 3949: }
3950: my $tag_internal_answer_name = 'INTERNAL';
3951: if ($anskeys[0] eq $tag_internal_answer_name) {
3952: $value = $answer;
3953: } else {
3954: $value = $anskeys[0].'='.$answer;
3955: }
3956: } else {
3957: foreach my $ans (@anskeys) {
3958: my $answer = $answers{$ans};
1.1001 raeburn 3959: if ($answer =~ m{\0}) {
3960: $answer =~ s{\0}{,}g;
1.988 raeburn 3961: }
3962: $value .= $ans.'='.$answer.'<br />';;
3963: }
3964: }
1.581 albertel 3965: } else {
3966: $value = &unescape($value);
3967: }
3968: return $value;
3969: }
3970:
3971:
1.107 albertel 3972: sub relative_to_absolute {
3973: my ($url,$output)=@_;
3974: my $parser=HTML::TokeParser->new(\$output);
3975: my $token;
3976: my $thisdir=$url;
3977: my @rlinks=();
3978: while ($token=$parser->get_token) {
3979: if ($token->[0] eq 'S') {
3980: if ($token->[1] eq 'a') {
3981: if ($token->[2]->{'href'}) {
3982: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3983: }
3984: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3985: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3986: } elsif ($token->[1] eq 'base') {
3987: $thisdir=$token->[2]->{'href'};
3988: }
3989: }
3990: }
3991: $thisdir=~s-/[^/]*$--;
1.356 albertel 3992: foreach my $link (@rlinks) {
1.726 raeburn 3993: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 3994: ($link=~/^\//) ||
3995: ($link=~/^javascript:/i) ||
3996: ($link=~/^mailto:/i) ||
3997: ($link=~/^\#/)) {
3998: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
3999: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4000: }
4001: }
4002: # -------------------------------------------------- Deal with Applet codebases
4003: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4004: return $output;
4005: }
4006:
1.112 bowersj2 4007: =pod
4008:
1.648 raeburn 4009: =item * &get_student_view()
1.112 bowersj2 4010:
4011: show a snapshot of what student was looking at
4012:
4013: =cut
4014:
1.10 albertel 4015: sub get_student_view {
1.186 albertel 4016: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4017: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4018: my (%form);
1.10 albertel 4019: my @elements=('symb','courseid','domain','username');
4020: foreach my $element (@elements) {
1.186 albertel 4021: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4022: }
1.186 albertel 4023: if (defined($moreenv)) {
4024: %form=(%form,%{$moreenv});
4025: }
1.236 albertel 4026: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4027: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4028: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4029: $userview=~s/\<body[^\>]*\>//gi;
4030: $userview=~s/\<\/body\>//gi;
4031: $userview=~s/\<html\>//gi;
4032: $userview=~s/\<\/html\>//gi;
4033: $userview=~s/\<head\>//gi;
4034: $userview=~s/\<\/head\>//gi;
4035: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4036: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4037: if (wantarray) {
4038: return ($userview,$response);
4039: } else {
4040: return $userview;
4041: }
4042: }
4043:
4044: sub get_student_view_with_retries {
4045: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4046:
4047: my $ok = 0; # True if we got a good response.
4048: my $content;
4049: my $response;
4050:
4051: # Try to get the student_view done. within the retries count:
4052:
4053: do {
4054: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4055: $ok = $response->is_success;
4056: if (!$ok) {
4057: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4058: }
4059: $retries--;
4060: } while (!$ok && ($retries > 0));
4061:
4062: if (!$ok) {
4063: $content = ''; # On error return an empty content.
4064: }
1.651 www 4065: if (wantarray) {
4066: return ($content, $response);
4067: } else {
4068: return $content;
4069: }
1.11 albertel 4070: }
4071:
1.112 bowersj2 4072: =pod
4073:
1.648 raeburn 4074: =item * &get_student_answers()
1.112 bowersj2 4075:
4076: show a snapshot of how student was answering problem
4077:
4078: =cut
4079:
1.11 albertel 4080: sub get_student_answers {
1.100 sakharuk 4081: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4082: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4083: my (%moreenv);
1.11 albertel 4084: my @elements=('symb','courseid','domain','username');
4085: foreach my $element (@elements) {
1.186 albertel 4086: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4087: }
1.186 albertel 4088: $moreenv{'grade_target'}='answer';
4089: %moreenv=(%form,%moreenv);
1.497 raeburn 4090: $feedurl = &Apache::lonnet::clutter($feedurl);
4091: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4092: return $userview;
1.1 albertel 4093: }
1.116 albertel 4094:
4095: =pod
4096:
4097: =item * &submlink()
4098:
1.242 albertel 4099: Inputs: $text $uname $udom $symb $target
1.116 albertel 4100:
4101: Returns: A link to grades.pm such as to see the SUBM view of a student
4102:
4103: =cut
4104:
4105: ###############################################
4106: sub submlink {
1.242 albertel 4107: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4108: if (!($uname && $udom)) {
4109: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4110: &Apache::lonnet::whichuser($symb);
1.116 albertel 4111: if (!$symb) { $symb=$cursymb; }
4112: }
1.254 matthew 4113: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4114: $symb=&escape($symb);
1.960 bisitz 4115: if ($target) { $target=" target=\"$target\""; }
4116: return
4117: '<a href="/adm/grades?command=submission'.
4118: '&symb='.$symb.
4119: '&student='.$uname.
4120: '&userdom='.$udom.'"'.
4121: $target.'>'.$text.'</a>';
1.242 albertel 4122: }
4123: ##############################################
4124:
4125: =pod
4126:
4127: =item * &pgrdlink()
4128:
4129: Inputs: $text $uname $udom $symb $target
4130:
4131: Returns: A link to grades.pm such as to see the PGRD view of a student
4132:
4133: =cut
4134:
4135: ###############################################
4136: sub pgrdlink {
4137: my $link=&submlink(@_);
4138: $link=~s/(&command=submission)/$1&showgrading=yes/;
4139: return $link;
4140: }
4141: ##############################################
4142:
4143: =pod
4144:
4145: =item * &pprmlink()
4146:
4147: Inputs: $text $uname $udom $symb $target
4148:
4149: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4150: student and a specific resource
1.242 albertel 4151:
4152: =cut
4153:
4154: ###############################################
4155: sub pprmlink {
4156: my ($text,$uname,$udom,$symb,$target)=@_;
4157: if (!($uname && $udom)) {
4158: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4159: &Apache::lonnet::whichuser($symb);
1.242 albertel 4160: if (!$symb) { $symb=$cursymb; }
4161: }
1.254 matthew 4162: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4163: $symb=&escape($symb);
1.242 albertel 4164: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4165: return '<a href="/adm/parmset?command=set&'.
4166: 'symb='.$symb.'&uname='.$uname.
4167: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4168: }
4169: ##############################################
1.37 matthew 4170:
1.112 bowersj2 4171: =pod
4172:
4173: =back
4174:
4175: =cut
4176:
1.37 matthew 4177: ###############################################
1.51 www 4178:
4179:
4180: sub timehash {
1.687 raeburn 4181: my ($thistime) = @_;
4182: my $timezone = &Apache::lonlocal::gettimezone();
4183: my $dt = DateTime->from_epoch(epoch => $thistime)
4184: ->set_time_zone($timezone);
4185: my $wday = $dt->day_of_week();
4186: if ($wday == 7) { $wday = 0; }
4187: return ( 'second' => $dt->second(),
4188: 'minute' => $dt->minute(),
4189: 'hour' => $dt->hour(),
4190: 'day' => $dt->day_of_month(),
4191: 'month' => $dt->month(),
4192: 'year' => $dt->year(),
4193: 'weekday' => $wday,
4194: 'dayyear' => $dt->day_of_year(),
4195: 'dlsav' => $dt->is_dst() );
1.51 www 4196: }
4197:
1.370 www 4198: sub utc_string {
4199: my ($date)=@_;
1.371 www 4200: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4201: }
4202:
1.51 www 4203: sub maketime {
4204: my %th=@_;
1.687 raeburn 4205: my ($epoch_time,$timezone,$dt);
4206: $timezone = &Apache::lonlocal::gettimezone();
4207: eval {
4208: $dt = DateTime->new( year => $th{'year'},
4209: month => $th{'month'},
4210: day => $th{'day'},
4211: hour => $th{'hour'},
4212: minute => $th{'minute'},
4213: second => $th{'second'},
4214: time_zone => $timezone,
4215: );
4216: };
4217: if (!$@) {
4218: $epoch_time = $dt->epoch;
4219: if ($epoch_time) {
4220: return $epoch_time;
4221: }
4222: }
1.51 www 4223: return POSIX::mktime(
4224: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4225: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4226: }
4227:
4228: #########################################
1.51 www 4229:
4230: sub findallcourses {
1.482 raeburn 4231: my ($roles,$uname,$udom) = @_;
1.355 albertel 4232: my %roles;
4233: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4234: my %courses;
1.51 www 4235: my $now=time;
1.482 raeburn 4236: if (!defined($uname)) {
4237: $uname = $env{'user.name'};
4238: }
4239: if (!defined($udom)) {
4240: $udom = $env{'user.domain'};
4241: }
4242: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4243: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4244: if (!%roles) {
4245: %roles = (
4246: cc => 1,
1.907 raeburn 4247: co => 1,
1.482 raeburn 4248: in => 1,
4249: ep => 1,
4250: ta => 1,
4251: cr => 1,
4252: st => 1,
4253: );
4254: }
4255: foreach my $entry (keys(%roleshash)) {
4256: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4257: if ($trole =~ /^cr/) {
4258: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4259: } else {
4260: next if (!exists($roles{$trole}));
4261: }
4262: if ($tend) {
4263: next if ($tend < $now);
4264: }
4265: if ($tstart) {
4266: next if ($tstart > $now);
4267: }
1.1058 raeburn 4268: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4269: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4270: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4271: if ($secpart eq '') {
4272: ($cnum,$role) = split(/_/,$cnumpart);
4273: $sec = 'none';
1.1058 raeburn 4274: $value .= $cnum.'/';
1.482 raeburn 4275: } else {
4276: $cnum = $cnumpart;
4277: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4278: $value .= $cnum.'/'.$sec;
4279: }
4280: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4281: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4282: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4283: }
4284: } else {
4285: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4286: }
1.482 raeburn 4287: }
4288: } else {
4289: foreach my $key (keys(%env)) {
1.483 albertel 4290: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4291: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4292: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4293: next if ($role eq 'ca' || $role eq 'aa');
4294: next if (%roles && !exists($roles{$role}));
4295: my ($starttime,$endtime)=split(/\./,$env{$key});
4296: my $active=1;
4297: if ($starttime) {
4298: if ($now<$starttime) { $active=0; }
4299: }
4300: if ($endtime) {
4301: if ($now>$endtime) { $active=0; }
4302: }
4303: if ($active) {
1.1058 raeburn 4304: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4305: if ($sec eq '') {
4306: $sec = 'none';
1.1058 raeburn 4307: } else {
4308: $value .= $sec;
4309: }
4310: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4311: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4312: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4313: }
4314: } else {
4315: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4316: }
1.474 raeburn 4317: }
4318: }
1.51 www 4319: }
4320: }
1.474 raeburn 4321: return %courses;
1.51 www 4322: }
1.37 matthew 4323:
1.54 www 4324: ###############################################
1.474 raeburn 4325:
4326: sub blockcheck {
1.1075.2.73 raeburn 4327: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4328:
1.1075.2.73 raeburn 4329: if (defined($udom) && defined($uname)) {
4330: # If uname and udom are for a course, check for blocks in the course.
4331: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4332: my ($startblock,$endblock,$triggerblock) =
4333: &get_blocks($setters,$activity,$udom,$uname,$url);
4334: return ($startblock,$endblock,$triggerblock);
4335: }
4336: } else {
1.490 raeburn 4337: $udom = $env{'user.domain'};
4338: $uname = $env{'user.name'};
4339: }
4340:
1.502 raeburn 4341: my $startblock = 0;
4342: my $endblock = 0;
1.1062 raeburn 4343: my $triggerblock = '';
1.482 raeburn 4344: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4345:
1.490 raeburn 4346: # If uname is for a user, and activity is course-specific, i.e.,
4347: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4348:
1.490 raeburn 4349: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73 raeburn 4350: $activity eq 'groups' || $activity eq 'printout') &&
4351: ($env{'request.course.id'})) {
1.490 raeburn 4352: foreach my $key (keys(%live_courses)) {
4353: if ($key ne $env{'request.course.id'}) {
4354: delete($live_courses{$key});
4355: }
4356: }
4357: }
4358:
4359: my $otheruser = 0;
4360: my %own_courses;
4361: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4362: # Resource belongs to user other than current user.
4363: $otheruser = 1;
4364: # Gather courses for current user
4365: %own_courses =
4366: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4367: }
4368:
4369: # Gather active course roles - course coordinator, instructor,
4370: # exam proctor, ta, student, or custom role.
1.474 raeburn 4371:
4372: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4373: my ($cdom,$cnum);
4374: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4375: $cdom = $env{'course.'.$course.'.domain'};
4376: $cnum = $env{'course.'.$course.'.num'};
4377: } else {
1.490 raeburn 4378: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4379: }
4380: my $no_ownblock = 0;
4381: my $no_userblock = 0;
1.533 raeburn 4382: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4383: # Check if current user has 'evb' priv for this
4384: if (defined($own_courses{$course})) {
4385: foreach my $sec (keys(%{$own_courses{$course}})) {
4386: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4387: if ($sec ne 'none') {
4388: $checkrole .= '/'.$sec;
4389: }
4390: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4391: $no_ownblock = 1;
4392: last;
4393: }
4394: }
4395: }
4396: # if they have 'evb' priv and are currently not playing student
4397: next if (($no_ownblock) &&
4398: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4399: }
1.474 raeburn 4400: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4401: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4402: if ($sec ne 'none') {
1.482 raeburn 4403: $checkrole .= '/'.$sec;
1.474 raeburn 4404: }
1.490 raeburn 4405: if ($otheruser) {
4406: # Resource belongs to user other than current user.
4407: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4408: my (%allroles,%userroles);
4409: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4410: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4411: my ($trole,$tdom,$tnum,$tsec);
4412: if ($entry =~ /^cr/) {
4413: ($trole,$tdom,$tnum,$tsec) =
4414: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4415: } else {
4416: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4417: }
4418: my ($spec,$area,$trest);
4419: $area = '/'.$tdom.'/'.$tnum;
4420: $trest = $tnum;
4421: if ($tsec ne '') {
4422: $area .= '/'.$tsec;
4423: $trest .= '/'.$tsec;
4424: }
4425: $spec = $trole.'.'.$area;
4426: if ($trole =~ /^cr/) {
4427: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4428: $tdom,$spec,$trest,$area);
4429: } else {
4430: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4431: $tdom,$spec,$trest,$area);
4432: }
4433: }
4434: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4435: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4436: if ($1) {
4437: $no_userblock = 1;
4438: last;
4439: }
1.486 raeburn 4440: }
4441: }
1.490 raeburn 4442: } else {
4443: # Resource belongs to current user
4444: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4445: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4446: $no_ownblock = 1;
4447: last;
4448: }
1.474 raeburn 4449: }
4450: }
4451: # if they have the evb priv and are currently not playing student
1.482 raeburn 4452: next if (($no_ownblock) &&
1.491 albertel 4453: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4454: next if ($no_userblock);
1.474 raeburn 4455:
1.866 kalberla 4456: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4457: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4458:
1.1062 raeburn 4459: my ($start,$end,$trigger) =
4460: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4461: if (($start != 0) &&
4462: (($startblock == 0) || ($startblock > $start))) {
4463: $startblock = $start;
1.1062 raeburn 4464: if ($trigger ne '') {
4465: $triggerblock = $trigger;
4466: }
1.502 raeburn 4467: }
4468: if (($end != 0) &&
4469: (($endblock == 0) || ($endblock < $end))) {
4470: $endblock = $end;
1.1062 raeburn 4471: if ($trigger ne '') {
4472: $triggerblock = $trigger;
4473: }
1.502 raeburn 4474: }
1.490 raeburn 4475: }
1.1062 raeburn 4476: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4477: }
4478:
4479: sub get_blocks {
1.1062 raeburn 4480: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4481: my $startblock = 0;
4482: my $endblock = 0;
1.1062 raeburn 4483: my $triggerblock = '';
1.490 raeburn 4484: my $course = $cdom.'_'.$cnum;
4485: $setters->{$course} = {};
4486: $setters->{$course}{'staff'} = [];
4487: $setters->{$course}{'times'} = [];
1.1062 raeburn 4488: $setters->{$course}{'triggers'} = [];
4489: my (@blockers,%triggered);
4490: my $now = time;
4491: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4492: if ($activity eq 'docs') {
4493: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4494: foreach my $block (@blockers) {
4495: if ($block =~ /^firstaccess____(.+)$/) {
4496: my $item = $1;
4497: my $type = 'map';
4498: my $timersymb = $item;
4499: if ($item eq 'course') {
4500: $type = 'course';
4501: } elsif ($item =~ /___\d+___/) {
4502: $type = 'resource';
4503: } else {
4504: $timersymb = &Apache::lonnet::symbread($item);
4505: }
4506: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4507: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4508: $triggered{$block} = {
4509: start => $start,
4510: end => $end,
4511: type => $type,
4512: };
4513: }
4514: }
4515: } else {
4516: foreach my $block (keys(%commblocks)) {
4517: if ($block =~ m/^(\d+)____(\d+)$/) {
4518: my ($start,$end) = ($1,$2);
4519: if ($start <= time && $end >= time) {
4520: if (ref($commblocks{$block}) eq 'HASH') {
4521: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4522: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4523: unless(grep(/^\Q$block\E$/,@blockers)) {
4524: push(@blockers,$block);
4525: }
4526: }
4527: }
4528: }
4529: }
4530: } elsif ($block =~ /^firstaccess____(.+)$/) {
4531: my $item = $1;
4532: my $timersymb = $item;
4533: my $type = 'map';
4534: if ($item eq 'course') {
4535: $type = 'course';
4536: } elsif ($item =~ /___\d+___/) {
4537: $type = 'resource';
4538: } else {
4539: $timersymb = &Apache::lonnet::symbread($item);
4540: }
4541: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4542: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4543: if ($start && $end) {
4544: if (($start <= time) && ($end >= time)) {
4545: unless (grep(/^\Q$block\E$/,@blockers)) {
4546: push(@blockers,$block);
4547: $triggered{$block} = {
4548: start => $start,
4549: end => $end,
4550: type => $type,
4551: };
4552: }
4553: }
1.490 raeburn 4554: }
1.1062 raeburn 4555: }
4556: }
4557: }
4558: foreach my $blocker (@blockers) {
4559: my ($staff_name,$staff_dom,$title,$blocks) =
4560: &parse_block_record($commblocks{$blocker});
4561: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4562: my ($start,$end,$triggertype);
4563: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4564: ($start,$end) = ($1,$2);
4565: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4566: $start = $triggered{$blocker}{'start'};
4567: $end = $triggered{$blocker}{'end'};
4568: $triggertype = $triggered{$blocker}{'type'};
4569: }
4570: if ($start) {
4571: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4572: if ($triggertype) {
4573: push(@{$$setters{$course}{'triggers'}},$triggertype);
4574: } else {
4575: push(@{$$setters{$course}{'triggers'}},0);
4576: }
4577: if ( ($startblock == 0) || ($startblock > $start) ) {
4578: $startblock = $start;
4579: if ($triggertype) {
4580: $triggerblock = $blocker;
1.474 raeburn 4581: }
4582: }
1.1062 raeburn 4583: if ( ($endblock == 0) || ($endblock < $end) ) {
4584: $endblock = $end;
4585: if ($triggertype) {
4586: $triggerblock = $blocker;
4587: }
4588: }
1.474 raeburn 4589: }
4590: }
1.1062 raeburn 4591: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4592: }
4593:
4594: sub parse_block_record {
4595: my ($record) = @_;
4596: my ($setuname,$setudom,$title,$blocks);
4597: if (ref($record) eq 'HASH') {
4598: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4599: $title = &unescape($record->{'event'});
4600: $blocks = $record->{'blocks'};
4601: } else {
4602: my @data = split(/:/,$record,3);
4603: if (scalar(@data) eq 2) {
4604: $title = $data[1];
4605: ($setuname,$setudom) = split(/@/,$data[0]);
4606: } else {
4607: ($setuname,$setudom,$title) = @data;
4608: }
4609: $blocks = { 'com' => 'on' };
4610: }
4611: return ($setuname,$setudom,$title,$blocks);
4612: }
4613:
1.854 kalberla 4614: sub blocking_status {
1.1075.2.73 raeburn 4615: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4616: my %setters;
1.890 droeschl 4617:
1.1061 raeburn 4618: # check for active blocking
1.1062 raeburn 4619: my ($startblock,$endblock,$triggerblock) =
1.1075.2.73 raeburn 4620: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4621: my $blocked = 0;
4622: if ($startblock && $endblock) {
4623: $blocked = 1;
4624: }
1.890 droeschl 4625:
1.1061 raeburn 4626: # caller just wants to know whether a block is active
4627: if (!wantarray) { return $blocked; }
4628:
4629: # build a link to a popup window containing the details
4630: my $querystring = "?activity=$activity";
4631: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4632: if ($activity eq 'port') {
4633: $querystring .= "&udom=$udom" if $udom;
4634: $querystring .= "&uname=$uname" if $uname;
4635: } elsif ($activity eq 'docs') {
4636: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4637: }
1.1061 raeburn 4638:
4639: my $output .= <<'END_MYBLOCK';
4640: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4641: var options = "width=" + w + ",height=" + h + ",";
4642: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4643: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4644: var newWin = window.open(url, wdwName, options);
4645: newWin.focus();
4646: }
1.890 droeschl 4647: END_MYBLOCK
1.854 kalberla 4648:
1.1061 raeburn 4649: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4650:
1.1061 raeburn 4651: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4652: my $text = &mt('Communication Blocked');
1.1075.2.93 raeburn 4653: my $class = 'LC_comblock';
1.1062 raeburn 4654: if ($activity eq 'docs') {
4655: $text = &mt('Content Access Blocked');
1.1075.2.93 raeburn 4656: $class = '';
1.1063 raeburn 4657: } elsif ($activity eq 'printout') {
4658: $text = &mt('Printing Blocked');
1.1062 raeburn 4659: }
1.1061 raeburn 4660: $output .= <<"END_BLOCK";
1.1075.2.93 raeburn 4661: <div class='$class'>
1.869 kalberla 4662: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4663: title='$text'>
4664: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4665: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4666: title='$text'>$text</a>
1.867 kalberla 4667: </div>
4668:
4669: END_BLOCK
1.474 raeburn 4670:
1.1061 raeburn 4671: return ($blocked, $output);
1.854 kalberla 4672: }
1.490 raeburn 4673:
1.60 matthew 4674: ###############################################
4675:
1.682 raeburn 4676: sub check_ip_acc {
4677: my ($acc)=@_;
4678: &Apache::lonxml::debug("acc is $acc");
4679: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4680: return 1;
4681: }
4682: my $allowed=0;
4683: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4684:
4685: my $name;
4686: foreach my $pattern (split(',',$acc)) {
4687: $pattern =~ s/^\s*//;
4688: $pattern =~ s/\s*$//;
4689: if ($pattern =~ /\*$/) {
4690: #35.8.*
4691: $pattern=~s/\*//;
4692: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4693: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4694: #35.8.3.[34-56]
4695: my $low=$2;
4696: my $high=$3;
4697: $pattern=$1;
4698: if ($ip =~ /^\Q$pattern\E/) {
4699: my $last=(split(/\./,$ip))[3];
4700: if ($last <=$high && $last >=$low) { $allowed=1; }
4701: }
4702: } elsif ($pattern =~ /^\*/) {
4703: #*.msu.edu
4704: $pattern=~s/\*//;
4705: if (!defined($name)) {
4706: use Socket;
4707: my $netaddr=inet_aton($ip);
4708: ($name)=gethostbyaddr($netaddr,AF_INET);
4709: }
4710: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4711: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4712: #127.0.0.1
4713: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4714: } else {
4715: #some.name.com
4716: if (!defined($name)) {
4717: use Socket;
4718: my $netaddr=inet_aton($ip);
4719: ($name)=gethostbyaddr($netaddr,AF_INET);
4720: }
4721: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4722: }
4723: if ($allowed) { last; }
4724: }
4725: return $allowed;
4726: }
4727:
4728: ###############################################
4729:
1.60 matthew 4730: =pod
4731:
1.112 bowersj2 4732: =head1 Domain Template Functions
4733:
4734: =over 4
4735:
4736: =item * &determinedomain()
1.60 matthew 4737:
4738: Inputs: $domain (usually will be undef)
4739:
1.63 www 4740: Returns: Determines which domain should be used for designs
1.60 matthew 4741:
4742: =cut
1.54 www 4743:
1.60 matthew 4744: ###############################################
1.63 www 4745: sub determinedomain {
4746: my $domain=shift;
1.531 albertel 4747: if (! $domain) {
1.60 matthew 4748: # Determine domain if we have not been given one
1.893 raeburn 4749: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4750: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4751: if ($env{'request.role.domain'}) {
4752: $domain=$env{'request.role.domain'};
1.60 matthew 4753: }
4754: }
1.63 www 4755: return $domain;
4756: }
4757: ###############################################
1.517 raeburn 4758:
1.518 albertel 4759: sub devalidate_domconfig_cache {
4760: my ($udom)=@_;
4761: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4762: }
4763:
4764: # ---------------------- Get domain configuration for a domain
4765: sub get_domainconf {
4766: my ($udom) = @_;
4767: my $cachetime=1800;
4768: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4769: if (defined($cached)) { return %{$result}; }
4770:
4771: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4772: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4773: my (%designhash,%legacy);
1.518 albertel 4774: if (keys(%domconfig) > 0) {
4775: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4776: if (keys(%{$domconfig{'login'}})) {
4777: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4778: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87 raeburn 4779: if (($key eq 'loginvia') || ($key eq 'headtag')) {
4780: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4781: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
4782: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
4783: if ($key eq 'loginvia') {
4784: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4785: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4786: $designhash{$udom.'.login.loginvia'} = $server;
4787: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4788: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4789: } else {
4790: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
4791: }
1.948 raeburn 4792: }
1.1075.2.87 raeburn 4793: } elsif ($key eq 'headtag') {
4794: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
4795: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 4796: }
1.946 raeburn 4797: }
1.1075.2.87 raeburn 4798: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
4799: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
4800: }
1.946 raeburn 4801: }
4802: }
4803: }
4804: } else {
4805: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4806: $designhash{$udom.'.login.'.$key.'_'.$img} =
4807: $domconfig{'login'}{$key}{$img};
4808: }
1.699 raeburn 4809: }
4810: } else {
4811: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4812: }
1.632 raeburn 4813: }
4814: } else {
4815: $legacy{'login'} = 1;
1.518 albertel 4816: }
1.632 raeburn 4817: } else {
4818: $legacy{'login'} = 1;
1.518 albertel 4819: }
4820: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4821: if (keys(%{$domconfig{'rolecolors'}})) {
4822: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4823: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4824: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4825: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4826: }
1.518 albertel 4827: }
4828: }
1.632 raeburn 4829: } else {
4830: $legacy{'rolecolors'} = 1;
1.518 albertel 4831: }
1.632 raeburn 4832: } else {
4833: $legacy{'rolecolors'} = 1;
1.518 albertel 4834: }
1.948 raeburn 4835: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4836: if ($domconfig{'autoenroll'}{'co-owners'}) {
4837: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4838: }
4839: }
1.632 raeburn 4840: if (keys(%legacy) > 0) {
4841: my %legacyhash = &get_legacy_domconf($udom);
4842: foreach my $item (keys(%legacyhash)) {
4843: if ($item =~ /^\Q$udom\E\.login/) {
4844: if ($legacy{'login'}) {
4845: $designhash{$item} = $legacyhash{$item};
4846: }
4847: } else {
4848: if ($legacy{'rolecolors'}) {
4849: $designhash{$item} = $legacyhash{$item};
4850: }
1.518 albertel 4851: }
4852: }
4853: }
1.632 raeburn 4854: } else {
4855: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4856: }
4857: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4858: $cachetime);
4859: return %designhash;
4860: }
4861:
1.632 raeburn 4862: sub get_legacy_domconf {
4863: my ($udom) = @_;
4864: my %legacyhash;
4865: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4866: my $designfile = $designdir.'/'.$udom.'.tab';
4867: if (-e $designfile) {
4868: if ( open (my $fh,"<$designfile") ) {
4869: while (my $line = <$fh>) {
4870: next if ($line =~ /^\#/);
4871: chomp($line);
4872: my ($key,$val)=(split(/\=/,$line));
4873: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4874: }
4875: close($fh);
4876: }
4877: }
1.1026 raeburn 4878: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4879: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4880: }
4881: return %legacyhash;
4882: }
4883:
1.63 www 4884: =pod
4885:
1.112 bowersj2 4886: =item * &domainlogo()
1.63 www 4887:
4888: Inputs: $domain (usually will be undef)
4889:
4890: Returns: A link to a domain logo, if the domain logo exists.
4891: If the domain logo does not exist, a description of the domain.
4892:
4893: =cut
1.112 bowersj2 4894:
1.63 www 4895: ###############################################
4896: sub domainlogo {
1.517 raeburn 4897: my $domain = &determinedomain(shift);
1.518 albertel 4898: my %designhash = &get_domainconf($domain);
1.517 raeburn 4899: # See if there is a logo
4900: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4901: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4902: if ($imgsrc =~ m{^/(adm|res)/}) {
4903: if ($imgsrc =~ m{^/res/}) {
4904: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4905: &Apache::lonnet::repcopy($local_name);
4906: }
4907: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4908: }
4909: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4910: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4911: return &Apache::lonnet::domain($domain,'description');
1.59 www 4912: } else {
1.60 matthew 4913: return '';
1.59 www 4914: }
4915: }
1.63 www 4916: ##############################################
4917:
4918: =pod
4919:
1.112 bowersj2 4920: =item * &designparm()
1.63 www 4921:
4922: Inputs: $which parameter; $domain (usually will be undef)
4923:
4924: Returns: value of designparamter $which
4925:
4926: =cut
1.112 bowersj2 4927:
1.397 albertel 4928:
1.400 albertel 4929: ##############################################
1.397 albertel 4930: sub designparm {
4931: my ($which,$domain)=@_;
4932: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4933: return $env{'environment.color.'.$which};
1.96 www 4934: }
1.63 www 4935: $domain=&determinedomain($domain);
1.1016 raeburn 4936: my %domdesign;
4937: unless ($domain eq 'public') {
4938: %domdesign = &get_domainconf($domain);
4939: }
1.520 raeburn 4940: my $output;
1.517 raeburn 4941: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4942: $output = $domdesign{$domain.'.'.$which};
1.63 www 4943: } else {
1.520 raeburn 4944: $output = $defaultdesign{$which};
4945: }
4946: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4947: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4948: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4949: if ($output =~ m{^/res/}) {
4950: my $local_name = &Apache::lonnet::filelocation('',$output);
4951: &Apache::lonnet::repcopy($local_name);
4952: }
1.520 raeburn 4953: $output = &lonhttpdurl($output);
4954: }
1.63 www 4955: }
1.520 raeburn 4956: return $output;
1.63 www 4957: }
1.59 www 4958:
1.822 bisitz 4959: ##############################################
4960: =pod
4961:
1.832 bisitz 4962: =item * &authorspace()
4963:
1.1028 raeburn 4964: Inputs: $url (usually will be undef).
1.832 bisitz 4965:
1.1075.2.40 raeburn 4966: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 4967: directory being viewed (or for which action is being taken).
4968: If $url is provided, and begins /priv/<domain>/<uname>
4969: the path will be that portion of the $context argument.
4970: Otherwise the path will be for the author space of the current
4971: user when the current role is author, or for that of the
4972: co-author/assistant co-author space when the current role
4973: is co-author or assistant co-author.
1.832 bisitz 4974:
4975: =cut
4976:
4977: sub authorspace {
1.1028 raeburn 4978: my ($url) = @_;
4979: if ($url ne '') {
4980: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4981: return $1;
4982: }
4983: }
1.832 bisitz 4984: my $caname = '';
1.1024 www 4985: my $cadom = '';
1.1028 raeburn 4986: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4987: ($cadom,$caname) =
1.832 bisitz 4988: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4989: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4990: $caname = $env{'user.name'};
1.1024 www 4991: $cadom = $env{'user.domain'};
1.832 bisitz 4992: }
1.1028 raeburn 4993: if (($caname ne '') && ($cadom ne '')) {
4994: return "/priv/$cadom/$caname/";
4995: }
4996: return;
1.832 bisitz 4997: }
4998:
4999: ##############################################
5000: =pod
5001:
1.822 bisitz 5002: =item * &head_subbox()
5003:
5004: Inputs: $content (contains HTML code with page functions, etc.)
5005:
5006: Returns: HTML div with $content
5007: To be included in page header
5008:
5009: =cut
5010:
5011: sub head_subbox {
5012: my ($content)=@_;
5013: my $output =
1.993 raeburn 5014: '<div class="LC_head_subbox">'
1.822 bisitz 5015: .$content
5016: .'</div>'
5017: }
5018:
5019: ##############################################
5020: =pod
5021:
5022: =item * &CSTR_pageheader()
5023:
1.1026 raeburn 5024: Input: (optional) filename from which breadcrumb trail is built.
5025: In most cases no input as needed, as $env{'request.filename'}
5026: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5027:
5028: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 5029: To be included on Authoring Space pages
1.822 bisitz 5030:
5031: =cut
5032:
5033: sub CSTR_pageheader {
1.1026 raeburn 5034: my ($trailfile) = @_;
5035: if ($trailfile eq '') {
5036: $trailfile = $env{'request.filename'};
5037: }
5038:
5039: # this is for resources; directories have customtitle, and crumbs
5040: # and select recent are created in lonpubdir.pm
5041:
5042: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5043: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 5044: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5045: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5046: $formaction =~ s{/+}{/}g;
1.822 bisitz 5047:
5048: my $parentpath = '';
5049: my $lastitem = '';
5050: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5051: $parentpath = $1;
5052: $lastitem = $2;
5053: } else {
5054: $lastitem = $thisdisfn;
5055: }
1.921 bisitz 5056:
5057: my $output =
1.822 bisitz 5058: '<div>'
5059: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40 raeburn 5060: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5061: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5062: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5063: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5064:
5065: if ($lastitem) {
5066: $output .=
5067: '<span class="LC_filename">'
5068: .$lastitem
5069: .'</span>';
5070: }
5071: $output .=
5072: '<br />'
1.822 bisitz 5073: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5074: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5075: .'</form>'
5076: .&Apache::lonmenu::constspaceform()
5077: .'</div>';
1.921 bisitz 5078:
5079: return $output;
1.822 bisitz 5080: }
5081:
1.60 matthew 5082: ###############################################
5083: ###############################################
5084:
5085: =pod
5086:
1.112 bowersj2 5087: =back
5088:
1.549 albertel 5089: =head1 HTML Helpers
1.112 bowersj2 5090:
5091: =over 4
5092:
5093: =item * &bodytag()
1.60 matthew 5094:
5095: Returns a uniform header for LON-CAPA web pages.
5096:
5097: Inputs:
5098:
1.112 bowersj2 5099: =over 4
5100:
5101: =item * $title, A title to be displayed on the page.
5102:
5103: =item * $function, the current role (can be undef).
5104:
5105: =item * $addentries, extra parameters for the <body> tag.
5106:
5107: =item * $bodyonly, if defined, only return the <body> tag.
5108:
5109: =item * $domain, if defined, force a given domain.
5110:
5111: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5112: text interface only)
1.60 matthew 5113:
1.814 bisitz 5114: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5115: navigational links
1.317 albertel 5116:
1.338 albertel 5117: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5118:
1.1075.2.12 raeburn 5119: =item * $no_inline_link, if true and in remote mode, don't show the
5120: 'Switch To Inline Menu' link
5121:
1.460 albertel 5122: =item * $args, optional argument valid values are
5123: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5124: inherit_jsmath -> when creating popup window in a page,
5125: should it have jsmath forced on by the
5126: current page
1.460 albertel 5127:
1.1075.2.15 raeburn 5128: =item * $advtoolsref, optional argument, ref to an array containing
5129: inlineremote items to be added in "Functions" menu below
5130: breadcrumbs.
5131:
1.112 bowersj2 5132: =back
5133:
1.60 matthew 5134: Returns: A uniform header for LON-CAPA web pages.
5135: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5136: If $bodyonly is undef or zero, an html string containing a <body> tag and
5137: other decorations will be returned.
5138:
5139: =cut
5140:
1.54 www 5141: sub bodytag {
1.831 bisitz 5142: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15 raeburn 5143: $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339 albertel 5144:
1.954 raeburn 5145: my $public;
5146: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5147: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5148: $public = 1;
5149: }
1.460 albertel 5150: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 5151: my $httphost = $args->{'use_absolute'};
1.339 albertel 5152:
1.183 matthew 5153: $function = &get_users_function() if (!$function);
1.339 albertel 5154: my $img = &designparm($function.'.img',$domain);
5155: my $font = &designparm($function.'.font',$domain);
5156: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5157:
1.803 bisitz 5158: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5159: 'bgcolor' => $pgbg,
1.339 albertel 5160: 'text' => $font,
5161: 'alink' => &designparm($function.'.alink',$domain),
5162: 'vlink' => &designparm($function.'.vlink',$domain),
5163: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5164: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5165:
1.63 www 5166: # role and realm
1.1075.2.68 raeburn 5167: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5168: if ($realm) {
5169: $realm = '/'.$realm;
5170: }
1.378 raeburn 5171: if ($role eq 'ca') {
1.479 albertel 5172: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5173: $realm = &plainname($rname,$rdom);
1.378 raeburn 5174: }
1.55 www 5175: # realm
1.258 albertel 5176: if ($env{'request.course.id'}) {
1.378 raeburn 5177: if ($env{'request.role'} !~ /^cr/) {
5178: $role = &Apache::lonnet::plaintext($role,&course_type());
5179: }
1.898 raeburn 5180: if ($env{'request.course.sec'}) {
5181: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5182: }
1.359 albertel 5183: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5184: } else {
5185: $role = &Apache::lonnet::plaintext($role);
1.54 www 5186: }
1.433 albertel 5187:
1.359 albertel 5188: if (!$realm) { $realm=' '; }
1.330 albertel 5189:
1.438 albertel 5190: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5191:
1.101 www 5192: # construct main body tag
1.359 albertel 5193: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5194: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5195:
1.1075.2.38 raeburn 5196: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5197:
5198: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5199: return $bodytag;
1.1075.2.38 raeburn 5200: }
1.359 albertel 5201:
1.954 raeburn 5202: if ($public) {
1.433 albertel 5203: undef($role);
5204: }
1.359 albertel 5205:
1.762 bisitz 5206: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5207: #
5208: # Extra info if you are the DC
5209: my $dc_info = '';
5210: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5211: $env{'course.'.$env{'request.course.id'}.
5212: '.domain'}.'/'})) {
5213: my $cid = $env{'request.course.id'};
1.917 raeburn 5214: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5215: $dc_info =~ s/\s+$//;
1.359 albertel 5216: }
5217:
1.898 raeburn 5218: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903 droeschl 5219:
1.1075.2.13 raeburn 5220: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5221:
1.1075.2.38 raeburn 5222:
5223:
1.1075.2.21 raeburn 5224: my $funclist;
5225: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52 raeburn 5226: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21 raeburn 5227: Apache::lonmenu::serverform();
5228: my $forbodytag;
5229: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5230: $forcereg,$args->{'group'},
5231: $args->{'bread_crumbs'},
5232: $advtoolsref,'',\$forbodytag);
5233: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5234: $funclist = $forbodytag;
5235: }
5236: } else {
1.903 droeschl 5237:
5238: # if ($env{'request.state'} eq 'construct') {
5239: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5240: # }
5241:
1.1075.2.38 raeburn 5242: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5243: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5244:
1.1075.2.38 raeburn 5245: my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2 raeburn 5246:
1.916 droeschl 5247: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22 raeburn 5248: if ($dc_info) {
5249: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1 raeburn 5250: }
1.1075.2.38 raeburn 5251: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22 raeburn 5252: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5253: return $bodytag;
5254: }
1.894 droeschl 5255:
1.927 raeburn 5256: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38 raeburn 5257: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5258: }
1.916 droeschl 5259:
1.1075.2.38 raeburn 5260: $bodytag .= $right;
1.852 droeschl 5261:
1.917 raeburn 5262: if ($dc_info) {
5263: $dc_info = &dc_courseid_toggle($dc_info);
5264: }
5265: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5266:
1.1075.2.61 raeburn 5267: #if directed to not display the secondary menu, don't.
5268: if ($args->{'no_secondary_menu'}) {
5269: return $bodytag;
5270: }
1.903 droeschl 5271: #don't show menus for public users
1.954 raeburn 5272: if (!$public){
1.1075.2.52 raeburn 5273: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5274: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5275: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5276: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5277: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5278: $args->{'bread_crumbs'});
5279: } elsif ($forcereg) {
1.1075.2.22 raeburn 5280: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5281: $args->{'group'});
1.1075.2.15 raeburn 5282: } else {
1.1075.2.21 raeburn 5283: my $forbodytag;
5284: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5285: $forcereg,$args->{'group'},
5286: $args->{'bread_crumbs'},
5287: $advtoolsref,'',\$forbodytag);
5288: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5289: $bodytag .= $forbodytag;
5290: }
1.920 raeburn 5291: }
1.903 droeschl 5292: }else{
5293: # this is to seperate menu from content when there's no secondary
5294: # menu. Especially needed for public accessible ressources.
5295: $bodytag .= '<hr style="clear:both" />';
5296: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5297: }
1.903 droeschl 5298:
1.235 raeburn 5299: return $bodytag;
1.1075.2.12 raeburn 5300: }
5301:
5302: #
5303: # Top frame rendering, Remote is up
5304: #
5305:
5306: my $imgsrc = $img;
5307: if ($img =~ /^\/adm/) {
5308: $imgsrc = &lonhttpdurl($img);
5309: }
5310: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
5311:
1.1075.2.60 raeburn 5312: my $help=($no_inline_link?''
5313: :&Apache::loncommon::top_nav_help('Help'));
5314:
1.1075.2.12 raeburn 5315: # Explicit link to get inline menu
5316: my $menu= ($no_inline_link?''
5317: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
5318:
5319: if ($dc_info) {
5320: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5321: }
5322:
1.1075.2.38 raeburn 5323: my $name = &plainname($env{'user.name'},$env{'user.domain'});
5324: unless ($public) {
5325: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5326: undef,'LC_menubuttons_link');
5327: }
5328:
1.1075.2.12 raeburn 5329: unless ($env{'form.inhibitmenu'}) {
5330: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38 raeburn 5331: <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60 raeburn 5332: <li>$help</li>
1.1075.2.12 raeburn 5333: <li>$menu</li>
5334: </ol><div id="LC_realm"> $realm $dc_info</div>|;
5335: }
1.1075.2.13 raeburn 5336: if ($env{'request.state'} eq 'construct') {
5337: if (!$public){
5338: if ($env{'request.state'} eq 'construct') {
5339: $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5340: &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13 raeburn 5341: &Apache::lonhtmlcommon::scripttag('','end').
5342: &Apache::lonmenu::innerregister($forcereg,
5343: $args->{'bread_crumbs'});
5344: }
5345: }
5346: }
1.1075.2.21 raeburn 5347: return $bodytag."\n".$funclist;
1.182 matthew 5348: }
5349:
1.917 raeburn 5350: sub dc_courseid_toggle {
5351: my ($dc_info) = @_;
1.980 raeburn 5352: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5353: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5354: &mt('(More ...)').'</a></span>'.
5355: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5356: }
5357:
1.330 albertel 5358: sub make_attr_string {
5359: my ($register,$attr_ref) = @_;
5360:
5361: if ($attr_ref && !ref($attr_ref)) {
5362: die("addentries Must be a hash ref ".
5363: join(':',caller(1))." ".
5364: join(':',caller(0))." ");
5365: }
5366:
5367: if ($register) {
1.339 albertel 5368: my ($on_load,$on_unload);
5369: foreach my $key (keys(%{$attr_ref})) {
5370: if (lc($key) eq 'onload') {
5371: $on_load.=$attr_ref->{$key}.';';
5372: delete($attr_ref->{$key});
5373:
5374: } elsif (lc($key) eq 'onunload') {
5375: $on_unload.=$attr_ref->{$key}.';';
5376: delete($attr_ref->{$key});
5377: }
5378: }
1.1075.2.12 raeburn 5379: if ($env{'environment.remote'} eq 'on') {
5380: $attr_ref->{'onload'} =
5381: &Apache::lonmenu::loadevents(). $on_load;
5382: $attr_ref->{'onunload'}=
5383: &Apache::lonmenu::unloadevents().$on_unload;
5384: } else {
5385: $attr_ref->{'onload'} = $on_load;
5386: $attr_ref->{'onunload'}= $on_unload;
5387: }
1.330 albertel 5388: }
1.339 albertel 5389:
1.330 albertel 5390: my $attr_string;
1.1075.2.56 raeburn 5391: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5392: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5393: }
5394: return $attr_string;
5395: }
5396:
5397:
1.182 matthew 5398: ###############################################
1.251 albertel 5399: ###############################################
5400:
5401: =pod
5402:
5403: =item * &endbodytag()
5404:
5405: Returns a uniform footer for LON-CAPA web pages.
5406:
1.635 raeburn 5407: Inputs: 1 - optional reference to an args hash
5408: If in the hash, key for noredirectlink has a value which evaluates to true,
5409: a 'Continue' link is not displayed if the page contains an
5410: internal redirect in the <head></head> section,
5411: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5412:
5413: =cut
5414:
5415: sub endbodytag {
1.635 raeburn 5416: my ($args) = @_;
1.1075.2.6 raeburn 5417: my $endbodytag;
5418: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5419: $endbodytag='</body>';
5420: }
1.269 albertel 5421: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5422: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5423: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5424: $endbodytag=
5425: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5426: &mt('Continue').'</a>'.
5427: $endbodytag;
5428: }
1.315 albertel 5429: }
1.251 albertel 5430: return $endbodytag;
5431: }
5432:
1.352 albertel 5433: =pod
5434:
5435: =item * &standard_css()
5436:
5437: Returns a style sheet
5438:
5439: Inputs: (all optional)
5440: domain -> force to color decorate a page for a specific
5441: domain
5442: function -> force usage of a specific rolish color scheme
5443: bgcolor -> override the default page bgcolor
5444:
5445: =cut
5446:
1.343 albertel 5447: sub standard_css {
1.345 albertel 5448: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5449: $function = &get_users_function() if (!$function);
5450: my $img = &designparm($function.'.img', $domain);
5451: my $tabbg = &designparm($function.'.tabbg', $domain);
5452: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5453: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5454: #second colour for later usage
1.345 albertel 5455: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5456: my $pgbg_or_bgcolor =
5457: $bgcolor ||
1.352 albertel 5458: &designparm($function.'.pgbg', $domain);
1.382 albertel 5459: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5460: my $alink = &designparm($function.'.alink', $domain);
5461: my $vlink = &designparm($function.'.vlink', $domain);
5462: my $link = &designparm($function.'.link', $domain);
5463:
1.602 albertel 5464: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5465: my $mono = 'monospace';
1.850 bisitz 5466: my $data_table_head = $sidebg;
5467: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5468: my $data_table_dark = '#E0E0E0';
1.470 banghart 5469: my $data_table_darker = '#CCCCCC';
1.349 albertel 5470: my $data_table_highlight = '#FFFF00';
1.352 albertel 5471: my $mail_new = '#FFBB77';
5472: my $mail_new_hover = '#DD9955';
5473: my $mail_read = '#BBBB77';
5474: my $mail_read_hover = '#999944';
5475: my $mail_replied = '#AAAA88';
5476: my $mail_replied_hover = '#888855';
5477: my $mail_other = '#99BBBB';
5478: my $mail_other_hover = '#669999';
1.391 albertel 5479: my $table_header = '#DDDDDD';
1.489 raeburn 5480: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5481: my $lg_border_color = '#C8C8C8';
1.952 onken 5482: my $button_hover = '#BF2317';
1.392 albertel 5483:
1.608 albertel 5484: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5485: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5486: : '0 3px 0 4px';
1.448 albertel 5487:
1.523 albertel 5488:
1.343 albertel 5489: return <<END;
1.947 droeschl 5490:
5491: /* needed for iframe to allow 100% height in FF */
5492: body, html {
5493: margin: 0;
5494: padding: 0 0.5%;
5495: height: 99%; /* to avoid scrollbars */
5496: }
5497:
1.795 www 5498: body {
1.911 bisitz 5499: font-family: $sans;
5500: line-height:130%;
5501: font-size:0.83em;
5502: color:$font;
1.795 www 5503: }
5504:
1.959 onken 5505: a:focus,
5506: a:focus img {
1.795 www 5507: color: red;
5508: }
1.698 harmsja 5509:
1.911 bisitz 5510: form, .inline {
5511: display: inline;
1.795 www 5512: }
1.721 harmsja 5513:
1.795 www 5514: .LC_right {
1.911 bisitz 5515: text-align:right;
1.795 www 5516: }
5517:
5518: .LC_middle {
1.911 bisitz 5519: vertical-align:middle;
1.795 www 5520: }
1.721 harmsja 5521:
1.1075.2.38 raeburn 5522: .LC_floatleft {
5523: float: left;
5524: }
5525:
5526: .LC_floatright {
5527: float: right;
5528: }
5529:
1.911 bisitz 5530: .LC_400Box {
5531: width:400px;
5532: }
1.721 harmsja 5533:
1.947 droeschl 5534: .LC_iframecontainer {
5535: width: 98%;
5536: margin: 0;
5537: position: fixed;
5538: top: 8.5em;
5539: bottom: 0;
5540: }
5541:
5542: .LC_iframecontainer iframe{
5543: border: none;
5544: width: 100%;
5545: height: 100%;
5546: }
5547:
1.778 bisitz 5548: .LC_filename {
5549: font-family: $mono;
5550: white-space:pre;
1.921 bisitz 5551: font-size: 120%;
1.778 bisitz 5552: }
5553:
5554: .LC_fileicon {
5555: border: none;
5556: height: 1.3em;
5557: vertical-align: text-bottom;
5558: margin-right: 0.3em;
5559: text-decoration:none;
5560: }
5561:
1.1008 www 5562: .LC_setting {
5563: text-decoration:underline;
5564: }
5565:
1.350 albertel 5566: .LC_error {
5567: color: red;
5568: }
1.795 www 5569:
1.1075.2.15 raeburn 5570: .LC_warning {
5571: color: darkorange;
5572: }
5573:
1.457 albertel 5574: .LC_diff_removed {
1.733 bisitz 5575: color: red;
1.394 albertel 5576: }
1.532 albertel 5577:
5578: .LC_info,
1.457 albertel 5579: .LC_success,
5580: .LC_diff_added {
1.350 albertel 5581: color: green;
5582: }
1.795 www 5583:
1.802 bisitz 5584: div.LC_confirm_box {
5585: background-color: #FAFAFA;
5586: border: 1px solid $lg_border_color;
5587: margin-right: 0;
5588: padding: 5px;
5589: }
5590:
5591: div.LC_confirm_box .LC_error img,
5592: div.LC_confirm_box .LC_success img {
5593: vertical-align: middle;
5594: }
5595:
1.440 albertel 5596: .LC_icon {
1.771 droeschl 5597: border: none;
1.790 droeschl 5598: vertical-align: middle;
1.771 droeschl 5599: }
5600:
1.543 albertel 5601: .LC_docs_spacer {
5602: width: 25px;
5603: height: 1px;
1.771 droeschl 5604: border: none;
1.543 albertel 5605: }
1.346 albertel 5606:
1.532 albertel 5607: .LC_internal_info {
1.735 bisitz 5608: color: #999999;
1.532 albertel 5609: }
5610:
1.794 www 5611: .LC_discussion {
1.1050 www 5612: background: $data_table_dark;
1.911 bisitz 5613: border: 1px solid black;
5614: margin: 2px;
1.794 www 5615: }
5616:
5617: .LC_disc_action_left {
1.1050 www 5618: background: $sidebg;
1.911 bisitz 5619: text-align: left;
1.1050 www 5620: padding: 4px;
5621: margin: 2px;
1.794 www 5622: }
5623:
5624: .LC_disc_action_right {
1.1050 www 5625: background: $sidebg;
1.911 bisitz 5626: text-align: right;
1.1050 www 5627: padding: 4px;
5628: margin: 2px;
1.794 www 5629: }
5630:
5631: .LC_disc_new_item {
1.911 bisitz 5632: background: white;
5633: border: 2px solid red;
1.1050 www 5634: margin: 4px;
5635: padding: 4px;
1.794 www 5636: }
5637:
5638: .LC_disc_old_item {
1.911 bisitz 5639: background: white;
1.1050 www 5640: margin: 4px;
5641: padding: 4px;
1.794 www 5642: }
5643:
1.458 albertel 5644: table.LC_pastsubmission {
5645: border: 1px solid black;
5646: margin: 2px;
5647: }
5648:
1.924 bisitz 5649: table#LC_menubuttons {
1.345 albertel 5650: width: 100%;
5651: background: $pgbg;
1.392 albertel 5652: border: 2px;
1.402 albertel 5653: border-collapse: separate;
1.803 bisitz 5654: padding: 0;
1.345 albertel 5655: }
1.392 albertel 5656:
1.801 tempelho 5657: table#LC_title_bar a {
5658: color: $fontmenu;
5659: }
1.836 bisitz 5660:
1.807 droeschl 5661: table#LC_title_bar {
1.819 tempelho 5662: clear: both;
1.836 bisitz 5663: display: none;
1.807 droeschl 5664: }
5665:
1.795 www 5666: table#LC_title_bar,
1.933 droeschl 5667: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5668: table#LC_title_bar.LC_with_remote {
1.359 albertel 5669: width: 100%;
1.392 albertel 5670: border-color: $pgbg;
5671: border-style: solid;
5672: border-width: $border;
1.379 albertel 5673: background: $pgbg;
1.801 tempelho 5674: color: $fontmenu;
1.392 albertel 5675: border-collapse: collapse;
1.803 bisitz 5676: padding: 0;
1.819 tempelho 5677: margin: 0;
1.359 albertel 5678: }
1.795 www 5679:
1.933 droeschl 5680: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5681: margin: 0;
5682: padding: 0;
1.933 droeschl 5683: position: relative;
5684: list-style: none;
1.913 droeschl 5685: }
1.933 droeschl 5686: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5687: display: inline;
5688: }
1.933 droeschl 5689:
5690: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5691: padding: 0;
1.933 droeschl 5692: margin: 0;
5693: float: left;
1.913 droeschl 5694: }
1.933 droeschl 5695: .LC_breadcrumb_tools_tools {
5696: padding: 0;
5697: margin: 0;
1.913 droeschl 5698: float: right;
5699: }
5700:
1.359 albertel 5701: table#LC_title_bar td {
5702: background: $tabbg;
5703: }
1.795 www 5704:
1.911 bisitz 5705: table#LC_menubuttons img {
1.803 bisitz 5706: border: none;
1.346 albertel 5707: }
1.795 www 5708:
1.842 droeschl 5709: .LC_breadcrumbs_component {
1.911 bisitz 5710: float: right;
5711: margin: 0 1em;
1.357 albertel 5712: }
1.842 droeschl 5713: .LC_breadcrumbs_component img {
1.911 bisitz 5714: vertical-align: middle;
1.777 tempelho 5715: }
1.795 www 5716:
1.383 albertel 5717: td.LC_table_cell_checkbox {
5718: text-align: center;
5719: }
1.795 www 5720:
5721: .LC_fontsize_small {
1.911 bisitz 5722: font-size: 70%;
1.705 tempelho 5723: }
5724:
1.844 bisitz 5725: #LC_breadcrumbs {
1.911 bisitz 5726: clear:both;
5727: background: $sidebg;
5728: border-bottom: 1px solid $lg_border_color;
5729: line-height: 2.5em;
1.933 droeschl 5730: overflow: hidden;
1.911 bisitz 5731: margin: 0;
5732: padding: 0;
1.995 raeburn 5733: text-align: left;
1.819 tempelho 5734: }
1.862 bisitz 5735:
1.1075.2.16 raeburn 5736: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5737: clear:both;
5738: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5739: border: 1px solid $sidebg;
1.1075.2.16 raeburn 5740: margin: 0 0 10px 0;
1.966 bisitz 5741: padding: 3px;
1.995 raeburn 5742: text-align: left;
1.822 bisitz 5743: }
5744:
1.795 www 5745: .LC_fontsize_medium {
1.911 bisitz 5746: font-size: 85%;
1.705 tempelho 5747: }
5748:
1.795 www 5749: .LC_fontsize_large {
1.911 bisitz 5750: font-size: 120%;
1.705 tempelho 5751: }
5752:
1.346 albertel 5753: .LC_menubuttons_inline_text {
5754: color: $font;
1.698 harmsja 5755: font-size: 90%;
1.701 harmsja 5756: padding-left:3px;
1.346 albertel 5757: }
5758:
1.934 droeschl 5759: .LC_menubuttons_inline_text img{
5760: vertical-align: middle;
5761: }
5762:
1.1051 www 5763: li.LC_menubuttons_inline_text img {
1.951 onken 5764: cursor:pointer;
1.1002 droeschl 5765: text-decoration: none;
1.951 onken 5766: }
5767:
1.526 www 5768: .LC_menubuttons_link {
5769: text-decoration: none;
5770: }
1.795 www 5771:
1.522 albertel 5772: .LC_menubuttons_category {
1.521 www 5773: color: $font;
1.526 www 5774: background: $pgbg;
1.521 www 5775: font-size: larger;
5776: font-weight: bold;
5777: }
5778:
1.346 albertel 5779: td.LC_menubuttons_text {
1.911 bisitz 5780: color: $font;
1.346 albertel 5781: }
1.706 harmsja 5782:
1.346 albertel 5783: .LC_current_location {
5784: background: $tabbg;
5785: }
1.795 www 5786:
1.938 bisitz 5787: table.LC_data_table {
1.347 albertel 5788: border: 1px solid #000000;
1.402 albertel 5789: border-collapse: separate;
1.426 albertel 5790: border-spacing: 1px;
1.610 albertel 5791: background: $pgbg;
1.347 albertel 5792: }
1.795 www 5793:
1.422 albertel 5794: .LC_data_table_dense {
5795: font-size: small;
5796: }
1.795 www 5797:
1.507 raeburn 5798: table.LC_nested_outer {
5799: border: 1px solid #000000;
1.589 raeburn 5800: border-collapse: collapse;
1.803 bisitz 5801: border-spacing: 0;
1.507 raeburn 5802: width: 100%;
5803: }
1.795 www 5804:
1.879 raeburn 5805: table.LC_innerpickbox,
1.507 raeburn 5806: table.LC_nested {
1.803 bisitz 5807: border: none;
1.589 raeburn 5808: border-collapse: collapse;
1.803 bisitz 5809: border-spacing: 0;
1.507 raeburn 5810: width: 100%;
5811: }
1.795 www 5812:
1.911 bisitz 5813: table.LC_data_table tr th,
5814: table.LC_calendar tr th,
1.879 raeburn 5815: table.LC_prior_tries tr th,
5816: table.LC_innerpickbox tr th {
1.349 albertel 5817: font-weight: bold;
5818: background-color: $data_table_head;
1.801 tempelho 5819: color:$fontmenu;
1.701 harmsja 5820: font-size:90%;
1.347 albertel 5821: }
1.795 www 5822:
1.879 raeburn 5823: table.LC_innerpickbox tr th,
5824: table.LC_innerpickbox tr td {
5825: vertical-align: top;
5826: }
5827:
1.711 raeburn 5828: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5829: background-color: #CCCCCC;
1.711 raeburn 5830: font-weight: bold;
5831: text-align: left;
5832: }
1.795 www 5833:
1.912 bisitz 5834: table.LC_data_table tr.LC_odd_row > td {
5835: background-color: $data_table_light;
5836: padding: 2px;
5837: vertical-align: top;
5838: }
5839:
1.809 bisitz 5840: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5841: background-color: $data_table_light;
1.912 bisitz 5842: vertical-align: top;
5843: }
5844:
5845: table.LC_data_table tr.LC_even_row > td {
5846: background-color: $data_table_dark;
1.425 albertel 5847: padding: 2px;
1.900 bisitz 5848: vertical-align: top;
1.347 albertel 5849: }
1.795 www 5850:
1.809 bisitz 5851: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5852: background-color: $data_table_dark;
1.900 bisitz 5853: vertical-align: top;
1.347 albertel 5854: }
1.795 www 5855:
1.425 albertel 5856: table.LC_data_table tr.LC_data_table_highlight td {
5857: background-color: $data_table_darker;
5858: }
1.795 www 5859:
1.639 raeburn 5860: table.LC_data_table tr td.LC_leftcol_header {
5861: background-color: $data_table_head;
5862: font-weight: bold;
5863: }
1.795 www 5864:
1.451 albertel 5865: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5866: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5867: font-weight: bold;
5868: font-style: italic;
5869: text-align: center;
5870: padding: 8px;
1.347 albertel 5871: }
1.795 www 5872:
1.1075.2.30 raeburn 5873: table.LC_data_table tr.LC_empty_row td,
5874: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5875: background-color: $sidebg;
5876: }
5877:
5878: table.LC_nested tr.LC_empty_row td {
5879: background-color: #FFFFFF;
5880: }
5881:
1.890 droeschl 5882: table.LC_caption {
5883: }
5884:
1.507 raeburn 5885: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5886: padding: 4ex
5887: }
1.795 www 5888:
1.507 raeburn 5889: table.LC_nested_outer tr th {
5890: font-weight: bold;
1.801 tempelho 5891: color:$fontmenu;
1.507 raeburn 5892: background-color: $data_table_head;
1.701 harmsja 5893: font-size: small;
1.507 raeburn 5894: border-bottom: 1px solid #000000;
5895: }
1.795 www 5896:
1.507 raeburn 5897: table.LC_nested_outer tr td.LC_subheader {
5898: background-color: $data_table_head;
5899: font-weight: bold;
5900: font-size: small;
5901: border-bottom: 1px solid #000000;
5902: text-align: right;
1.451 albertel 5903: }
1.795 www 5904:
1.507 raeburn 5905: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5906: background-color: #CCCCCC;
1.451 albertel 5907: font-weight: bold;
5908: font-size: small;
1.507 raeburn 5909: text-align: center;
5910: }
1.795 www 5911:
1.589 raeburn 5912: table.LC_nested tr.LC_info_row td.LC_left_item,
5913: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5914: text-align: left;
1.451 albertel 5915: }
1.795 www 5916:
1.507 raeburn 5917: table.LC_nested td {
1.735 bisitz 5918: background-color: #FFFFFF;
1.451 albertel 5919: font-size: small;
1.507 raeburn 5920: }
1.795 www 5921:
1.507 raeburn 5922: table.LC_nested_outer tr th.LC_right_item,
5923: table.LC_nested tr.LC_info_row td.LC_right_item,
5924: table.LC_nested tr.LC_odd_row td.LC_right_item,
5925: table.LC_nested tr td.LC_right_item {
1.451 albertel 5926: text-align: right;
5927: }
5928:
1.507 raeburn 5929: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5930: background-color: #EEEEEE;
1.451 albertel 5931: }
5932:
1.473 raeburn 5933: table.LC_createuser {
5934: }
5935:
5936: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5937: font-size: small;
1.473 raeburn 5938: }
5939:
5940: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5941: background-color: #CCCCCC;
1.473 raeburn 5942: font-weight: bold;
5943: text-align: center;
5944: }
5945:
1.349 albertel 5946: table.LC_calendar {
5947: border: 1px solid #000000;
5948: border-collapse: collapse;
1.917 raeburn 5949: width: 98%;
1.349 albertel 5950: }
1.795 www 5951:
1.349 albertel 5952: table.LC_calendar_pickdate {
5953: font-size: xx-small;
5954: }
1.795 www 5955:
1.349 albertel 5956: table.LC_calendar tr td {
5957: border: 1px solid #000000;
5958: vertical-align: top;
1.917 raeburn 5959: width: 14%;
1.349 albertel 5960: }
1.795 www 5961:
1.349 albertel 5962: table.LC_calendar tr td.LC_calendar_day_empty {
5963: background-color: $data_table_dark;
5964: }
1.795 www 5965:
1.779 bisitz 5966: table.LC_calendar tr td.LC_calendar_day_current {
5967: background-color: $data_table_highlight;
1.777 tempelho 5968: }
1.795 www 5969:
1.938 bisitz 5970: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5971: background-color: $mail_new;
5972: }
1.795 www 5973:
1.938 bisitz 5974: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5975: background-color: $mail_new_hover;
5976: }
1.795 www 5977:
1.938 bisitz 5978: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5979: background-color: $mail_read;
5980: }
1.795 www 5981:
1.938 bisitz 5982: /*
5983: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5984: background-color: $mail_read_hover;
5985: }
1.938 bisitz 5986: */
1.795 www 5987:
1.938 bisitz 5988: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5989: background-color: $mail_replied;
5990: }
1.795 www 5991:
1.938 bisitz 5992: /*
5993: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5994: background-color: $mail_replied_hover;
5995: }
1.938 bisitz 5996: */
1.795 www 5997:
1.938 bisitz 5998: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5999: background-color: $mail_other;
6000: }
1.795 www 6001:
1.938 bisitz 6002: /*
6003: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6004: background-color: $mail_other_hover;
6005: }
1.938 bisitz 6006: */
1.494 raeburn 6007:
1.777 tempelho 6008: table.LC_data_table tr > td.LC_browser_file,
6009: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6010: background: #AAEE77;
1.389 albertel 6011: }
1.795 www 6012:
1.777 tempelho 6013: table.LC_data_table tr > td.LC_browser_file_locked,
6014: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6015: background: #FFAA99;
1.387 albertel 6016: }
1.795 www 6017:
1.777 tempelho 6018: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6019: background: #888888;
1.779 bisitz 6020: }
1.795 www 6021:
1.777 tempelho 6022: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6023: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6024: background: #F8F866;
1.777 tempelho 6025: }
1.795 www 6026:
1.696 bisitz 6027: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6028: background: #E0E8FF;
1.387 albertel 6029: }
1.696 bisitz 6030:
1.707 bisitz 6031: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6032: /* background: #77FF77; */
1.707 bisitz 6033: }
1.795 www 6034:
1.707 bisitz 6035: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6036: border-right: 8px solid #FFFF77;
1.707 bisitz 6037: }
1.795 www 6038:
1.707 bisitz 6039: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6040: border-right: 8px solid #FFAA77;
1.707 bisitz 6041: }
1.795 www 6042:
1.707 bisitz 6043: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6044: border-right: 8px solid #FF7777;
1.707 bisitz 6045: }
1.795 www 6046:
1.707 bisitz 6047: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6048: border-right: 8px solid #AAFF77;
1.707 bisitz 6049: }
1.795 www 6050:
1.707 bisitz 6051: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6052: border-right: 8px solid #11CC55;
1.707 bisitz 6053: }
6054:
1.388 albertel 6055: span.LC_current_location {
1.701 harmsja 6056: font-size:larger;
1.388 albertel 6057: background: $pgbg;
6058: }
1.387 albertel 6059:
1.1029 www 6060: span.LC_current_nav_location {
6061: font-weight:bold;
6062: background: $sidebg;
6063: }
6064:
1.395 albertel 6065: span.LC_parm_menu_item {
6066: font-size: larger;
6067: }
1.795 www 6068:
1.395 albertel 6069: span.LC_parm_scope_all {
6070: color: red;
6071: }
1.795 www 6072:
1.395 albertel 6073: span.LC_parm_scope_folder {
6074: color: green;
6075: }
1.795 www 6076:
1.395 albertel 6077: span.LC_parm_scope_resource {
6078: color: orange;
6079: }
1.795 www 6080:
1.395 albertel 6081: span.LC_parm_part {
6082: color: blue;
6083: }
1.795 www 6084:
1.911 bisitz 6085: span.LC_parm_folder,
6086: span.LC_parm_symb {
1.395 albertel 6087: font-size: x-small;
6088: font-family: $mono;
6089: color: #AAAAAA;
6090: }
6091:
1.977 bisitz 6092: ul.LC_parm_parmlist li {
6093: display: inline-block;
6094: padding: 0.3em 0.8em;
6095: vertical-align: top;
6096: width: 150px;
6097: border-top:1px solid $lg_border_color;
6098: }
6099:
1.795 www 6100: td.LC_parm_overview_level_menu,
6101: td.LC_parm_overview_map_menu,
6102: td.LC_parm_overview_parm_selectors,
6103: td.LC_parm_overview_restrictions {
1.396 albertel 6104: border: 1px solid black;
6105: border-collapse: collapse;
6106: }
1.795 www 6107:
1.396 albertel 6108: table.LC_parm_overview_restrictions td {
6109: border-width: 1px 4px 1px 4px;
6110: border-style: solid;
6111: border-color: $pgbg;
6112: text-align: center;
6113: }
1.795 www 6114:
1.396 albertel 6115: table.LC_parm_overview_restrictions th {
6116: background: $tabbg;
6117: border-width: 1px 4px 1px 4px;
6118: border-style: solid;
6119: border-color: $pgbg;
6120: }
1.795 www 6121:
1.398 albertel 6122: table#LC_helpmenu {
1.803 bisitz 6123: border: none;
1.398 albertel 6124: height: 55px;
1.803 bisitz 6125: border-spacing: 0;
1.398 albertel 6126: }
6127:
6128: table#LC_helpmenu fieldset legend {
6129: font-size: larger;
6130: }
1.795 www 6131:
1.397 albertel 6132: table#LC_helpmenu_links {
6133: width: 100%;
6134: border: 1px solid black;
6135: background: $pgbg;
1.803 bisitz 6136: padding: 0;
1.397 albertel 6137: border-spacing: 1px;
6138: }
1.795 www 6139:
1.397 albertel 6140: table#LC_helpmenu_links tr td {
6141: padding: 1px;
6142: background: $tabbg;
1.399 albertel 6143: text-align: center;
6144: font-weight: bold;
1.397 albertel 6145: }
1.396 albertel 6146:
1.795 www 6147: table#LC_helpmenu_links a:link,
6148: table#LC_helpmenu_links a:visited,
1.397 albertel 6149: table#LC_helpmenu_links a:active {
6150: text-decoration: none;
6151: color: $font;
6152: }
1.795 www 6153:
1.397 albertel 6154: table#LC_helpmenu_links a:hover {
6155: text-decoration: underline;
6156: color: $vlink;
6157: }
1.396 albertel 6158:
1.417 albertel 6159: .LC_chrt_popup_exists {
6160: border: 1px solid #339933;
6161: margin: -1px;
6162: }
1.795 www 6163:
1.417 albertel 6164: .LC_chrt_popup_up {
6165: border: 1px solid yellow;
6166: margin: -1px;
6167: }
1.795 www 6168:
1.417 albertel 6169: .LC_chrt_popup {
6170: border: 1px solid #8888FF;
6171: background: #CCCCFF;
6172: }
1.795 www 6173:
1.421 albertel 6174: table.LC_pick_box {
6175: border-collapse: separate;
6176: background: white;
6177: border: 1px solid black;
6178: border-spacing: 1px;
6179: }
1.795 www 6180:
1.421 albertel 6181: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6182: background: $sidebg;
1.421 albertel 6183: font-weight: bold;
1.900 bisitz 6184: text-align: left;
1.740 bisitz 6185: vertical-align: top;
1.421 albertel 6186: width: 184px;
6187: padding: 8px;
6188: }
1.795 www 6189:
1.579 raeburn 6190: table.LC_pick_box td.LC_pick_box_value {
6191: text-align: left;
6192: padding: 8px;
6193: }
1.795 www 6194:
1.579 raeburn 6195: table.LC_pick_box td.LC_pick_box_select {
6196: text-align: left;
6197: padding: 8px;
6198: }
1.795 www 6199:
1.424 albertel 6200: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6201: padding: 0;
1.421 albertel 6202: height: 1px;
6203: background: black;
6204: }
1.795 www 6205:
1.421 albertel 6206: table.LC_pick_box td.LC_pick_box_submit {
6207: text-align: right;
6208: }
1.795 www 6209:
1.579 raeburn 6210: table.LC_pick_box td.LC_evenrow_value {
6211: text-align: left;
6212: padding: 8px;
6213: background-color: $data_table_light;
6214: }
1.795 www 6215:
1.579 raeburn 6216: table.LC_pick_box td.LC_oddrow_value {
6217: text-align: left;
6218: padding: 8px;
6219: background-color: $data_table_light;
6220: }
1.795 www 6221:
1.579 raeburn 6222: span.LC_helpform_receipt_cat {
6223: font-weight: bold;
6224: }
1.795 www 6225:
1.424 albertel 6226: table.LC_group_priv_box {
6227: background: white;
6228: border: 1px solid black;
6229: border-spacing: 1px;
6230: }
1.795 www 6231:
1.424 albertel 6232: table.LC_group_priv_box td.LC_pick_box_title {
6233: background: $tabbg;
6234: font-weight: bold;
6235: text-align: right;
6236: width: 184px;
6237: }
1.795 www 6238:
1.424 albertel 6239: table.LC_group_priv_box td.LC_groups_fixed {
6240: background: $data_table_light;
6241: text-align: center;
6242: }
1.795 www 6243:
1.424 albertel 6244: table.LC_group_priv_box td.LC_groups_optional {
6245: background: $data_table_dark;
6246: text-align: center;
6247: }
1.795 www 6248:
1.424 albertel 6249: table.LC_group_priv_box td.LC_groups_functionality {
6250: background: $data_table_darker;
6251: text-align: center;
6252: font-weight: bold;
6253: }
1.795 www 6254:
1.424 albertel 6255: table.LC_group_priv td {
6256: text-align: left;
1.803 bisitz 6257: padding: 0;
1.424 albertel 6258: }
6259:
6260: .LC_navbuttons {
6261: margin: 2ex 0ex 2ex 0ex;
6262: }
1.795 www 6263:
1.423 albertel 6264: .LC_topic_bar {
6265: font-weight: bold;
6266: background: $tabbg;
1.918 wenzelju 6267: margin: 1em 0em 1em 2em;
1.805 bisitz 6268: padding: 3px;
1.918 wenzelju 6269: font-size: 1.2em;
1.423 albertel 6270: }
1.795 www 6271:
1.423 albertel 6272: .LC_topic_bar span {
1.918 wenzelju 6273: left: 0.5em;
6274: position: absolute;
1.423 albertel 6275: vertical-align: middle;
1.918 wenzelju 6276: font-size: 1.2em;
1.423 albertel 6277: }
1.795 www 6278:
1.423 albertel 6279: table.LC_course_group_status {
6280: margin: 20px;
6281: }
1.795 www 6282:
1.423 albertel 6283: table.LC_status_selector td {
6284: vertical-align: top;
6285: text-align: center;
1.424 albertel 6286: padding: 4px;
6287: }
1.795 www 6288:
1.599 albertel 6289: div.LC_feedback_link {
1.616 albertel 6290: clear: both;
1.829 kalberla 6291: background: $sidebg;
1.779 bisitz 6292: width: 100%;
1.829 kalberla 6293: padding-bottom: 10px;
6294: border: 1px $tabbg solid;
1.833 kalberla 6295: height: 22px;
6296: line-height: 22px;
6297: padding-top: 5px;
6298: }
6299:
6300: div.LC_feedback_link img {
6301: height: 22px;
1.867 kalberla 6302: vertical-align:middle;
1.829 kalberla 6303: }
6304:
1.911 bisitz 6305: div.LC_feedback_link a {
1.829 kalberla 6306: text-decoration: none;
1.489 raeburn 6307: }
1.795 www 6308:
1.867 kalberla 6309: div.LC_comblock {
1.911 bisitz 6310: display:inline;
1.867 kalberla 6311: color:$font;
6312: font-size:90%;
6313: }
6314:
6315: div.LC_feedback_link div.LC_comblock {
6316: padding-left:5px;
6317: }
6318:
6319: div.LC_feedback_link div.LC_comblock a {
6320: color:$font;
6321: }
6322:
1.489 raeburn 6323: span.LC_feedback_link {
1.858 bisitz 6324: /* background: $feedback_link_bg; */
1.599 albertel 6325: font-size: larger;
6326: }
1.795 www 6327:
1.599 albertel 6328: span.LC_message_link {
1.858 bisitz 6329: /* background: $feedback_link_bg; */
1.599 albertel 6330: font-size: larger;
6331: position: absolute;
6332: right: 1em;
1.489 raeburn 6333: }
1.421 albertel 6334:
1.515 albertel 6335: table.LC_prior_tries {
1.524 albertel 6336: border: 1px solid #000000;
6337: border-collapse: separate;
6338: border-spacing: 1px;
1.515 albertel 6339: }
1.523 albertel 6340:
1.515 albertel 6341: table.LC_prior_tries td {
1.524 albertel 6342: padding: 2px;
1.515 albertel 6343: }
1.523 albertel 6344:
6345: .LC_answer_correct {
1.795 www 6346: background: lightgreen;
6347: color: darkgreen;
6348: padding: 6px;
1.523 albertel 6349: }
1.795 www 6350:
1.523 albertel 6351: .LC_answer_charged_try {
1.797 www 6352: background: #FFAAAA;
1.795 www 6353: color: darkred;
6354: padding: 6px;
1.523 albertel 6355: }
1.795 www 6356:
1.779 bisitz 6357: .LC_answer_not_charged_try,
1.523 albertel 6358: .LC_answer_no_grade,
6359: .LC_answer_late {
1.795 www 6360: background: lightyellow;
1.523 albertel 6361: color: black;
1.795 www 6362: padding: 6px;
1.523 albertel 6363: }
1.795 www 6364:
1.523 albertel 6365: .LC_answer_previous {
1.795 www 6366: background: lightblue;
6367: color: darkblue;
6368: padding: 6px;
1.523 albertel 6369: }
1.795 www 6370:
1.779 bisitz 6371: .LC_answer_no_message {
1.777 tempelho 6372: background: #FFFFFF;
6373: color: black;
1.795 www 6374: padding: 6px;
1.779 bisitz 6375: }
1.795 www 6376:
1.779 bisitz 6377: .LC_answer_unknown {
6378: background: orange;
6379: color: black;
1.795 www 6380: padding: 6px;
1.777 tempelho 6381: }
1.795 www 6382:
1.529 albertel 6383: span.LC_prior_numerical,
6384: span.LC_prior_string,
6385: span.LC_prior_custom,
6386: span.LC_prior_reaction,
6387: span.LC_prior_math {
1.925 bisitz 6388: font-family: $mono;
1.523 albertel 6389: white-space: pre;
6390: }
6391:
1.525 albertel 6392: span.LC_prior_string {
1.925 bisitz 6393: font-family: $mono;
1.525 albertel 6394: white-space: pre;
6395: }
6396:
1.523 albertel 6397: table.LC_prior_option {
6398: width: 100%;
6399: border-collapse: collapse;
6400: }
1.795 www 6401:
1.911 bisitz 6402: table.LC_prior_rank,
1.795 www 6403: table.LC_prior_match {
1.528 albertel 6404: border-collapse: collapse;
6405: }
1.795 www 6406:
1.528 albertel 6407: table.LC_prior_option tr td,
6408: table.LC_prior_rank tr td,
6409: table.LC_prior_match tr td {
1.524 albertel 6410: border: 1px solid #000000;
1.515 albertel 6411: }
6412:
1.855 bisitz 6413: .LC_nobreak {
1.544 albertel 6414: white-space: nowrap;
1.519 raeburn 6415: }
6416:
1.576 raeburn 6417: span.LC_cusr_emph {
6418: font-style: italic;
6419: }
6420:
1.633 raeburn 6421: span.LC_cusr_subheading {
6422: font-weight: normal;
6423: font-size: 85%;
6424: }
6425:
1.861 bisitz 6426: div.LC_docs_entry_move {
1.859 bisitz 6427: border: 1px solid #BBBBBB;
1.545 albertel 6428: background: #DDDDDD;
1.861 bisitz 6429: width: 22px;
1.859 bisitz 6430: padding: 1px;
6431: margin: 0;
1.545 albertel 6432: }
6433:
1.861 bisitz 6434: table.LC_data_table tr > td.LC_docs_entry_commands,
6435: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6436: font-size: x-small;
6437: }
1.795 www 6438:
1.861 bisitz 6439: .LC_docs_entry_parameter {
6440: white-space: nowrap;
6441: }
6442:
1.544 albertel 6443: .LC_docs_copy {
1.545 albertel 6444: color: #000099;
1.544 albertel 6445: }
1.795 www 6446:
1.544 albertel 6447: .LC_docs_cut {
1.545 albertel 6448: color: #550044;
1.544 albertel 6449: }
1.795 www 6450:
1.544 albertel 6451: .LC_docs_rename {
1.545 albertel 6452: color: #009900;
1.544 albertel 6453: }
1.795 www 6454:
1.544 albertel 6455: .LC_docs_remove {
1.545 albertel 6456: color: #990000;
6457: }
6458:
1.547 albertel 6459: .LC_docs_reinit_warn,
6460: .LC_docs_ext_edit {
6461: font-size: x-small;
6462: }
6463:
1.545 albertel 6464: table.LC_docs_adddocs td,
6465: table.LC_docs_adddocs th {
6466: border: 1px solid #BBBBBB;
6467: padding: 4px;
6468: background: #DDDDDD;
1.543 albertel 6469: }
6470:
1.584 albertel 6471: table.LC_sty_begin {
6472: background: #BBFFBB;
6473: }
1.795 www 6474:
1.584 albertel 6475: table.LC_sty_end {
6476: background: #FFBBBB;
6477: }
6478:
1.589 raeburn 6479: table.LC_double_column {
1.803 bisitz 6480: border-width: 0;
1.589 raeburn 6481: border-collapse: collapse;
6482: width: 100%;
6483: padding: 2px;
6484: }
6485:
6486: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6487: top: 2px;
1.589 raeburn 6488: left: 2px;
6489: width: 47%;
6490: vertical-align: top;
6491: }
6492:
6493: table.LC_double_column tr td.LC_right_col {
6494: top: 2px;
1.779 bisitz 6495: right: 2px;
1.589 raeburn 6496: width: 47%;
6497: vertical-align: top;
6498: }
6499:
1.591 raeburn 6500: div.LC_left_float {
6501: float: left;
6502: padding-right: 5%;
1.597 albertel 6503: padding-bottom: 4px;
1.591 raeburn 6504: }
6505:
6506: div.LC_clear_float_header {
1.597 albertel 6507: padding-bottom: 2px;
1.591 raeburn 6508: }
6509:
6510: div.LC_clear_float_footer {
1.597 albertel 6511: padding-top: 10px;
1.591 raeburn 6512: clear: both;
6513: }
6514:
1.597 albertel 6515: div.LC_grade_show_user {
1.941 bisitz 6516: /* border-left: 5px solid $sidebg; */
6517: border-top: 5px solid #000000;
6518: margin: 50px 0 0 0;
1.936 bisitz 6519: padding: 15px 0 5px 10px;
1.597 albertel 6520: }
1.795 www 6521:
1.936 bisitz 6522: div.LC_grade_show_user_odd_row {
1.941 bisitz 6523: /* border-left: 5px solid #000000; */
6524: }
6525:
6526: div.LC_grade_show_user div.LC_Box {
6527: margin-right: 50px;
1.597 albertel 6528: }
6529:
6530: div.LC_grade_submissions,
6531: div.LC_grade_message_center,
1.936 bisitz 6532: div.LC_grade_info_links {
1.597 albertel 6533: margin: 5px;
6534: width: 99%;
6535: background: #FFFFFF;
6536: }
1.795 www 6537:
1.597 albertel 6538: div.LC_grade_submissions_header,
1.936 bisitz 6539: div.LC_grade_message_center_header {
1.705 tempelho 6540: font-weight: bold;
6541: font-size: large;
1.597 albertel 6542: }
1.795 www 6543:
1.597 albertel 6544: div.LC_grade_submissions_body,
1.936 bisitz 6545: div.LC_grade_message_center_body {
1.597 albertel 6546: border: 1px solid black;
6547: width: 99%;
6548: background: #FFFFFF;
6549: }
1.795 www 6550:
1.613 albertel 6551: table.LC_scantron_action {
6552: width: 100%;
6553: }
1.795 www 6554:
1.613 albertel 6555: table.LC_scantron_action tr th {
1.698 harmsja 6556: font-weight:bold;
6557: font-style:normal;
1.613 albertel 6558: }
1.795 www 6559:
1.779 bisitz 6560: .LC_edit_problem_header,
1.614 albertel 6561: div.LC_edit_problem_footer {
1.705 tempelho 6562: font-weight: normal;
6563: font-size: medium;
1.602 albertel 6564: margin: 2px;
1.1060 bisitz 6565: background-color: $sidebg;
1.600 albertel 6566: }
1.795 www 6567:
1.600 albertel 6568: div.LC_edit_problem_header,
1.602 albertel 6569: div.LC_edit_problem_header div,
1.614 albertel 6570: div.LC_edit_problem_footer,
6571: div.LC_edit_problem_footer div,
1.602 albertel 6572: div.LC_edit_problem_editxml_header,
6573: div.LC_edit_problem_editxml_header div {
1.600 albertel 6574: margin-top: 5px;
6575: }
1.795 www 6576:
1.600 albertel 6577: div.LC_edit_problem_header_title {
1.705 tempelho 6578: font-weight: bold;
6579: font-size: larger;
1.602 albertel 6580: background: $tabbg;
6581: padding: 3px;
1.1060 bisitz 6582: margin: 0 0 5px 0;
1.602 albertel 6583: }
1.795 www 6584:
1.602 albertel 6585: table.LC_edit_problem_header_title {
6586: width: 100%;
1.600 albertel 6587: background: $tabbg;
1.602 albertel 6588: }
6589:
6590: div.LC_edit_problem_discards {
6591: float: left;
6592: padding-bottom: 5px;
6593: }
1.795 www 6594:
1.602 albertel 6595: div.LC_edit_problem_saves {
6596: float: right;
6597: padding-bottom: 5px;
1.600 albertel 6598: }
1.795 www 6599:
1.1075.2.34 raeburn 6600: .LC_edit_opt {
6601: padding-left: 1em;
6602: white-space: nowrap;
6603: }
6604:
1.1075.2.57 raeburn 6605: .LC_edit_problem_latexhelper{
6606: text-align: right;
6607: }
6608:
6609: #LC_edit_problem_colorful div{
6610: margin-left: 40px;
6611: }
6612:
1.911 bisitz 6613: img.stift {
1.803 bisitz 6614: border-width: 0;
6615: vertical-align: middle;
1.677 riegler 6616: }
1.680 riegler 6617:
1.923 bisitz 6618: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6619: vertical-align: top;
1.777 tempelho 6620: }
1.795 www 6621:
1.716 raeburn 6622: div.LC_createcourse {
1.911 bisitz 6623: margin: 10px 10px 10px 10px;
1.716 raeburn 6624: }
6625:
1.917 raeburn 6626: .LC_dccid {
1.1075.2.38 raeburn 6627: float: right;
1.917 raeburn 6628: margin: 0.2em 0 0 0;
6629: padding: 0;
6630: font-size: 90%;
6631: display:none;
6632: }
6633:
1.897 wenzelju 6634: ol.LC_primary_menu a:hover,
1.721 harmsja 6635: ol#LC_MenuBreadcrumbs a:hover,
6636: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6637: ul#LC_secondary_menu a:hover,
1.721 harmsja 6638: .LC_FormSectionClearButton input:hover
1.795 www 6639: ul.LC_TabContent li:hover a {
1.952 onken 6640: color:$button_hover;
1.911 bisitz 6641: text-decoration:none;
1.693 droeschl 6642: }
6643:
1.779 bisitz 6644: h1 {
1.911 bisitz 6645: padding: 0;
6646: line-height:130%;
1.693 droeschl 6647: }
1.698 harmsja 6648:
1.911 bisitz 6649: h2,
6650: h3,
6651: h4,
6652: h5,
6653: h6 {
6654: margin: 5px 0 5px 0;
6655: padding: 0;
6656: line-height:130%;
1.693 droeschl 6657: }
1.795 www 6658:
6659: .LC_hcell {
1.911 bisitz 6660: padding:3px 15px 3px 15px;
6661: margin: 0;
6662: background-color:$tabbg;
6663: color:$fontmenu;
6664: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6665: }
1.795 www 6666:
1.840 bisitz 6667: .LC_Box > .LC_hcell {
1.911 bisitz 6668: margin: 0 -10px 10px -10px;
1.835 bisitz 6669: }
6670:
1.721 harmsja 6671: .LC_noBorder {
1.911 bisitz 6672: border: 0;
1.698 harmsja 6673: }
1.693 droeschl 6674:
1.721 harmsja 6675: .LC_FormSectionClearButton input {
1.911 bisitz 6676: background-color:transparent;
6677: border: none;
6678: cursor:pointer;
6679: text-decoration:underline;
1.693 droeschl 6680: }
1.763 bisitz 6681:
6682: .LC_help_open_topic {
1.911 bisitz 6683: color: #FFFFFF;
6684: background-color: #EEEEFF;
6685: margin: 1px;
6686: padding: 4px;
6687: border: 1px solid #000033;
6688: white-space: nowrap;
6689: /* vertical-align: middle; */
1.759 neumanie 6690: }
1.693 droeschl 6691:
1.911 bisitz 6692: dl,
6693: ul,
6694: div,
6695: fieldset {
6696: margin: 10px 10px 10px 0;
6697: /* overflow: hidden; */
1.693 droeschl 6698: }
1.795 www 6699:
1.1075.2.90 raeburn 6700: article.geogebraweb div {
6701: margin: 0;
6702: }
6703:
1.838 bisitz 6704: fieldset > legend {
1.911 bisitz 6705: font-weight: bold;
6706: padding: 0 5px 0 5px;
1.838 bisitz 6707: }
6708:
1.813 bisitz 6709: #LC_nav_bar {
1.911 bisitz 6710: float: left;
1.995 raeburn 6711: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6712: margin: 0 0 2px 0;
1.807 droeschl 6713: }
6714:
1.916 droeschl 6715: #LC_realm {
6716: margin: 0.2em 0 0 0;
6717: padding: 0;
6718: font-weight: bold;
6719: text-align: center;
1.995 raeburn 6720: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6721: }
6722:
1.911 bisitz 6723: #LC_nav_bar em {
6724: font-weight: bold;
6725: font-style: normal;
1.807 droeschl 6726: }
6727:
1.897 wenzelju 6728: ol.LC_primary_menu {
1.934 droeschl 6729: margin: 0;
1.1075.2.2 raeburn 6730: padding: 0;
1.995 raeburn 6731: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6732: }
6733:
1.852 droeschl 6734: ol#LC_PathBreadcrumbs {
1.911 bisitz 6735: margin: 0;
1.693 droeschl 6736: }
6737:
1.897 wenzelju 6738: ol.LC_primary_menu li {
1.1075.2.2 raeburn 6739: color: RGB(80, 80, 80);
6740: vertical-align: middle;
6741: text-align: left;
6742: list-style: none;
6743: float: left;
6744: }
6745:
6746: ol.LC_primary_menu li a {
6747: display: block;
6748: margin: 0;
6749: padding: 0 5px 0 10px;
6750: text-decoration: none;
6751: }
6752:
6753: ol.LC_primary_menu li ul {
6754: display: none;
6755: width: 10em;
6756: background-color: $data_table_light;
6757: }
6758:
6759: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6760: display: block;
6761: position: absolute;
6762: margin: 0;
6763: padding: 0;
1.1075.2.5 raeburn 6764: z-index: 2;
1.1075.2.2 raeburn 6765: }
6766:
6767: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6768: font-size: 90%;
1.911 bisitz 6769: vertical-align: top;
1.1075.2.2 raeburn 6770: float: none;
1.1075.2.5 raeburn 6771: border-left: 1px solid black;
6772: border-right: 1px solid black;
1.1075.2.2 raeburn 6773: }
6774:
6775: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5 raeburn 6776: background-color:$data_table_light;
1.1075.2.2 raeburn 6777: }
6778:
6779: ol.LC_primary_menu li li a:hover {
6780: color:$button_hover;
6781: background-color:$data_table_dark;
1.693 droeschl 6782: }
6783:
1.897 wenzelju 6784: ol.LC_primary_menu li img {
1.911 bisitz 6785: vertical-align: bottom;
1.934 droeschl 6786: height: 1.1em;
1.1075.2.3 raeburn 6787: margin: 0.2em 0 0 0;
1.693 droeschl 6788: }
6789:
1.897 wenzelju 6790: ol.LC_primary_menu a {
1.911 bisitz 6791: color: RGB(80, 80, 80);
6792: text-decoration: none;
1.693 droeschl 6793: }
1.795 www 6794:
1.949 droeschl 6795: ol.LC_primary_menu a.LC_new_message {
6796: font-weight:bold;
6797: color: darkred;
6798: }
6799:
1.975 raeburn 6800: ol.LC_docs_parameters {
6801: margin-left: 0;
6802: padding: 0;
6803: list-style: none;
6804: }
6805:
6806: ol.LC_docs_parameters li {
6807: margin: 0;
6808: padding-right: 20px;
6809: display: inline;
6810: }
6811:
1.976 raeburn 6812: ol.LC_docs_parameters li:before {
6813: content: "\\002022 \\0020";
6814: }
6815:
6816: li.LC_docs_parameters_title {
6817: font-weight: bold;
6818: }
6819:
6820: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6821: content: "";
6822: }
6823:
1.897 wenzelju 6824: ul#LC_secondary_menu {
1.1075.2.23 raeburn 6825: clear: right;
1.911 bisitz 6826: color: $fontmenu;
6827: background: $tabbg;
6828: list-style: none;
6829: padding: 0;
6830: margin: 0;
6831: width: 100%;
1.995 raeburn 6832: text-align: left;
1.1075.2.4 raeburn 6833: float: left;
1.808 droeschl 6834: }
6835:
1.897 wenzelju 6836: ul#LC_secondary_menu li {
1.911 bisitz 6837: font-weight: bold;
6838: line-height: 1.8em;
6839: border-right: 1px solid black;
6840: vertical-align: middle;
1.1075.2.4 raeburn 6841: float: left;
6842: }
6843:
6844: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6845: background-color: $data_table_light;
6846: }
6847:
6848: ul#LC_secondary_menu li a {
6849: padding: 0 0.8em;
6850: }
6851:
6852: ul#LC_secondary_menu li ul {
6853: display: none;
6854: }
6855:
6856: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6857: display: block;
6858: position: absolute;
6859: margin: 0;
6860: padding: 0;
6861: list-style:none;
6862: float: none;
6863: background-color: $data_table_light;
1.1075.2.5 raeburn 6864: z-index: 2;
1.1075.2.10 raeburn 6865: margin-left: -1px;
1.1075.2.4 raeburn 6866: }
6867:
6868: ul#LC_secondary_menu li ul li {
6869: font-size: 90%;
6870: vertical-align: top;
6871: border-left: 1px solid black;
6872: border-right: 1px solid black;
1.1075.2.33 raeburn 6873: background-color: $data_table_light;
1.1075.2.4 raeburn 6874: list-style:none;
6875: float: none;
6876: }
6877:
6878: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6879: background-color: $data_table_dark;
1.807 droeschl 6880: }
6881:
1.847 tempelho 6882: ul.LC_TabContent {
1.911 bisitz 6883: display:block;
6884: background: $sidebg;
6885: border-bottom: solid 1px $lg_border_color;
6886: list-style:none;
1.1020 raeburn 6887: margin: -1px -10px 0 -10px;
1.911 bisitz 6888: padding: 0;
1.693 droeschl 6889: }
6890:
1.795 www 6891: ul.LC_TabContent li,
6892: ul.LC_TabContentBigger li {
1.911 bisitz 6893: float:left;
1.741 harmsja 6894: }
1.795 www 6895:
1.897 wenzelju 6896: ul#LC_secondary_menu li a {
1.911 bisitz 6897: color: $fontmenu;
6898: text-decoration: none;
1.693 droeschl 6899: }
1.795 www 6900:
1.721 harmsja 6901: ul.LC_TabContent {
1.952 onken 6902: min-height:20px;
1.721 harmsja 6903: }
1.795 www 6904:
6905: ul.LC_TabContent li {
1.911 bisitz 6906: vertical-align:middle;
1.959 onken 6907: padding: 0 16px 0 10px;
1.911 bisitz 6908: background-color:$tabbg;
6909: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6910: border-left: solid 1px $font;
1.721 harmsja 6911: }
1.795 www 6912:
1.847 tempelho 6913: ul.LC_TabContent .right {
1.911 bisitz 6914: float:right;
1.847 tempelho 6915: }
6916:
1.911 bisitz 6917: ul.LC_TabContent li a,
6918: ul.LC_TabContent li {
6919: color:rgb(47,47,47);
6920: text-decoration:none;
6921: font-size:95%;
6922: font-weight:bold;
1.952 onken 6923: min-height:20px;
6924: }
6925:
1.959 onken 6926: ul.LC_TabContent li a:hover,
6927: ul.LC_TabContent li a:focus {
1.952 onken 6928: color: $button_hover;
1.959 onken 6929: background:none;
6930: outline:none;
1.952 onken 6931: }
6932:
6933: ul.LC_TabContent li:hover {
6934: color: $button_hover;
6935: cursor:pointer;
1.721 harmsja 6936: }
1.795 www 6937:
1.911 bisitz 6938: ul.LC_TabContent li.active {
1.952 onken 6939: color: $font;
1.911 bisitz 6940: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6941: border-bottom:solid 1px #FFFFFF;
6942: cursor: default;
1.744 ehlerst 6943: }
1.795 www 6944:
1.959 onken 6945: ul.LC_TabContent li.active a {
6946: color:$font;
6947: background:#FFFFFF;
6948: outline: none;
6949: }
1.1047 raeburn 6950:
6951: ul.LC_TabContent li.goback {
6952: float: left;
6953: border-left: none;
6954: }
6955:
1.870 tempelho 6956: #maincoursedoc {
1.911 bisitz 6957: clear:both;
1.870 tempelho 6958: }
6959:
6960: ul.LC_TabContentBigger {
1.911 bisitz 6961: display:block;
6962: list-style:none;
6963: padding: 0;
1.870 tempelho 6964: }
6965:
1.795 www 6966: ul.LC_TabContentBigger li {
1.911 bisitz 6967: vertical-align:bottom;
6968: height: 30px;
6969: font-size:110%;
6970: font-weight:bold;
6971: color: #737373;
1.841 tempelho 6972: }
6973:
1.957 onken 6974: ul.LC_TabContentBigger li.active {
6975: position: relative;
6976: top: 1px;
6977: }
6978:
1.870 tempelho 6979: ul.LC_TabContentBigger li a {
1.911 bisitz 6980: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6981: height: 30px;
6982: line-height: 30px;
6983: text-align: center;
6984: display: block;
6985: text-decoration: none;
1.958 onken 6986: outline: none;
1.741 harmsja 6987: }
1.795 www 6988:
1.870 tempelho 6989: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6990: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6991: color:$font;
1.744 ehlerst 6992: }
1.795 www 6993:
1.870 tempelho 6994: ul.LC_TabContentBigger li b {
1.911 bisitz 6995: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6996: display: block;
6997: float: left;
6998: padding: 0 30px;
1.957 onken 6999: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7000: }
7001:
1.956 onken 7002: ul.LC_TabContentBigger li:hover b {
7003: color:$button_hover;
7004: }
7005:
1.870 tempelho 7006: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7007: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7008: color:$font;
1.957 onken 7009: border: 0;
1.741 harmsja 7010: }
1.693 droeschl 7011:
1.870 tempelho 7012:
1.862 bisitz 7013: ul.LC_CourseBreadcrumbs {
7014: background: $sidebg;
1.1020 raeburn 7015: height: 2em;
1.862 bisitz 7016: padding-left: 10px;
1.1020 raeburn 7017: margin: 0;
1.862 bisitz 7018: list-style-position: inside;
7019: }
7020:
1.911 bisitz 7021: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7022: ol#LC_PathBreadcrumbs {
1.911 bisitz 7023: padding-left: 10px;
7024: margin: 0;
1.933 droeschl 7025: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7026: }
7027:
1.911 bisitz 7028: ol#LC_MenuBreadcrumbs li,
7029: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7030: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7031: display: inline;
1.933 droeschl 7032: white-space: normal;
1.693 droeschl 7033: }
7034:
1.823 bisitz 7035: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7036: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7037: text-decoration: none;
7038: font-size:90%;
1.693 droeschl 7039: }
1.795 www 7040:
1.969 droeschl 7041: ol#LC_MenuBreadcrumbs h1 {
7042: display: inline;
7043: font-size: 90%;
7044: line-height: 2.5em;
7045: margin: 0;
7046: padding: 0;
7047: }
7048:
1.795 www 7049: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7050: text-decoration:none;
7051: font-size:100%;
7052: font-weight:bold;
1.693 droeschl 7053: }
1.795 www 7054:
1.840 bisitz 7055: .LC_Box {
1.911 bisitz 7056: border: solid 1px $lg_border_color;
7057: padding: 0 10px 10px 10px;
1.746 neumanie 7058: }
1.795 www 7059:
1.1020 raeburn 7060: .LC_DocsBox {
7061: border: solid 1px $lg_border_color;
7062: padding: 0 0 10px 10px;
7063: }
7064:
1.795 www 7065: .LC_AboutMe_Image {
1.911 bisitz 7066: float:left;
7067: margin-right:10px;
1.747 neumanie 7068: }
1.795 www 7069:
7070: .LC_Clear_AboutMe_Image {
1.911 bisitz 7071: clear:left;
1.747 neumanie 7072: }
1.795 www 7073:
1.721 harmsja 7074: dl.LC_ListStyleClean dt {
1.911 bisitz 7075: padding-right: 5px;
7076: display: table-header-group;
1.693 droeschl 7077: }
7078:
1.721 harmsja 7079: dl.LC_ListStyleClean dd {
1.911 bisitz 7080: display: table-row;
1.693 droeschl 7081: }
7082:
1.721 harmsja 7083: .LC_ListStyleClean,
7084: .LC_ListStyleSimple,
7085: .LC_ListStyleNormal,
1.795 www 7086: .LC_ListStyleSpecial {
1.911 bisitz 7087: /* display:block; */
7088: list-style-position: inside;
7089: list-style-type: none;
7090: overflow: hidden;
7091: padding: 0;
1.693 droeschl 7092: }
7093:
1.721 harmsja 7094: .LC_ListStyleSimple li,
7095: .LC_ListStyleSimple dd,
7096: .LC_ListStyleNormal li,
7097: .LC_ListStyleNormal dd,
7098: .LC_ListStyleSpecial li,
1.795 www 7099: .LC_ListStyleSpecial dd {
1.911 bisitz 7100: margin: 0;
7101: padding: 5px 5px 5px 10px;
7102: clear: both;
1.693 droeschl 7103: }
7104:
1.721 harmsja 7105: .LC_ListStyleClean li,
7106: .LC_ListStyleClean dd {
1.911 bisitz 7107: padding-top: 0;
7108: padding-bottom: 0;
1.693 droeschl 7109: }
7110:
1.721 harmsja 7111: .LC_ListStyleSimple dd,
1.795 www 7112: .LC_ListStyleSimple li {
1.911 bisitz 7113: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7114: }
7115:
1.721 harmsja 7116: .LC_ListStyleSpecial li,
7117: .LC_ListStyleSpecial dd {
1.911 bisitz 7118: list-style-type: none;
7119: background-color: RGB(220, 220, 220);
7120: margin-bottom: 4px;
1.693 droeschl 7121: }
7122:
1.721 harmsja 7123: table.LC_SimpleTable {
1.911 bisitz 7124: margin:5px;
7125: border:solid 1px $lg_border_color;
1.795 www 7126: }
1.693 droeschl 7127:
1.721 harmsja 7128: table.LC_SimpleTable tr {
1.911 bisitz 7129: padding: 0;
7130: border:solid 1px $lg_border_color;
1.693 droeschl 7131: }
1.795 www 7132:
7133: table.LC_SimpleTable thead {
1.911 bisitz 7134: background:rgb(220,220,220);
1.693 droeschl 7135: }
7136:
1.721 harmsja 7137: div.LC_columnSection {
1.911 bisitz 7138: display: block;
7139: clear: both;
7140: overflow: hidden;
7141: margin: 0;
1.693 droeschl 7142: }
7143:
1.721 harmsja 7144: div.LC_columnSection>* {
1.911 bisitz 7145: float: left;
7146: margin: 10px 20px 10px 0;
7147: overflow:hidden;
1.693 droeschl 7148: }
1.721 harmsja 7149:
1.795 www 7150: table em {
1.911 bisitz 7151: font-weight: bold;
7152: font-style: normal;
1.748 schulted 7153: }
1.795 www 7154:
1.779 bisitz 7155: table.LC_tableBrowseRes,
1.795 www 7156: table.LC_tableOfContent {
1.911 bisitz 7157: border:none;
7158: border-spacing: 1px;
7159: padding: 3px;
7160: background-color: #FFFFFF;
7161: font-size: 90%;
1.753 droeschl 7162: }
1.789 droeschl 7163:
1.911 bisitz 7164: table.LC_tableOfContent {
7165: border-collapse: collapse;
1.789 droeschl 7166: }
7167:
1.771 droeschl 7168: table.LC_tableBrowseRes a,
1.768 schulted 7169: table.LC_tableOfContent a {
1.911 bisitz 7170: background-color: transparent;
7171: text-decoration: none;
1.753 droeschl 7172: }
7173:
1.795 www 7174: table.LC_tableOfContent img {
1.911 bisitz 7175: border: none;
7176: height: 1.3em;
7177: vertical-align: text-bottom;
7178: margin-right: 0.3em;
1.753 droeschl 7179: }
1.757 schulted 7180:
1.795 www 7181: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7182: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7183: }
7184:
1.795 www 7185: a#LC_content_toolbar_everything {
1.911 bisitz 7186: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7187: }
7188:
1.795 www 7189: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7190: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7191: }
7192:
1.795 www 7193: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7194: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7195: }
7196:
1.795 www 7197: a#LC_content_toolbar_changefolder {
1.911 bisitz 7198: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7199: }
7200:
1.795 www 7201: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7202: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7203: }
7204:
1.1043 raeburn 7205: a#LC_content_toolbar_edittoplevel {
7206: background-image:url(/res/adm/pages/edittoplevel.gif);
7207: }
7208:
1.795 www 7209: ul#LC_toolbar li a:hover {
1.911 bisitz 7210: background-position: bottom center;
1.757 schulted 7211: }
7212:
1.795 www 7213: ul#LC_toolbar {
1.911 bisitz 7214: padding: 0;
7215: margin: 2px;
7216: list-style:none;
7217: position:relative;
7218: background-color:white;
1.1075.2.9 raeburn 7219: overflow: auto;
1.757 schulted 7220: }
7221:
1.795 www 7222: ul#LC_toolbar li {
1.911 bisitz 7223: border:1px solid white;
7224: padding: 0;
7225: margin: 0;
7226: float: left;
7227: display:inline;
7228: vertical-align:middle;
1.1075.2.9 raeburn 7229: white-space: nowrap;
1.911 bisitz 7230: }
1.757 schulted 7231:
1.783 amueller 7232:
1.795 www 7233: a.LC_toolbarItem {
1.911 bisitz 7234: display:block;
7235: padding: 0;
7236: margin: 0;
7237: height: 32px;
7238: width: 32px;
7239: color:white;
7240: border: none;
7241: background-repeat:no-repeat;
7242: background-color:transparent;
1.757 schulted 7243: }
7244:
1.915 droeschl 7245: ul.LC_funclist {
7246: margin: 0;
7247: padding: 0.5em 1em 0.5em 0;
7248: }
7249:
1.933 droeschl 7250: ul.LC_funclist > li:first-child {
7251: font-weight:bold;
7252: margin-left:0.8em;
7253: }
7254:
1.915 droeschl 7255: ul.LC_funclist + ul.LC_funclist {
7256: /*
7257: left border as a seperator if we have more than
7258: one list
7259: */
7260: border-left: 1px solid $sidebg;
7261: /*
7262: this hides the left border behind the border of the
7263: outer box if element is wrapped to the next 'line'
7264: */
7265: margin-left: -1px;
7266: }
7267:
1.843 bisitz 7268: ul.LC_funclist li {
1.915 droeschl 7269: display: inline;
1.782 bisitz 7270: white-space: nowrap;
1.915 droeschl 7271: margin: 0 0 0 25px;
7272: line-height: 150%;
1.782 bisitz 7273: }
7274:
1.974 wenzelju 7275: .LC_hidden {
7276: display: none;
7277: }
7278:
1.1030 www 7279: .LCmodal-overlay {
7280: position:fixed;
7281: top:0;
7282: right:0;
7283: bottom:0;
7284: left:0;
7285: height:100%;
7286: width:100%;
7287: margin:0;
7288: padding:0;
7289: background:#999;
7290: opacity:.75;
7291: filter: alpha(opacity=75);
7292: -moz-opacity: 0.75;
7293: z-index:101;
7294: }
7295:
7296: * html .LCmodal-overlay {
7297: position: absolute;
7298: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7299: }
7300:
7301: .LCmodal-window {
7302: position:fixed;
7303: top:50%;
7304: left:50%;
7305: margin:0;
7306: padding:0;
7307: z-index:102;
7308: }
7309:
7310: * html .LCmodal-window {
7311: position:absolute;
7312: }
7313:
7314: .LCclose-window {
7315: position:absolute;
7316: width:32px;
7317: height:32px;
7318: right:8px;
7319: top:8px;
7320: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7321: text-indent:-99999px;
7322: overflow:hidden;
7323: cursor:pointer;
7324: }
7325:
1.1075.2.17 raeburn 7326: /*
7327: styles used by TTH when "Default set of options to pass to tth/m
7328: when converting TeX" in course settings has been set
7329:
7330: option passed: -t
7331:
7332: */
7333:
7334: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7335: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7336: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7337: td div.norm {line-height:normal;}
7338:
7339: /*
7340: option passed -y3
7341: */
7342:
7343: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7344: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7345: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7346:
1.343 albertel 7347: END
7348: }
7349:
1.306 albertel 7350: =pod
7351:
7352: =item * &headtag()
7353:
7354: Returns a uniform footer for LON-CAPA web pages.
7355:
1.307 albertel 7356: Inputs: $title - optional title for the head
7357: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7358: $args - optional arguments
1.319 albertel 7359: force_register - if is true call registerurl so the remote is
7360: informed
1.415 albertel 7361: redirect -> array ref of
7362: 1- seconds before redirect occurs
7363: 2- url to redirect to
7364: 3- whether the side effect should occur
1.315 albertel 7365: (side effect of setting
7366: $env{'internal.head.redirect'} to the url
7367: redirected too)
1.352 albertel 7368: domain -> force to color decorate a page for a specific
7369: domain
7370: function -> force usage of a specific rolish color scheme
7371: bgcolor -> override the default page bgcolor
1.460 albertel 7372: no_auto_mt_title
7373: -> prevent &mt()ing the title arg
1.464 albertel 7374:
1.306 albertel 7375: =cut
7376:
7377: sub headtag {
1.313 albertel 7378: my ($title,$head_extra,$args) = @_;
1.306 albertel 7379:
1.363 albertel 7380: my $function = $args->{'function'} || &get_users_function();
7381: my $domain = $args->{'domain'} || &determinedomain();
7382: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 7383: my $httphost = $args->{'use_absolute'};
1.418 albertel 7384: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7385: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7386: #time(),
1.418 albertel 7387: $env{'environment.color.timestamp'},
1.363 albertel 7388: $function,$domain,$bgcolor);
7389:
1.369 www 7390: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7391:
1.308 albertel 7392: my $result =
7393: '<head>'.
1.1075.2.56 raeburn 7394: &font_settings($args);
1.319 albertel 7395:
1.1075.2.72 raeburn 7396: my $inhibitprint;
7397: if ($args->{'print_suppress'}) {
7398: $inhibitprint = &print_suppression();
7399: }
1.1064 raeburn 7400:
1.461 albertel 7401: if (!$args->{'frameset'}) {
7402: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7403: }
1.1075.2.12 raeburn 7404: if ($args->{'force_register'}) {
7405: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 7406: }
1.436 albertel 7407: if (!$args->{'no_nav_bar'}
7408: && !$args->{'only_body'}
7409: && !$args->{'frameset'}) {
1.1075.2.52 raeburn 7410: $result .= &help_menu_js($httphost);
1.1032 www 7411: $result.=&modal_window();
1.1038 www 7412: $result.=&togglebox_script();
1.1034 www 7413: $result.=&wishlist_window();
1.1041 www 7414: $result.=&LCprogressbarUpdate_script();
1.1034 www 7415: } else {
7416: if ($args->{'add_modal'}) {
7417: $result.=&modal_window();
7418: }
7419: if ($args->{'add_wishlist'}) {
7420: $result.=&wishlist_window();
7421: }
1.1038 www 7422: if ($args->{'add_togglebox'}) {
7423: $result.=&togglebox_script();
7424: }
1.1041 www 7425: if ($args->{'add_progressbar'}) {
7426: $result.=&LCprogressbarUpdate_script();
7427: }
1.436 albertel 7428: }
1.314 albertel 7429: if (ref($args->{'redirect'})) {
1.414 albertel 7430: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7431: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7432: if (!$inhibit_continue) {
7433: $env{'internal.head.redirect'} = $url;
7434: }
1.313 albertel 7435: $result.=<<ADDMETA
7436: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7437: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7438: ADDMETA
1.1075.2.89 raeburn 7439: } else {
7440: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7441: my $requrl = $env{'request.uri'};
7442: if ($requrl eq '') {
7443: $requrl = $ENV{'REQUEST_URI'};
7444: $requrl =~ s/\?.+$//;
7445: }
7446: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7447: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7448: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7449: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7450: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7451: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7452: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7453: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7454: if ($domdefs{'offloadnow'}{$lonhost}) {
7455: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7456: if (($newserver) && ($newserver ne $lonhost)) {
7457: my $numsec = 5;
7458: my $timeout = $numsec * 1000;
7459: my ($newurl,$locknum,%locks,$msg);
7460: if ($env{'request.role.adv'}) {
7461: ($locknum,%locks) = &Apache::lonnet::get_locks();
7462: }
7463: my $disable_submit = 0;
7464: if ($requrl =~ /$LONCAPA::assess_re/) {
7465: $disable_submit = 1;
7466: }
7467: if ($locknum) {
7468: my @lockinfo = sort(values(%locks));
7469: $msg = &mt('Once the following tasks are complete: ')."\\n".
7470: join(", ",sort(values(%locks)))."\\n".
7471: &mt('your session will be transferred to a different server, after you click "Roles".');
7472: } else {
7473: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7474: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7475: }
7476: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7477: $newurl = '/adm/switchserver?otherserver='.$newserver;
7478: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7479: $newurl .= '&role='.$env{'request.role'};
7480: }
7481: if ($env{'request.symb'}) {
7482: $newurl .= '&symb='.$env{'request.symb'};
7483: } else {
7484: $newurl .= '&origurl='.$requrl;
7485: }
7486: }
7487: $result.=<<OFFLOAD
7488: <meta http-equiv="pragma" content="no-cache" />
7489: <script type="text/javascript">
1.1075.2.92 raeburn 7490: // <![CDATA[
1.1075.2.89 raeburn 7491: function LC_Offload_Now() {
7492: var dest = "$newurl";
7493: if (dest != '') {
7494: window.location.href="$newurl";
7495: }
7496: }
1.1075.2.92 raeburn 7497: \$(document).ready(function () {
7498: window.alert('$msg');
7499: if ($disable_submit) {
1.1075.2.89 raeburn 7500: \$(".LC_hwk_submit").prop("disabled", true);
7501: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92 raeburn 7502: }
7503: setTimeout('LC_Offload_Now()', $timeout);
7504: });
7505: // ]]>
1.1075.2.89 raeburn 7506: </script>
7507: OFFLOAD
7508: }
7509: }
7510: }
7511: }
7512: }
7513: }
1.313 albertel 7514: }
1.306 albertel 7515: if (!defined($title)) {
7516: $title = 'The LearningOnline Network with CAPA';
7517: }
1.460 albertel 7518: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7519: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61 raeburn 7520: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7521: if (!$args->{'frameset'}) {
7522: $result .= ' /';
7523: }
7524: $result .= '>'
1.1064 raeburn 7525: .$inhibitprint
1.414 albertel 7526: .$head_extra;
1.1075.2.42 raeburn 7527: if ($env{'browser.mobile'}) {
7528: $result .= '
7529: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7530: <meta name="apple-mobile-web-app-capable" content="yes" />';
7531: }
1.962 droeschl 7532: return $result.'</head>';
1.306 albertel 7533: }
7534:
7535: =pod
7536:
1.340 albertel 7537: =item * &font_settings()
7538:
7539: Returns neccessary <meta> to set the proper encoding
7540:
1.1075.2.56 raeburn 7541: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7542:
7543: =cut
7544:
7545: sub font_settings {
1.1075.2.56 raeburn 7546: my ($args) = @_;
1.340 albertel 7547: my $headerstring='';
1.1075.2.56 raeburn 7548: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7549: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 7550: $headerstring.=
1.1075.2.61 raeburn 7551: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7552: if (!$args->{'frameset'}) {
7553: $headerstring.= ' /';
7554: }
7555: $headerstring .= '>'."\n";
1.340 albertel 7556: }
7557: return $headerstring;
7558: }
7559:
1.341 albertel 7560: =pod
7561:
1.1064 raeburn 7562: =item * &print_suppression()
7563:
7564: In course context returns css which causes the body to be blank when media="print",
7565: if printout generation is unavailable for the current resource.
7566:
7567: This could be because:
7568:
7569: (a) printstartdate is in the future
7570:
7571: (b) printenddate is in the past
7572:
7573: (c) there is an active exam block with "printout"
7574: functionality blocked
7575:
7576: Users with pav, pfo or evb privileges are exempt.
7577:
7578: Inputs: none
7579:
7580: =cut
7581:
7582:
7583: sub print_suppression {
7584: my $noprint;
7585: if ($env{'request.course.id'}) {
7586: my $scope = $env{'request.course.id'};
7587: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7588: (&Apache::lonnet::allowed('pfo',$scope))) {
7589: return;
7590: }
7591: if ($env{'request.course.sec'} ne '') {
7592: $scope .= "/$env{'request.course.sec'}";
7593: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7594: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7595: return;
1.1064 raeburn 7596: }
7597: }
7598: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7599: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73 raeburn 7600: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7601: if ($blocked) {
7602: my $checkrole = "cm./$cdom/$cnum";
7603: if ($env{'request.course.sec'} ne '') {
7604: $checkrole .= "/$env{'request.course.sec'}";
7605: }
7606: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7607: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7608: $noprint = 1;
7609: }
7610: }
7611: unless ($noprint) {
7612: my $symb = &Apache::lonnet::symbread();
7613: if ($symb ne '') {
7614: my $navmap = Apache::lonnavmaps::navmap->new();
7615: if (ref($navmap)) {
7616: my $res = $navmap->getBySymb($symb);
7617: if (ref($res)) {
7618: if (!$res->resprintable()) {
7619: $noprint = 1;
7620: }
7621: }
7622: }
7623: }
7624: }
7625: if ($noprint) {
7626: return <<"ENDSTYLE";
7627: <style type="text/css" media="print">
7628: body { display:none }
7629: </style>
7630: ENDSTYLE
7631: }
7632: }
7633: return;
7634: }
7635:
7636: =pod
7637:
1.341 albertel 7638: =item * &xml_begin()
7639:
7640: Returns the needed doctype and <html>
7641:
7642: Inputs: none
7643:
7644: =cut
7645:
7646: sub xml_begin {
1.1075.2.61 raeburn 7647: my ($is_frameset) = @_;
1.341 albertel 7648: my $output='';
7649:
7650: if ($env{'browser.mathml'}) {
7651: $output='<?xml version="1.0"?>'
7652: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7653: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7654:
7655: # .'<!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">] >'
7656: .'<!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">'
7657: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7658: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 7659: } elsif ($is_frameset) {
7660: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7661: '<html>'."\n";
1.341 albertel 7662: } else {
1.1075.2.61 raeburn 7663: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7664: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7665: }
7666: return $output;
7667: }
1.340 albertel 7668:
7669: =pod
7670:
1.306 albertel 7671: =item * &start_page()
7672:
7673: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7674:
1.648 raeburn 7675: Inputs:
7676:
7677: =over 4
7678:
7679: $title - optional title for the page
7680:
7681: $head_extra - optional extra HTML to incude inside the <head>
7682:
7683: $args - additional optional args supported are:
7684:
7685: =over 8
7686:
7687: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7688: arg on
1.814 bisitz 7689: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7690: add_entries -> additional attributes to add to the <body>
7691: domain -> force to color decorate a page for a
1.317 albertel 7692: specific domain
1.648 raeburn 7693: function -> force usage of a specific rolish color
1.317 albertel 7694: scheme
1.648 raeburn 7695: redirect -> see &headtag()
7696: bgcolor -> override the default page bg color
7697: js_ready -> return a string ready for being used in
1.317 albertel 7698: a javascript writeln
1.648 raeburn 7699: html_encode -> return a string ready for being used in
1.320 albertel 7700: a html attribute
1.648 raeburn 7701: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7702: $forcereg arg
1.648 raeburn 7703: frameset -> if true will start with a <frameset>
1.330 albertel 7704: rather than <body>
1.648 raeburn 7705: skip_phases -> hash ref of
1.338 albertel 7706: head -> skip the <html><head> generation
7707: body -> skip all <body> generation
1.1075.2.12 raeburn 7708: no_inline_link -> if true and in remote mode, don't show the
7709: 'Switch To Inline Menu' link
1.648 raeburn 7710: no_auto_mt_title -> prevent &mt()ing the title arg
7711: inherit_jsmath -> when creating popup window in a page,
7712: should it have jsmath forced on by the
7713: current page
1.867 kalberla 7714: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7715: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.15 raeburn 7716: group -> includes the current group, if page is for a
7717: specific group
1.361 albertel 7718:
1.648 raeburn 7719: =back
1.460 albertel 7720:
1.648 raeburn 7721: =back
1.562 albertel 7722:
1.306 albertel 7723: =cut
7724:
7725: sub start_page {
1.309 albertel 7726: my ($title,$head_extra,$args) = @_;
1.318 albertel 7727: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7728:
1.315 albertel 7729: $env{'internal.start_page'}++;
1.1075.2.15 raeburn 7730: my ($result,@advtools);
1.964 droeschl 7731:
1.338 albertel 7732: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 7733: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 7734: }
7735:
7736: if (! exists($args->{'skip_phases'}{'body'}) ) {
7737: if ($args->{'frameset'}) {
7738: my $attr_string = &make_attr_string($args->{'force_register'},
7739: $args->{'add_entries'});
7740: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7741: } else {
7742: $result .=
7743: &bodytag($title,
7744: $args->{'function'}, $args->{'add_entries'},
7745: $args->{'only_body'}, $args->{'domain'},
7746: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 7747: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.15 raeburn 7748: $args, \@advtools);
1.831 bisitz 7749: }
1.330 albertel 7750: }
1.338 albertel 7751:
1.315 albertel 7752: if ($args->{'js_ready'}) {
1.713 kaisler 7753: $result = &js_ready($result);
1.315 albertel 7754: }
1.320 albertel 7755: if ($args->{'html_encode'}) {
1.713 kaisler 7756: $result = &html_encode($result);
7757: }
7758:
1.813 bisitz 7759: # Preparation for new and consistent functionlist at top of screen
7760: # if ($args->{'functionlist'}) {
7761: # $result .= &build_functionlist();
7762: #}
7763:
1.964 droeschl 7764: # Don't add anything more if only_body wanted or in const space
7765: return $result if $args->{'only_body'}
7766: || $env{'request.state'} eq 'construct';
1.813 bisitz 7767:
7768: #Breadcrumbs
1.758 kaisler 7769: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7770: &Apache::lonhtmlcommon::clear_breadcrumbs();
7771: #if any br links exists, add them to the breadcrumbs
7772: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7773: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7774: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7775: }
7776: }
1.1075.2.19 raeburn 7777: # if @advtools array contains items add then to the breadcrumbs
7778: if (@advtools > 0) {
7779: &Apache::lonmenu::advtools_crumbs(@advtools);
7780: }
1.758 kaisler 7781:
7782: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7783: if(exists($args->{'bread_crumbs_component'})){
7784: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7785: }else{
7786: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7787: }
1.1075.2.24 raeburn 7788: } elsif (($env{'environment.remote'} eq 'on') &&
7789: ($env{'form.inhibitmenu'} ne 'yes') &&
7790: ($env{'request.noversionuri'} =~ m{^/res/}) &&
7791: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 7792: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 7793: }
1.315 albertel 7794: return $result;
1.306 albertel 7795: }
7796:
7797: sub end_page {
1.315 albertel 7798: my ($args) = @_;
7799: $env{'internal.end_page'}++;
1.330 albertel 7800: my $result;
1.335 albertel 7801: if ($args->{'discussion'}) {
7802: my ($target,$parser);
7803: if (ref($args->{'discussion'})) {
7804: ($target,$parser) =($args->{'discussion'}{'target'},
7805: $args->{'discussion'}{'parser'});
7806: }
7807: $result .= &Apache::lonxml::xmlend($target,$parser);
7808: }
1.330 albertel 7809: if ($args->{'frameset'}) {
7810: $result .= '</frameset>';
7811: } else {
1.635 raeburn 7812: $result .= &endbodytag($args);
1.330 albertel 7813: }
1.1075.2.6 raeburn 7814: unless ($args->{'notbody'}) {
7815: $result .= "\n</html>";
7816: }
1.330 albertel 7817:
1.315 albertel 7818: if ($args->{'js_ready'}) {
1.317 albertel 7819: $result = &js_ready($result);
1.315 albertel 7820: }
1.335 albertel 7821:
1.320 albertel 7822: if ($args->{'html_encode'}) {
7823: $result = &html_encode($result);
7824: }
1.335 albertel 7825:
1.315 albertel 7826: return $result;
7827: }
7828:
1.1034 www 7829: sub wishlist_window {
7830: return(<<'ENDWISHLIST');
1.1046 raeburn 7831: <script type="text/javascript">
1.1034 www 7832: // <![CDATA[
7833: // <!-- BEGIN LON-CAPA Internal
7834: function set_wishlistlink(title, path) {
7835: if (!title) {
7836: title = document.title;
7837: title = title.replace(/^LON-CAPA /,'');
7838: }
1.1075.2.65 raeburn 7839: title = encodeURIComponent(title);
1.1075.2.83 raeburn 7840: title = title.replace("'","\\\'");
1.1034 www 7841: if (!path) {
7842: path = location.pathname;
7843: }
1.1075.2.65 raeburn 7844: path = encodeURIComponent(path);
1.1075.2.83 raeburn 7845: path = path.replace("'","\\\'");
1.1034 www 7846: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7847: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7848: }
7849: // END LON-CAPA Internal -->
7850: // ]]>
7851: </script>
7852: ENDWISHLIST
7853: }
7854:
1.1030 www 7855: sub modal_window {
7856: return(<<'ENDMODAL');
1.1046 raeburn 7857: <script type="text/javascript">
1.1030 www 7858: // <![CDATA[
7859: // <!-- BEGIN LON-CAPA Internal
7860: var modalWindow = {
7861: parent:"body",
7862: windowId:null,
7863: content:null,
7864: width:null,
7865: height:null,
7866: close:function()
7867: {
7868: $(".LCmodal-window").remove();
7869: $(".LCmodal-overlay").remove();
7870: },
7871: open:function()
7872: {
7873: var modal = "";
7874: modal += "<div class=\"LCmodal-overlay\"></div>";
7875: 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;\">";
7876: modal += this.content;
7877: modal += "</div>";
7878:
7879: $(this.parent).append(modal);
7880:
7881: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7882: $(".LCclose-window").click(function(){modalWindow.close();});
7883: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7884: }
7885: };
1.1075.2.42 raeburn 7886: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7887: {
1.1075.2.83 raeburn 7888: source = source.replace("'","'");
1.1030 www 7889: modalWindow.windowId = "myModal";
7890: modalWindow.width = width;
7891: modalWindow.height = height;
1.1075.2.80 raeburn 7892: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7893: modalWindow.open();
1.1075.2.87 raeburn 7894: };
1.1030 www 7895: // END LON-CAPA Internal -->
7896: // ]]>
7897: </script>
7898: ENDMODAL
7899: }
7900:
7901: sub modal_link {
1.1075.2.42 raeburn 7902: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7903: unless ($width) { $width=480; }
7904: unless ($height) { $height=400; }
1.1031 www 7905: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 7906: unless ($transparency) { $transparency='true'; }
7907:
1.1074 raeburn 7908: my $target_attr;
7909: if (defined($target)) {
7910: $target_attr = 'target="'.$target.'"';
7911: }
7912: return <<"ENDLINK";
1.1075.2.42 raeburn 7913: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7914: $linktext</a>
7915: ENDLINK
1.1030 www 7916: }
7917:
1.1032 www 7918: sub modal_adhoc_script {
7919: my ($funcname,$width,$height,$content)=@_;
7920: return (<<ENDADHOC);
1.1046 raeburn 7921: <script type="text/javascript">
1.1032 www 7922: // <![CDATA[
7923: var $funcname = function()
7924: {
7925: modalWindow.windowId = "myModal";
7926: modalWindow.width = $width;
7927: modalWindow.height = $height;
7928: modalWindow.content = '$content';
7929: modalWindow.open();
7930: };
7931: // ]]>
7932: </script>
7933: ENDADHOC
7934: }
7935:
1.1041 www 7936: sub modal_adhoc_inner {
7937: my ($funcname,$width,$height,$content)=@_;
7938: my $innerwidth=$width-20;
7939: $content=&js_ready(
1.1042 www 7940: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 7941: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7942: $content.
1.1041 www 7943: &end_scrollbox().
1.1075.2.42 raeburn 7944: &end_page()
1.1041 www 7945: );
7946: return &modal_adhoc_script($funcname,$width,$height,$content);
7947: }
7948:
7949: sub modal_adhoc_window {
7950: my ($funcname,$width,$height,$content,$linktext)=@_;
7951: return &modal_adhoc_inner($funcname,$width,$height,$content).
7952: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7953: }
7954:
7955: sub modal_adhoc_launch {
7956: my ($funcname,$width,$height,$content)=@_;
7957: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7958: <script type="text/javascript">
7959: // <![CDATA[
7960: $funcname();
7961: // ]]>
7962: </script>
7963: ENDLAUNCH
7964: }
7965:
7966: sub modal_adhoc_close {
7967: return (<<ENDCLOSE);
7968: <script type="text/javascript">
7969: // <![CDATA[
7970: modalWindow.close();
7971: // ]]>
7972: </script>
7973: ENDCLOSE
7974: }
7975:
1.1038 www 7976: sub togglebox_script {
7977: return(<<ENDTOGGLE);
7978: <script type="text/javascript">
7979: // <![CDATA[
7980: function LCtoggleDisplay(id,hidetext,showtext) {
7981: link = document.getElementById(id + "link").childNodes[0];
7982: with (document.getElementById(id).style) {
7983: if (display == "none" ) {
7984: display = "inline";
7985: link.nodeValue = hidetext;
7986: } else {
7987: display = "none";
7988: link.nodeValue = showtext;
7989: }
7990: }
7991: }
7992: // ]]>
7993: </script>
7994: ENDTOGGLE
7995: }
7996:
1.1039 www 7997: sub start_togglebox {
7998: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7999: unless ($heading) { $heading=''; } else { $heading.=' '; }
8000: unless ($showtext) { $showtext=&mt('show'); }
8001: unless ($hidetext) { $hidetext=&mt('hide'); }
8002: unless ($headerbg) { $headerbg='#FFFFFF'; }
8003: return &start_data_table().
8004: &start_data_table_header_row().
8005: '<td bgcolor="'.$headerbg.'">'.$heading.
8006: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8007: $showtext.'\')">'.$showtext.'</a>]</td>'.
8008: &end_data_table_header_row().
8009: '<tr id="'.$id.'" style="display:none""><td>';
8010: }
8011:
8012: sub end_togglebox {
8013: return '</td></tr>'.&end_data_table();
8014: }
8015:
1.1041 www 8016: sub LCprogressbar_script {
1.1045 www 8017: my ($id)=@_;
1.1041 www 8018: return(<<ENDPROGRESS);
8019: <script type="text/javascript">
8020: // <![CDATA[
1.1045 www 8021: \$('#progressbar$id').progressbar({
1.1041 www 8022: value: 0,
8023: change: function(event, ui) {
8024: var newVal = \$(this).progressbar('option', 'value');
8025: \$('.pblabel', this).text(LCprogressTxt);
8026: }
8027: });
8028: // ]]>
8029: </script>
8030: ENDPROGRESS
8031: }
8032:
8033: sub LCprogressbarUpdate_script {
8034: return(<<ENDPROGRESSUPDATE);
8035: <style type="text/css">
8036: .ui-progressbar { position:relative; }
8037: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8038: </style>
8039: <script type="text/javascript">
8040: // <![CDATA[
1.1045 www 8041: var LCprogressTxt='---';
8042:
8043: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8044: LCprogressTxt=progresstext;
1.1045 www 8045: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8046: }
8047: // ]]>
8048: </script>
8049: ENDPROGRESSUPDATE
8050: }
8051:
1.1042 www 8052: my $LClastpercent;
1.1045 www 8053: my $LCidcnt;
8054: my $LCcurrentid;
1.1042 www 8055:
1.1041 www 8056: sub LCprogressbar {
1.1042 www 8057: my ($r)=(@_);
8058: $LClastpercent=0;
1.1045 www 8059: $LCidcnt++;
8060: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8061: my $starting=&mt('Starting');
8062: my $content=(<<ENDPROGBAR);
1.1045 www 8063: <div id="progressbar$LCcurrentid">
1.1041 www 8064: <span class="pblabel">$starting</span>
8065: </div>
8066: ENDPROGBAR
1.1045 www 8067: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8068: }
8069:
8070: sub LCprogressbarUpdate {
1.1042 www 8071: my ($r,$val,$text)=@_;
8072: unless ($val) {
8073: if ($LClastpercent) {
8074: $val=$LClastpercent;
8075: } else {
8076: $val=0;
8077: }
8078: }
1.1041 www 8079: if ($val<0) { $val=0; }
8080: if ($val>100) { $val=0; }
1.1042 www 8081: $LClastpercent=$val;
1.1041 www 8082: unless ($text) { $text=$val.'%'; }
8083: $text=&js_ready($text);
1.1044 www 8084: &r_print($r,<<ENDUPDATE);
1.1041 www 8085: <script type="text/javascript">
8086: // <![CDATA[
1.1045 www 8087: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8088: // ]]>
8089: </script>
8090: ENDUPDATE
1.1035 www 8091: }
8092:
1.1042 www 8093: sub LCprogressbarClose {
8094: my ($r)=@_;
8095: $LClastpercent=0;
1.1044 www 8096: &r_print($r,<<ENDCLOSE);
1.1042 www 8097: <script type="text/javascript">
8098: // <![CDATA[
1.1045 www 8099: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8100: // ]]>
8101: </script>
8102: ENDCLOSE
1.1044 www 8103: }
8104:
8105: sub r_print {
8106: my ($r,$to_print)=@_;
8107: if ($r) {
8108: $r->print($to_print);
8109: $r->rflush();
8110: } else {
8111: print($to_print);
8112: }
1.1042 www 8113: }
8114:
1.320 albertel 8115: sub html_encode {
8116: my ($result) = @_;
8117:
1.322 albertel 8118: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8119:
8120: return $result;
8121: }
1.1044 www 8122:
1.317 albertel 8123: sub js_ready {
8124: my ($result) = @_;
8125:
1.323 albertel 8126: $result =~ s/[\n\r]/ /xmsg;
8127: $result =~ s/\\/\\\\/xmsg;
8128: $result =~ s/'/\\'/xmsg;
1.372 albertel 8129: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8130:
8131: return $result;
8132: }
8133:
1.315 albertel 8134: sub validate_page {
8135: if ( exists($env{'internal.start_page'})
1.316 albertel 8136: && $env{'internal.start_page'} > 1) {
8137: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8138: $env{'internal.start_page'}.' '.
1.316 albertel 8139: $ENV{'request.filename'});
1.315 albertel 8140: }
8141: if ( exists($env{'internal.end_page'})
1.316 albertel 8142: && $env{'internal.end_page'} > 1) {
8143: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8144: $env{'internal.end_page'}.' '.
1.316 albertel 8145: $env{'request.filename'});
1.315 albertel 8146: }
8147: if ( exists($env{'internal.start_page'})
8148: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8149: &Apache::lonnet::logthis('start_page called without end_page '.
8150: $env{'request.filename'});
1.315 albertel 8151: }
8152: if ( ! exists($env{'internal.start_page'})
8153: && exists($env{'internal.end_page'})) {
1.316 albertel 8154: &Apache::lonnet::logthis('end_page called without start_page'.
8155: $env{'request.filename'});
1.315 albertel 8156: }
1.306 albertel 8157: }
1.315 albertel 8158:
1.996 www 8159:
8160: sub start_scrollbox {
1.1075.2.56 raeburn 8161: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8162: unless ($outerwidth) { $outerwidth='520px'; }
8163: unless ($width) { $width='500px'; }
8164: unless ($height) { $height='200px'; }
1.1075 raeburn 8165: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8166: if ($id ne '') {
1.1075.2.42 raeburn 8167: $table_id = ' id="table_'.$id.'"';
8168: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8169: }
1.1075 raeburn 8170: if ($bgcolor ne '') {
8171: $tdcol = "background-color: $bgcolor;";
8172: }
1.1075.2.42 raeburn 8173: my $nicescroll_js;
8174: if ($env{'browser.mobile'}) {
8175: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8176: }
1.1075 raeburn 8177: return <<"END";
1.1075.2.42 raeburn 8178: $nicescroll_js
8179:
8180: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 8181: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 8182: END
1.996 www 8183: }
8184:
8185: sub end_scrollbox {
1.1036 www 8186: return '</div></td></tr></table>';
1.996 www 8187: }
8188:
1.1075.2.42 raeburn 8189: sub nicescroll_javascript {
8190: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8191: my %options;
8192: if (ref($cursor) eq 'HASH') {
8193: %options = %{$cursor};
8194: }
8195: unless ($options{'railalign'} =~ /^left|right$/) {
8196: $options{'railalign'} = 'left';
8197: }
8198: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8199: my $function = &get_users_function();
8200: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
8201: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8202: $options{'cursorcolor'} = '#00F';
8203: }
8204: }
8205: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8206: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
8207: $options{'cursoropacity'}='1.0';
8208: }
8209: } else {
8210: $options{'cursoropacity'}='1.0';
8211: }
8212: if ($options{'cursorfixedheight'} eq 'none') {
8213: delete($options{'cursorfixedheight'});
8214: } else {
8215: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8216: }
8217: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8218: delete($options{'railoffset'});
8219: }
8220: my @niceoptions;
8221: while (my($key,$value) = each(%options)) {
8222: if ($value =~ /^\{.+\}$/) {
8223: push(@niceoptions,$key.':'.$value);
8224: } else {
8225: push(@niceoptions,$key.':"'.$value.'"');
8226: }
8227: }
8228: my $nicescroll_js = '
8229: $(document).ready(
8230: function() {
8231: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8232: }
8233: );
8234: ';
8235: if ($framecheck) {
8236: $nicescroll_js .= '
8237: function expand_div(caller) {
8238: if (top === self) {
8239: document.getElementById("'.$id.'").style.width = "auto";
8240: document.getElementById("'.$id.'").style.height = "auto";
8241: } else {
8242: try {
8243: if (parent.frames) {
8244: if (parent.frames.length > 1) {
8245: var framesrc = parent.frames[1].location.href;
8246: var currsrc = framesrc.replace(/\#.*$/,"");
8247: if ((caller == "search") || (currsrc == "'.$location.'")) {
8248: document.getElementById("'.$id.'").style.width = "auto";
8249: document.getElementById("'.$id.'").style.height = "auto";
8250: }
8251: }
8252: }
8253: } catch (e) {
8254: return;
8255: }
8256: }
8257: return;
8258: }
8259: ';
8260: }
8261: if ($needjsready) {
8262: $nicescroll_js = '
8263: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8264: } else {
8265: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8266: }
8267: return $nicescroll_js;
8268: }
8269:
1.318 albertel 8270: sub simple_error_page {
1.1075.2.49 raeburn 8271: my ($r,$title,$msg,$args) = @_;
8272: if (ref($args) eq 'HASH') {
8273: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8274: } else {
8275: $msg = &mt($msg);
8276: }
8277:
1.318 albertel 8278: my $page =
8279: &Apache::loncommon::start_page($title).
1.1075.2.49 raeburn 8280: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8281: &Apache::loncommon::end_page();
8282: if (ref($r)) {
8283: $r->print($page);
1.327 albertel 8284: return;
1.318 albertel 8285: }
8286: return $page;
8287: }
1.347 albertel 8288:
8289: {
1.610 albertel 8290: my @row_count;
1.961 onken 8291:
8292: sub start_data_table_count {
8293: unshift(@row_count, 0);
8294: return;
8295: }
8296:
8297: sub end_data_table_count {
8298: shift(@row_count);
8299: return;
8300: }
8301:
1.347 albertel 8302: sub start_data_table {
1.1018 raeburn 8303: my ($add_class,$id) = @_;
1.422 albertel 8304: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8305: my $table_id;
8306: if (defined($id)) {
8307: $table_id = ' id="'.$id.'"';
8308: }
1.961 onken 8309: &start_data_table_count();
1.1018 raeburn 8310: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8311: }
8312:
8313: sub end_data_table {
1.961 onken 8314: &end_data_table_count();
1.389 albertel 8315: return '</table>'."\n";;
1.347 albertel 8316: }
8317:
8318: sub start_data_table_row {
1.974 wenzelju 8319: my ($add_class, $id) = @_;
1.610 albertel 8320: $row_count[0]++;
8321: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8322: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8323: $id = (' id="'.$id.'"') unless ($id eq '');
8324: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8325: }
1.471 banghart 8326:
8327: sub continue_data_table_row {
1.974 wenzelju 8328: my ($add_class, $id) = @_;
1.610 albertel 8329: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8330: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8331: $id = (' id="'.$id.'"') unless ($id eq '');
8332: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8333: }
1.347 albertel 8334:
8335: sub end_data_table_row {
1.389 albertel 8336: return '</tr>'."\n";;
1.347 albertel 8337: }
1.367 www 8338:
1.421 albertel 8339: sub start_data_table_empty_row {
1.707 bisitz 8340: # $row_count[0]++;
1.421 albertel 8341: return '<tr class="LC_empty_row" >'."\n";;
8342: }
8343:
8344: sub end_data_table_empty_row {
8345: return '</tr>'."\n";;
8346: }
8347:
1.367 www 8348: sub start_data_table_header_row {
1.389 albertel 8349: return '<tr class="LC_header_row">'."\n";;
1.367 www 8350: }
8351:
8352: sub end_data_table_header_row {
1.389 albertel 8353: return '</tr>'."\n";;
1.367 www 8354: }
1.890 droeschl 8355:
8356: sub data_table_caption {
8357: my $caption = shift;
8358: return "<caption class=\"LC_caption\">$caption</caption>";
8359: }
1.347 albertel 8360: }
8361:
1.548 albertel 8362: =pod
8363:
8364: =item * &inhibit_menu_check($arg)
8365:
8366: Checks for a inhibitmenu state and generates output to preserve it
8367:
8368: Inputs: $arg - can be any of
8369: - undef - in which case the return value is a string
8370: to add into arguments list of a uri
8371: - 'input' - in which case the return value is a HTML
8372: <form> <input> field of type hidden to
8373: preserve the value
8374: - a url - in which case the return value is the url with
8375: the neccesary cgi args added to preserve the
8376: inhibitmenu state
8377: - a ref to a url - no return value, but the string is
8378: updated to include the neccessary cgi
8379: args to preserve the inhibitmenu state
8380:
8381: =cut
8382:
8383: sub inhibit_menu_check {
8384: my ($arg) = @_;
8385: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8386: if ($arg eq 'input') {
8387: if ($env{'form.inhibitmenu'}) {
8388: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8389: } else {
8390: return
8391: }
8392: }
8393: if ($env{'form.inhibitmenu'}) {
8394: if (ref($arg)) {
8395: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8396: } elsif ($arg eq '') {
8397: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8398: } else {
8399: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8400: }
8401: }
8402: if (!ref($arg)) {
8403: return $arg;
8404: }
8405: }
8406:
1.251 albertel 8407: ###############################################
1.182 matthew 8408:
8409: =pod
8410:
1.549 albertel 8411: =back
8412:
8413: =head1 User Information Routines
8414:
8415: =over 4
8416:
1.405 albertel 8417: =item * &get_users_function()
1.182 matthew 8418:
8419: Used by &bodytag to determine the current users primary role.
8420: Returns either 'student','coordinator','admin', or 'author'.
8421:
8422: =cut
8423:
8424: ###############################################
8425: sub get_users_function {
1.815 tempelho 8426: my $function = 'norole';
1.818 tempelho 8427: if ($env{'request.role'}=~/^(st)/) {
8428: $function='student';
8429: }
1.907 raeburn 8430: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8431: $function='coordinator';
8432: }
1.258 albertel 8433: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8434: $function='admin';
8435: }
1.826 bisitz 8436: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8437: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8438: $function='author';
8439: }
8440: return $function;
1.54 www 8441: }
1.99 www 8442:
8443: ###############################################
8444:
1.233 raeburn 8445: =pod
8446:
1.821 raeburn 8447: =item * &show_course()
8448:
8449: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8450: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8451:
8452: Inputs:
8453: None
8454:
8455: Outputs:
8456: Scalar: 1 if 'Course' to be used, 0 otherwise.
8457:
8458: =cut
8459:
8460: ###############################################
8461: sub show_course {
8462: my $course = !$env{'user.adv'};
8463: if (!$env{'user.adv'}) {
8464: foreach my $env (keys(%env)) {
8465: next if ($env !~ m/^user\.priv\./);
8466: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8467: $course = 0;
8468: last;
8469: }
8470: }
8471: }
8472: return $course;
8473: }
8474:
8475: ###############################################
8476:
8477: =pod
8478:
1.542 raeburn 8479: =item * &check_user_status()
1.274 raeburn 8480:
8481: Determines current status of supplied role for a
8482: specific user. Roles can be active, previous or future.
8483:
8484: Inputs:
8485: user's domain, user's username, course's domain,
1.375 raeburn 8486: course's number, optional section ID.
1.274 raeburn 8487:
8488: Outputs:
8489: role status: active, previous or future.
8490:
8491: =cut
8492:
8493: sub check_user_status {
1.412 raeburn 8494: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8495: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85 raeburn 8496: my @uroles = keys(%userinfo);
1.274 raeburn 8497: my $srchstr;
8498: my $active_chk = 'none';
1.412 raeburn 8499: my $now = time;
1.274 raeburn 8500: if (@uroles > 0) {
1.908 raeburn 8501: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8502: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8503: } else {
1.412 raeburn 8504: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8505: }
8506: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8507: my $role_end = 0;
8508: my $role_start = 0;
8509: $active_chk = 'active';
1.412 raeburn 8510: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8511: $role_end = $1;
8512: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8513: $role_start = $1;
1.274 raeburn 8514: }
8515: }
8516: if ($role_start > 0) {
1.412 raeburn 8517: if ($now < $role_start) {
1.274 raeburn 8518: $active_chk = 'future';
8519: }
8520: }
8521: if ($role_end > 0) {
1.412 raeburn 8522: if ($now > $role_end) {
1.274 raeburn 8523: $active_chk = 'previous';
8524: }
8525: }
8526: }
8527: }
8528: return $active_chk;
8529: }
8530:
8531: ###############################################
8532:
8533: =pod
8534:
1.405 albertel 8535: =item * &get_sections()
1.233 raeburn 8536:
8537: Determines all the sections for a course including
8538: sections with students and sections containing other roles.
1.419 raeburn 8539: Incoming parameters:
8540:
8541: 1. domain
8542: 2. course number
8543: 3. reference to array containing roles for which sections should
8544: be gathered (optional).
8545: 4. reference to array containing status types for which sections
8546: should be gathered (optional).
8547:
8548: If the third argument is undefined, sections are gathered for any role.
8549: If the fourth argument is undefined, sections are gathered for any status.
8550: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8551:
1.374 raeburn 8552: Returns section hash (keys are section IDs, values are
8553: number of users in each section), subject to the
1.419 raeburn 8554: optional roles filter, optional status filter
1.233 raeburn 8555:
8556: =cut
8557:
8558: ###############################################
8559: sub get_sections {
1.419 raeburn 8560: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8561: if (!defined($cdom) || !defined($cnum)) {
8562: my $cid = $env{'request.course.id'};
8563:
8564: return if (!defined($cid));
8565:
8566: $cdom = $env{'course.'.$cid.'.domain'};
8567: $cnum = $env{'course.'.$cid.'.num'};
8568: }
8569:
8570: my %sectioncount;
1.419 raeburn 8571: my $now = time;
1.240 albertel 8572:
1.1075.2.33 raeburn 8573: my $check_students = 1;
8574: my $only_students = 0;
8575: if (ref($possible_roles) eq 'ARRAY') {
8576: if (grep(/^st$/,@{$possible_roles})) {
8577: if (@{$possible_roles} == 1) {
8578: $only_students = 1;
8579: }
8580: } else {
8581: $check_students = 0;
8582: }
8583: }
8584:
8585: if ($check_students) {
1.276 albertel 8586: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8587: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8588: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8589: my $start_index = &Apache::loncoursedata::CL_START();
8590: my $end_index = &Apache::loncoursedata::CL_END();
8591: my $status;
1.366 albertel 8592: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8593: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8594: $data->[$status_index],
8595: $data->[$start_index],
8596: $data->[$end_index]);
8597: if ($stu_status eq 'Active') {
8598: $status = 'active';
8599: } elsif ($end < $now) {
8600: $status = 'previous';
8601: } elsif ($start > $now) {
8602: $status = 'future';
8603: }
8604: if ($section ne '-1' && $section !~ /^\s*$/) {
8605: if ((!defined($possible_status)) || (($status ne '') &&
8606: (grep/^\Q$status\E$/,@{$possible_status}))) {
8607: $sectioncount{$section}++;
8608: }
1.240 albertel 8609: }
8610: }
8611: }
1.1075.2.33 raeburn 8612: if ($only_students) {
8613: return %sectioncount;
8614: }
1.240 albertel 8615: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8616: foreach my $user (sort(keys(%courseroles))) {
8617: if ($user !~ /^(\w{2})/) { next; }
8618: my ($role) = ($user =~ /^(\w{2})/);
8619: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8620: my ($section,$status);
1.240 albertel 8621: if ($role eq 'cr' &&
8622: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8623: $section=$1;
8624: }
8625: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8626: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8627: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8628: if ($end == -1 && $start == -1) {
8629: next; #deleted role
8630: }
8631: if (!defined($possible_status)) {
8632: $sectioncount{$section}++;
8633: } else {
8634: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8635: $status = 'active';
8636: } elsif ($end < $now) {
8637: $status = 'future';
8638: } elsif ($start > $now) {
8639: $status = 'previous';
8640: }
8641: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8642: $sectioncount{$section}++;
8643: }
8644: }
1.233 raeburn 8645: }
1.366 albertel 8646: return %sectioncount;
1.233 raeburn 8647: }
8648:
1.274 raeburn 8649: ###############################################
1.294 raeburn 8650:
8651: =pod
1.405 albertel 8652:
8653: =item * &get_course_users()
8654:
1.275 raeburn 8655: Retrieves usernames:domains for users in the specified course
8656: with specific role(s), and access status.
8657:
8658: Incoming parameters:
1.277 albertel 8659: 1. course domain
8660: 2. course number
8661: 3. access status: users must have - either active,
1.275 raeburn 8662: previous, future, or all.
1.277 albertel 8663: 4. reference to array of permissible roles
1.288 raeburn 8664: 5. reference to array of section restrictions (optional)
8665: 6. reference to results object (hash of hashes).
8666: 7. reference to optional userdata hash
1.609 raeburn 8667: 8. reference to optional statushash
1.630 raeburn 8668: 9. flag if privileged users (except those set to unhide in
8669: course settings) should be excluded
1.609 raeburn 8670: Keys of top level results hash are roles.
1.275 raeburn 8671: Keys of inner hashes are username:domain, with
8672: values set to access type.
1.288 raeburn 8673: Optional userdata hash returns an array with arguments in the
8674: same order as loncoursedata::get_classlist() for student data.
8675:
1.609 raeburn 8676: Optional statushash returns
8677:
1.288 raeburn 8678: Entries for end, start, section and status are blank because
8679: of the possibility of multiple values for non-student roles.
8680:
1.275 raeburn 8681: =cut
1.405 albertel 8682:
1.275 raeburn 8683: ###############################################
1.405 albertel 8684:
1.275 raeburn 8685: sub get_course_users {
1.630 raeburn 8686: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8687: my %idx = ();
1.419 raeburn 8688: my %seclists;
1.288 raeburn 8689:
8690: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8691: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8692: $idx{end} = &Apache::loncoursedata::CL_END();
8693: $idx{start} = &Apache::loncoursedata::CL_START();
8694: $idx{id} = &Apache::loncoursedata::CL_ID();
8695: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8696: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8697: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8698:
1.290 albertel 8699: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8700: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8701: my $now = time;
1.277 albertel 8702: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8703: my $match = 0;
1.412 raeburn 8704: my $secmatch = 0;
1.419 raeburn 8705: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8706: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8707: if ($section eq '') {
8708: $section = 'none';
8709: }
1.291 albertel 8710: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8711: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8712: $secmatch = 1;
8713: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8714: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8715: $secmatch = 1;
8716: }
8717: } else {
1.419 raeburn 8718: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8719: $secmatch = 1;
8720: }
1.290 albertel 8721: }
1.412 raeburn 8722: if (!$secmatch) {
8723: next;
8724: }
1.419 raeburn 8725: }
1.275 raeburn 8726: if (defined($$types{'active'})) {
1.288 raeburn 8727: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8728: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8729: $match = 1;
1.275 raeburn 8730: }
8731: }
8732: if (defined($$types{'previous'})) {
1.609 raeburn 8733: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8734: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8735: $match = 1;
1.275 raeburn 8736: }
8737: }
8738: if (defined($$types{'future'})) {
1.609 raeburn 8739: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8740: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8741: $match = 1;
1.275 raeburn 8742: }
8743: }
1.609 raeburn 8744: if ($match) {
8745: push(@{$seclists{$student}},$section);
8746: if (ref($userdata) eq 'HASH') {
8747: $$userdata{$student} = $$classlist{$student};
8748: }
8749: if (ref($statushash) eq 'HASH') {
8750: $statushash->{$student}{'st'}{$section} = $status;
8751: }
1.288 raeburn 8752: }
1.275 raeburn 8753: }
8754: }
1.412 raeburn 8755: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8756: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8757: my $now = time;
1.609 raeburn 8758: my %displaystatus = ( previous => 'Expired',
8759: active => 'Active',
8760: future => 'Future',
8761: );
1.1075.2.36 raeburn 8762: my (%nothide,@possdoms);
1.630 raeburn 8763: if ($hidepriv) {
8764: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8765: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8766: if ($user !~ /:/) {
8767: $nothide{join(':',split(/[\@]/,$user))}=1;
8768: } else {
8769: $nothide{$user} = 1;
8770: }
8771: }
1.1075.2.36 raeburn 8772: my @possdoms = ($cdom);
8773: if ($coursehash{'checkforpriv'}) {
8774: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8775: }
1.630 raeburn 8776: }
1.439 raeburn 8777: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8778: my $match = 0;
1.412 raeburn 8779: my $secmatch = 0;
1.439 raeburn 8780: my $status;
1.412 raeburn 8781: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8782: $user =~ s/:$//;
1.439 raeburn 8783: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8784: if ($end == -1 || $start == -1) {
8785: next;
8786: }
8787: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8788: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8789: my ($uname,$udom) = split(/:/,$user);
8790: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8791: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8792: $secmatch = 1;
8793: } elsif ($usec eq '') {
1.420 albertel 8794: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8795: $secmatch = 1;
8796: }
8797: } else {
8798: if (grep(/^\Q$usec\E$/,@{$sections})) {
8799: $secmatch = 1;
8800: }
8801: }
8802: if (!$secmatch) {
8803: next;
8804: }
1.288 raeburn 8805: }
1.419 raeburn 8806: if ($usec eq '') {
8807: $usec = 'none';
8808: }
1.275 raeburn 8809: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8810: if ($hidepriv) {
1.1075.2.36 raeburn 8811: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8812: (!$nothide{$uname.':'.$udom})) {
8813: next;
8814: }
8815: }
1.503 raeburn 8816: if ($end > 0 && $end < $now) {
1.439 raeburn 8817: $status = 'previous';
8818: } elsif ($start > $now) {
8819: $status = 'future';
8820: } else {
8821: $status = 'active';
8822: }
1.277 albertel 8823: foreach my $type (keys(%{$types})) {
1.275 raeburn 8824: if ($status eq $type) {
1.420 albertel 8825: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8826: push(@{$$users{$role}{$user}},$type);
8827: }
1.288 raeburn 8828: $match = 1;
8829: }
8830: }
1.419 raeburn 8831: if (($match) && (ref($userdata) eq 'HASH')) {
8832: if (!exists($$userdata{$uname.':'.$udom})) {
8833: &get_user_info($udom,$uname,\%idx,$userdata);
8834: }
1.420 albertel 8835: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8836: push(@{$seclists{$uname.':'.$udom}},$usec);
8837: }
1.609 raeburn 8838: if (ref($statushash) eq 'HASH') {
8839: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8840: }
1.275 raeburn 8841: }
8842: }
8843: }
8844: }
1.290 albertel 8845: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8846: if ((defined($cdom)) && (defined($cnum))) {
8847: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8848: if ( defined($csettings{'internal.courseowner'}) ) {
8849: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8850: next if ($owner eq '');
8851: my ($ownername,$ownerdom);
8852: if ($owner =~ /^([^:]+):([^:]+)$/) {
8853: $ownername = $1;
8854: $ownerdom = $2;
8855: } else {
8856: $ownername = $owner;
8857: $ownerdom = $cdom;
8858: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8859: }
8860: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8861: if (defined($userdata) &&
1.609 raeburn 8862: !exists($$userdata{$owner})) {
8863: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8864: if (!grep(/^none$/,@{$seclists{$owner}})) {
8865: push(@{$seclists{$owner}},'none');
8866: }
8867: if (ref($statushash) eq 'HASH') {
8868: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8869: }
1.290 albertel 8870: }
1.279 raeburn 8871: }
8872: }
8873: }
1.419 raeburn 8874: foreach my $user (keys(%seclists)) {
8875: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8876: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8877: }
1.275 raeburn 8878: }
8879: return;
8880: }
8881:
1.288 raeburn 8882: sub get_user_info {
8883: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8884: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8885: &plainname($uname,$udom,'lastname');
1.291 albertel 8886: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8887: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8888: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8889: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8890: return;
8891: }
1.275 raeburn 8892:
1.472 raeburn 8893: ###############################################
8894:
8895: =pod
8896:
8897: =item * &get_user_quota()
8898:
1.1075.2.41 raeburn 8899: Retrieves quota assigned for storage of user files.
8900: Default is to report quota for portfolio files.
1.472 raeburn 8901:
8902: Incoming parameters:
8903: 1. user's username
8904: 2. user's domain
1.1075.2.41 raeburn 8905: 3. quota name - portfolio, author, or course
8906: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 8907: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 8908: course
1.472 raeburn 8909:
8910: Returns:
1.1075.2.58 raeburn 8911: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8912: 2. (Optional) Type of setting: custom or default
8913: (individually assigned or default for user's
8914: institutional status).
8915: 3. (Optional) - User's institutional status (e.g., faculty, staff
8916: or student - types as defined in localenroll::inst_usertypes
8917: for user's domain, which determines default quota for user.
8918: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8919:
8920: If a value has been stored in the user's environment,
1.536 raeburn 8921: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 8922: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8923:
8924: =cut
8925:
8926: ###############################################
8927:
8928:
8929: sub get_user_quota {
1.1075.2.42 raeburn 8930: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8931: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8932: if (!defined($udom)) {
8933: $udom = $env{'user.domain'};
8934: }
8935: if (!defined($uname)) {
8936: $uname = $env{'user.name'};
8937: }
8938: if (($udom eq '' || $uname eq '') ||
8939: ($udom eq 'public') && ($uname eq 'public')) {
8940: $quota = 0;
1.536 raeburn 8941: $quotatype = 'default';
8942: $defquota = 0;
1.472 raeburn 8943: } else {
1.536 raeburn 8944: my $inststatus;
1.1075.2.41 raeburn 8945: if ($quotaname eq 'course') {
8946: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8947: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8948: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8949: } else {
8950: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8951: $quota = $cenv{'internal.uploadquota'};
8952: }
1.536 raeburn 8953: } else {
1.1075.2.41 raeburn 8954: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8955: if ($quotaname eq 'author') {
8956: $quota = $env{'environment.authorquota'};
8957: } else {
8958: $quota = $env{'environment.portfolioquota'};
8959: }
8960: $inststatus = $env{'environment.inststatus'};
8961: } else {
8962: my %userenv =
8963: &Apache::lonnet::get('environment',['portfolioquota',
8964: 'authorquota','inststatus'],$udom,$uname);
8965: my ($tmp) = keys(%userenv);
8966: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8967: if ($quotaname eq 'author') {
8968: $quota = $userenv{'authorquota'};
8969: } else {
8970: $quota = $userenv{'portfolioquota'};
8971: }
8972: $inststatus = $userenv{'inststatus'};
8973: } else {
8974: undef(%userenv);
8975: }
8976: }
8977: }
8978: if ($quota eq '' || wantarray) {
8979: if ($quotaname eq 'course') {
8980: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 8981: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8982: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 8983: $defquota = $domdefs{$crstype.'quota'};
8984: }
8985: if ($defquota eq '') {
8986: $defquota = 500;
8987: }
1.1075.2.41 raeburn 8988: } else {
8989: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8990: }
8991: if ($quota eq '') {
8992: $quota = $defquota;
8993: $quotatype = 'default';
8994: } else {
8995: $quotatype = 'custom';
8996: }
1.472 raeburn 8997: }
8998: }
1.536 raeburn 8999: if (wantarray) {
9000: return ($quota,$quotatype,$settingstatus,$defquota);
9001: } else {
9002: return $quota;
9003: }
1.472 raeburn 9004: }
9005:
9006: ###############################################
9007:
9008: =pod
9009:
9010: =item * &default_quota()
9011:
1.536 raeburn 9012: Retrieves default quota assigned for storage of user portfolio files,
9013: given an (optional) user's institutional status.
1.472 raeburn 9014:
9015: Incoming parameters:
1.1075.2.42 raeburn 9016:
1.472 raeburn 9017: 1. domain
1.536 raeburn 9018: 2. (Optional) institutional status(es). This is a : separated list of
9019: status types (e.g., faculty, staff, student etc.)
9020: which apply to the user for whom the default is being retrieved.
9021: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 9022: default quota will be returned.
9023: 3. quota name - portfolio, author, or course
9024: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9025:
9026: Returns:
1.1075.2.42 raeburn 9027:
1.1075.2.58 raeburn 9028: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9029: 2. (Optional) institutional type which determined the value of the
9030: default quota.
1.472 raeburn 9031:
9032: If a value has been stored in the domain's configuration db,
9033: it will return that, otherwise it returns 20 (for backwards
9034: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 9035: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9036:
1.536 raeburn 9037: If the user's status includes multiple types (e.g., staff and student),
9038: the largest default quota which applies to the user determines the
9039: default quota returned.
9040:
1.472 raeburn 9041: =cut
9042:
9043: ###############################################
9044:
9045:
9046: sub default_quota {
1.1075.2.41 raeburn 9047: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9048: my ($defquota,$settingstatus);
9049: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9050: ['quotas'],$udom);
1.1075.2.41 raeburn 9051: my $key = 'defaultquota';
9052: if ($quotaname eq 'author') {
9053: $key = 'authorquota';
9054: }
1.622 raeburn 9055: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9056: if ($inststatus ne '') {
1.765 raeburn 9057: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9058: foreach my $item (@statuses) {
1.1075.2.41 raeburn 9059: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9060: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9061: if ($defquota eq '') {
1.1075.2.41 raeburn 9062: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9063: $settingstatus = $item;
1.1075.2.41 raeburn 9064: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9065: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9066: $settingstatus = $item;
9067: }
9068: }
1.1075.2.41 raeburn 9069: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9070: if ($quotahash{'quotas'}{$item} ne '') {
9071: if ($defquota eq '') {
9072: $defquota = $quotahash{'quotas'}{$item};
9073: $settingstatus = $item;
9074: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9075: $defquota = $quotahash{'quotas'}{$item};
9076: $settingstatus = $item;
9077: }
1.536 raeburn 9078: }
9079: }
9080: }
9081: }
9082: if ($defquota eq '') {
1.1075.2.41 raeburn 9083: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9084: $defquota = $quotahash{'quotas'}{$key}{'default'};
9085: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9086: $defquota = $quotahash{'quotas'}{'default'};
9087: }
1.536 raeburn 9088: $settingstatus = 'default';
1.1075.2.42 raeburn 9089: if ($defquota eq '') {
9090: if ($quotaname eq 'author') {
9091: $defquota = 500;
9092: }
9093: }
1.536 raeburn 9094: }
9095: } else {
9096: $settingstatus = 'default';
1.1075.2.41 raeburn 9097: if ($quotaname eq 'author') {
9098: $defquota = 500;
9099: } else {
9100: $defquota = 20;
9101: }
1.536 raeburn 9102: }
9103: if (wantarray) {
9104: return ($defquota,$settingstatus);
1.472 raeburn 9105: } else {
1.536 raeburn 9106: return $defquota;
1.472 raeburn 9107: }
9108: }
9109:
1.1075.2.41 raeburn 9110: ###############################################
9111:
9112: =pod
9113:
1.1075.2.42 raeburn 9114: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 9115:
9116: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 9117: of existing file within authoring space will cause quota for the authoring
9118: space to be exceeded.
9119:
9120: Same, if upload of a file directly to a course/community via Course Editor
9121: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 9122:
1.1075.2.61 raeburn 9123: Inputs: 7
1.1075.2.42 raeburn 9124: 1. username or coursenum
1.1075.2.41 raeburn 9125: 2. domain
1.1075.2.42 raeburn 9126: 3. context ('author' or 'course')
1.1075.2.41 raeburn 9127: 4. filename of file for which action is being requested
9128: 5. filesize (kB) of file
9129: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 9130: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 9131:
9132: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
9133: otherwise return null.
9134:
1.1075.2.42 raeburn 9135: =back
9136:
1.1075.2.41 raeburn 9137: =cut
9138:
1.1075.2.42 raeburn 9139: sub excess_filesize_warning {
1.1075.2.59 raeburn 9140: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 9141: my $current_disk_usage = 0;
1.1075.2.59 raeburn 9142: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 9143: if ($context eq 'author') {
9144: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9145: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9146: } else {
9147: foreach my $subdir ('docs','supplemental') {
9148: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9149: }
9150: }
1.1075.2.41 raeburn 9151: $disk_quota = int($disk_quota * 1000);
9152: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69 raeburn 9153: return '<p class="LC_warning">'.
1.1075.2.41 raeburn 9154: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69 raeburn 9155: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9156: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41 raeburn 9157: $disk_quota,$current_disk_usage).
9158: '</p>';
9159: }
9160: return;
9161: }
9162:
9163: ###############################################
9164:
9165:
1.384 raeburn 9166: sub get_secgrprole_info {
9167: my ($cdom,$cnum,$needroles,$type) = @_;
9168: my %sections_count = &get_sections($cdom,$cnum);
9169: my @sections = (sort {$a <=> $b} keys(%sections_count));
9170: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9171: my @groups = sort(keys(%curr_groups));
9172: my $allroles = [];
9173: my $rolehash;
9174: my $accesshash = {
9175: active => 'Currently has access',
9176: future => 'Will have future access',
9177: previous => 'Previously had access',
9178: };
9179: if ($needroles) {
9180: $rolehash = {'all' => 'all'};
1.385 albertel 9181: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9182: if (&Apache::lonnet::error(%user_roles)) {
9183: undef(%user_roles);
9184: }
9185: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9186: my ($role)=split(/\:/,$item,2);
9187: if ($role eq 'cr') { next; }
9188: if ($role =~ /^cr/) {
9189: $$rolehash{$role} = (split('/',$role))[3];
9190: } else {
9191: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9192: }
9193: }
9194: foreach my $key (sort(keys(%{$rolehash}))) {
9195: push(@{$allroles},$key);
9196: }
9197: push (@{$allroles},'st');
9198: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9199: }
9200: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9201: }
9202:
1.555 raeburn 9203: sub user_picker {
1.994 raeburn 9204: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9205: my $currdom = $dom;
9206: my %curr_selected = (
9207: srchin => 'dom',
1.580 raeburn 9208: srchby => 'lastname',
1.555 raeburn 9209: );
9210: my $srchterm;
1.625 raeburn 9211: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9212: if ($srch->{'srchby'} ne '') {
9213: $curr_selected{'srchby'} = $srch->{'srchby'};
9214: }
9215: if ($srch->{'srchin'} ne '') {
9216: $curr_selected{'srchin'} = $srch->{'srchin'};
9217: }
9218: if ($srch->{'srchtype'} ne '') {
9219: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9220: }
9221: if ($srch->{'srchdomain'} ne '') {
9222: $currdom = $srch->{'srchdomain'};
9223: }
9224: $srchterm = $srch->{'srchterm'};
9225: }
9226: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9227: 'usr' => 'Search criteria',
1.563 raeburn 9228: 'doma' => 'Domain/institution to search',
1.558 albertel 9229: 'uname' => 'username',
9230: 'lastname' => 'last name',
1.555 raeburn 9231: 'lastfirst' => 'last name, first name',
1.558 albertel 9232: 'crs' => 'in this course',
1.576 raeburn 9233: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9234: 'alc' => 'all LON-CAPA',
1.573 raeburn 9235: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9236: 'exact' => 'is',
9237: 'contains' => 'contains',
1.569 raeburn 9238: 'begins' => 'begins with',
1.571 raeburn 9239: 'youm' => "You must include some text to search for.",
9240: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9241: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9242: 'yomc' => "You must choose a domain when using an institutional directory search.",
9243: 'ymcd' => "You must choose a domain when using a domain search.",
9244: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9245: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9246: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9247: );
1.563 raeburn 9248: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9249: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9250:
9251: my @srchins = ('crs','dom','alc','instd');
9252:
9253: foreach my $option (@srchins) {
9254: # FIXME 'alc' option unavailable until
9255: # loncreateuser::print_user_query_page()
9256: # has been completed.
9257: next if ($option eq 'alc');
1.880 raeburn 9258: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9259: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9260: if ($curr_selected{'srchin'} eq $option) {
9261: $srchinsel .= '
9262: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9263: } else {
9264: $srchinsel .= '
9265: <option value="'.$option.'">'.$lt{$option}.'</option>';
9266: }
1.555 raeburn 9267: }
1.563 raeburn 9268: $srchinsel .= "\n </select>\n";
1.555 raeburn 9269:
9270: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9271: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9272: if ($curr_selected{'srchby'} eq $option) {
9273: $srchbysel .= '
9274: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9275: } else {
9276: $srchbysel .= '
9277: <option value="'.$option.'">'.$lt{$option}.'</option>';
9278: }
9279: }
9280: $srchbysel .= "\n </select>\n";
9281:
9282: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9283: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9284: if ($curr_selected{'srchtype'} eq $option) {
9285: $srchtypesel .= '
9286: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9287: } else {
9288: $srchtypesel .= '
9289: <option value="'.$option.'">'.$lt{$option}.'</option>';
9290: }
9291: }
9292: $srchtypesel .= "\n </select>\n";
9293:
1.558 albertel 9294: my ($newuserscript,$new_user_create);
1.994 raeburn 9295: my $context_dom = $env{'request.role.domain'};
9296: if ($context eq 'requestcrs') {
9297: if ($env{'form.coursedom'} ne '') {
9298: $context_dom = $env{'form.coursedom'};
9299: }
9300: }
1.556 raeburn 9301: if ($forcenewuser) {
1.576 raeburn 9302: if (ref($srch) eq 'HASH') {
1.994 raeburn 9303: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9304: if ($cancreate) {
9305: $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>';
9306: } else {
1.799 bisitz 9307: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9308: my %usertypetext = (
9309: official => 'institutional',
9310: unofficial => 'non-institutional',
9311: );
1.799 bisitz 9312: $new_user_create = '<p class="LC_warning">'
9313: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9314: .' '
9315: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9316: ,'<a href="'.$helplink.'">','</a>')
9317: .'</p><br />';
1.627 raeburn 9318: }
1.576 raeburn 9319: }
9320: }
9321:
1.556 raeburn 9322: $newuserscript = <<"ENDSCRIPT";
9323:
1.570 raeburn 9324: function setSearch(createnew,callingForm) {
1.556 raeburn 9325: if (createnew == 1) {
1.570 raeburn 9326: for (var i=0; i<callingForm.srchby.length; i++) {
9327: if (callingForm.srchby.options[i].value == 'uname') {
9328: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9329: }
9330: }
1.570 raeburn 9331: for (var i=0; i<callingForm.srchin.length; i++) {
9332: if ( callingForm.srchin.options[i].value == 'dom') {
9333: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9334: }
9335: }
1.570 raeburn 9336: for (var i=0; i<callingForm.srchtype.length; i++) {
9337: if (callingForm.srchtype.options[i].value == 'exact') {
9338: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9339: }
9340: }
1.570 raeburn 9341: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9342: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9343: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9344: }
9345: }
9346: }
9347: }
9348: ENDSCRIPT
1.558 albertel 9349:
1.556 raeburn 9350: }
9351:
1.555 raeburn 9352: my $output = <<"END_BLOCK";
1.556 raeburn 9353: <script type="text/javascript">
1.824 bisitz 9354: // <![CDATA[
1.570 raeburn 9355: function validateEntry(callingForm) {
1.558 albertel 9356:
1.556 raeburn 9357: var checkok = 1;
1.558 albertel 9358: var srchin;
1.570 raeburn 9359: for (var i=0; i<callingForm.srchin.length; i++) {
9360: if ( callingForm.srchin[i].checked ) {
9361: srchin = callingForm.srchin[i].value;
1.558 albertel 9362: }
9363: }
9364:
1.570 raeburn 9365: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9366: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9367: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9368: var srchterm = callingForm.srchterm.value;
9369: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9370: var msg = "";
9371:
9372: if (srchterm == "") {
9373: checkok = 0;
1.571 raeburn 9374: msg += "$lt{'youm'}\\n";
1.556 raeburn 9375: }
9376:
1.569 raeburn 9377: if (srchtype== 'begins') {
9378: if (srchterm.length < 2) {
9379: checkok = 0;
1.571 raeburn 9380: msg += "$lt{'thte'}\\n";
1.569 raeburn 9381: }
9382: }
9383:
1.556 raeburn 9384: if (srchtype== 'contains') {
9385: if (srchterm.length < 3) {
9386: checkok = 0;
1.571 raeburn 9387: msg += "$lt{'thet'}\\n";
1.556 raeburn 9388: }
9389: }
9390: if (srchin == 'instd') {
9391: if (srchdomain == '') {
9392: checkok = 0;
1.571 raeburn 9393: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9394: }
9395: }
9396: if (srchin == 'dom') {
9397: if (srchdomain == '') {
9398: checkok = 0;
1.571 raeburn 9399: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9400: }
9401: }
9402: if (srchby == 'lastfirst') {
9403: if (srchterm.indexOf(",") == -1) {
9404: checkok = 0;
1.571 raeburn 9405: msg += "$lt{'whus'}\\n";
1.556 raeburn 9406: }
9407: if (srchterm.indexOf(",") == srchterm.length -1) {
9408: checkok = 0;
1.571 raeburn 9409: msg += "$lt{'whse'}\\n";
1.556 raeburn 9410: }
9411: }
9412: if (checkok == 0) {
1.571 raeburn 9413: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9414: return;
9415: }
9416: if (checkok == 1) {
1.570 raeburn 9417: callingForm.submit();
1.556 raeburn 9418: }
9419: }
9420:
9421: $newuserscript
9422:
1.824 bisitz 9423: // ]]>
1.556 raeburn 9424: </script>
1.558 albertel 9425:
9426: $new_user_create
9427:
1.555 raeburn 9428: END_BLOCK
1.558 albertel 9429:
1.876 raeburn 9430: $output .= &Apache::lonhtmlcommon::start_pick_box().
9431: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9432: $domform.
9433: &Apache::lonhtmlcommon::row_closure().
9434: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9435: $srchbysel.
9436: $srchtypesel.
9437: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9438: $srchinsel.
9439: &Apache::lonhtmlcommon::row_closure(1).
9440: &Apache::lonhtmlcommon::end_pick_box().
9441: '<br />';
1.555 raeburn 9442: return $output;
9443: }
9444:
1.612 raeburn 9445: sub user_rule_check {
1.615 raeburn 9446: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9447: my $response;
9448: if (ref($usershash) eq 'HASH') {
9449: foreach my $user (keys(%{$usershash})) {
9450: my ($uname,$udom) = split(/:/,$user);
9451: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9452: my ($id,$newuser);
1.612 raeburn 9453: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9454: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9455: $id = $usershash->{$user}->{'id'};
9456: }
9457: my $inst_response;
9458: if (ref($checks) eq 'HASH') {
9459: if (defined($checks->{'username'})) {
1.615 raeburn 9460: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9461: &Apache::lonnet::get_instuser($udom,$uname);
9462: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9463: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9464: &Apache::lonnet::get_instuser($udom,undef,$id);
9465: }
1.615 raeburn 9466: } else {
9467: ($inst_response,%{$inst_results->{$user}}) =
9468: &Apache::lonnet::get_instuser($udom,$uname);
9469: return;
1.612 raeburn 9470: }
1.615 raeburn 9471: if (!$got_rules->{$udom}) {
1.612 raeburn 9472: my %domconfig = &Apache::lonnet::get_dom('configuration',
9473: ['usercreation'],$udom);
9474: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9475: foreach my $item ('username','id') {
1.612 raeburn 9476: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9477: $$curr_rules{$udom}{$item} =
9478: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9479: }
9480: }
9481: }
1.615 raeburn 9482: $got_rules->{$udom} = 1;
1.585 raeburn 9483: }
1.612 raeburn 9484: foreach my $item (keys(%{$checks})) {
9485: if (ref($$curr_rules{$udom}) eq 'HASH') {
9486: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9487: if (@{$$curr_rules{$udom}{$item}} > 0) {
9488: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9489: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9490: if ($rule_check{$rule}) {
9491: $$rulematch{$user}{$item} = $rule;
9492: if ($inst_response eq 'ok') {
1.615 raeburn 9493: if (ref($inst_results) eq 'HASH') {
9494: if (ref($inst_results->{$user}) eq 'HASH') {
9495: if (keys(%{$inst_results->{$user}}) == 0) {
9496: $$alerts{$item}{$udom}{$uname} = 1;
9497: }
1.612 raeburn 9498: }
9499: }
1.615 raeburn 9500: }
9501: last;
1.585 raeburn 9502: }
9503: }
9504: }
9505: }
9506: }
9507: }
9508: }
9509: }
1.612 raeburn 9510: return;
9511: }
9512:
9513: sub user_rule_formats {
9514: my ($domain,$domdesc,$curr_rules,$check) = @_;
9515: my %text = (
9516: 'username' => 'Usernames',
9517: 'id' => 'IDs',
9518: );
9519: my $output;
9520: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9521: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9522: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 9523: $output = '<br />'.
9524: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9525: '<span class="LC_cusr_emph">','</span>',$domdesc).
9526: ' <ul>';
1.612 raeburn 9527: foreach my $rule (@{$ruleorder}) {
9528: if (ref($curr_rules) eq 'ARRAY') {
9529: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9530: if (ref($rules->{$rule}) eq 'HASH') {
9531: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9532: $rules->{$rule}{'desc'}.'</li>';
9533: }
9534: }
9535: }
9536: }
9537: $output .= '</ul>';
9538: }
9539: }
9540: return $output;
9541: }
9542:
9543: sub instrule_disallow_msg {
1.615 raeburn 9544: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9545: my $response;
9546: my %text = (
9547: item => 'username',
9548: items => 'usernames',
9549: match => 'matches',
9550: do => 'does',
9551: action => 'a username',
9552: one => 'one',
9553: );
9554: if ($count > 1) {
9555: $text{'item'} = 'usernames';
9556: $text{'match'} ='match';
9557: $text{'do'} = 'do';
9558: $text{'action'} = 'usernames',
9559: $text{'one'} = 'ones';
9560: }
9561: if ($checkitem eq 'id') {
9562: $text{'items'} = 'IDs';
9563: $text{'item'} = 'ID';
9564: $text{'action'} = 'an ID';
1.615 raeburn 9565: if ($count > 1) {
9566: $text{'item'} = 'IDs';
9567: $text{'action'} = 'IDs';
9568: }
1.612 raeburn 9569: }
1.674 bisitz 9570: $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 9571: if ($mode eq 'upload') {
9572: if ($checkitem eq 'username') {
9573: $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'}.");
9574: } elsif ($checkitem eq 'id') {
1.674 bisitz 9575: $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 9576: }
1.669 raeburn 9577: } elsif ($mode eq 'selfcreate') {
9578: if ($checkitem eq 'id') {
9579: $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.");
9580: }
1.615 raeburn 9581: } else {
9582: if ($checkitem eq 'username') {
9583: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9584: } elsif ($checkitem eq 'id') {
9585: $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.");
9586: }
1.612 raeburn 9587: }
9588: return $response;
1.585 raeburn 9589: }
9590:
1.624 raeburn 9591: sub personal_data_fieldtitles {
9592: my %fieldtitles = &Apache::lonlocal::texthash (
9593: id => 'Student/Employee ID',
9594: permanentemail => 'E-mail address',
9595: lastname => 'Last Name',
9596: firstname => 'First Name',
9597: middlename => 'Middle Name',
9598: generation => 'Generation',
9599: gen => 'Generation',
1.765 raeburn 9600: inststatus => 'Affiliation',
1.624 raeburn 9601: );
9602: return %fieldtitles;
9603: }
9604:
1.642 raeburn 9605: sub sorted_inst_types {
9606: my ($dom) = @_;
1.1075.2.70 raeburn 9607: my ($usertypes,$order);
9608: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9609: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9610: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9611: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9612: } else {
9613: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9614: }
1.642 raeburn 9615: my $othertitle = &mt('All users');
9616: if ($env{'request.course.id'}) {
1.668 raeburn 9617: $othertitle = &mt('Any users');
1.642 raeburn 9618: }
9619: my @types;
9620: if (ref($order) eq 'ARRAY') {
9621: @types = @{$order};
9622: }
9623: if (@types == 0) {
9624: if (ref($usertypes) eq 'HASH') {
9625: @types = sort(keys(%{$usertypes}));
9626: }
9627: }
9628: if (keys(%{$usertypes}) > 0) {
9629: $othertitle = &mt('Other users');
9630: }
9631: return ($othertitle,$usertypes,\@types);
9632: }
9633:
1.645 raeburn 9634: sub get_institutional_codes {
9635: my ($settings,$allcourses,$LC_code) = @_;
9636: # Get complete list of course sections to update
9637: my @currsections = ();
9638: my @currxlists = ();
9639: my $coursecode = $$settings{'internal.coursecode'};
9640:
9641: if ($$settings{'internal.sectionnums'} ne '') {
9642: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9643: }
9644:
9645: if ($$settings{'internal.crosslistings'} ne '') {
9646: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9647: }
9648:
9649: if (@currxlists > 0) {
9650: foreach (@currxlists) {
9651: if (m/^([^:]+):(\w*)$/) {
9652: unless (grep/^$1$/,@{$allcourses}) {
9653: push @{$allcourses},$1;
9654: $$LC_code{$1} = $2;
9655: }
9656: }
9657: }
9658: }
9659:
9660: if (@currsections > 0) {
9661: foreach (@currsections) {
9662: if (m/^(\w+):(\w*)$/) {
9663: my $sec = $coursecode.$1;
9664: my $lc_sec = $2;
9665: unless (grep/^$sec$/,@{$allcourses}) {
9666: push @{$allcourses},$sec;
9667: $$LC_code{$sec} = $lc_sec;
9668: }
9669: }
9670: }
9671: }
9672: return;
9673: }
9674:
1.971 raeburn 9675: sub get_standard_codeitems {
9676: return ('Year','Semester','Department','Number','Section');
9677: }
9678:
1.112 bowersj2 9679: =pod
9680:
1.780 raeburn 9681: =head1 Slot Helpers
9682:
9683: =over 4
9684:
9685: =item * sorted_slots()
9686:
1.1040 raeburn 9687: Sorts an array of slot names in order of an optional sort key,
9688: default sort is by slot start time (earliest first).
1.780 raeburn 9689:
9690: Inputs:
9691:
9692: =over 4
9693:
9694: slotsarr - Reference to array of unsorted slot names.
9695:
9696: slots - Reference to hash of hash, where outer hash keys are slot names.
9697:
1.1040 raeburn 9698: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9699:
1.549 albertel 9700: =back
9701:
1.780 raeburn 9702: Returns:
9703:
9704: =over 4
9705:
1.1040 raeburn 9706: sorted - An array of slot names sorted by a specified sort key
9707: (default sort key is start time of the slot).
1.780 raeburn 9708:
9709: =back
9710:
9711: =cut
9712:
9713:
9714: sub sorted_slots {
1.1040 raeburn 9715: my ($slotsarr,$slots,$sortkey) = @_;
9716: if ($sortkey eq '') {
9717: $sortkey = 'starttime';
9718: }
1.780 raeburn 9719: my @sorted;
9720: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9721: @sorted =
9722: sort {
9723: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9724: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9725: }
9726: if (ref($slots->{$a})) { return -1;}
9727: if (ref($slots->{$b})) { return 1;}
9728: return 0;
9729: } @{$slotsarr};
9730: }
9731: return @sorted;
9732: }
9733:
1.1040 raeburn 9734: =pod
9735:
9736: =item * get_future_slots()
9737:
9738: Inputs:
9739:
9740: =over 4
9741:
9742: cnum - course number
9743:
9744: cdom - course domain
9745:
9746: now - current UNIX time
9747:
9748: symb - optional symb
9749:
9750: =back
9751:
9752: Returns:
9753:
9754: =over 4
9755:
9756: sorted_reservable - ref to array of student_schedulable slots currently
9757: reservable, ordered by end date of reservation period.
9758:
9759: reservable_now - ref to hash of student_schedulable slots currently
9760: reservable.
9761:
9762: Keys in inner hash are:
9763: (a) symb: either blank or symb to which slot use is restricted.
9764: (b) endreserve: end date of reservation period.
9765:
9766: sorted_future - ref to array of student_schedulable slots reservable in
9767: the future, ordered by start date of reservation period.
9768:
9769: future_reservable - ref to hash of student_schedulable slots reservable
9770: in the future.
9771:
9772: Keys in inner hash are:
9773: (a) symb: either blank or symb to which slot use is restricted.
9774: (b) startreserve: start date of reservation period.
9775:
9776: =back
9777:
9778: =cut
9779:
9780: sub get_future_slots {
9781: my ($cnum,$cdom,$now,$symb) = @_;
9782: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9783: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9784: foreach my $slot (keys(%slots)) {
9785: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9786: if ($symb) {
9787: next if (($slots{$slot}->{'symb'} ne '') &&
9788: ($slots{$slot}->{'symb'} ne $symb));
9789: }
9790: if (($slots{$slot}->{'starttime'} > $now) &&
9791: ($slots{$slot}->{'endtime'} > $now)) {
9792: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9793: my $userallowed = 0;
9794: if ($slots{$slot}->{'allowedsections'}) {
9795: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9796: if (!defined($env{'request.role.sec'})
9797: && grep(/^No section assigned$/,@allowed_sec)) {
9798: $userallowed=1;
9799: } else {
9800: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9801: $userallowed=1;
9802: }
9803: }
9804: unless ($userallowed) {
9805: if (defined($env{'request.course.groups'})) {
9806: my @groups = split(/:/,$env{'request.course.groups'});
9807: foreach my $group (@groups) {
9808: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9809: $userallowed=1;
9810: last;
9811: }
9812: }
9813: }
9814: }
9815: }
9816: if ($slots{$slot}->{'allowedusers'}) {
9817: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9818: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9819: if (grep(/^\Q$user\E$/,@allowed_users)) {
9820: $userallowed = 1;
9821: }
9822: }
9823: next unless($userallowed);
9824: }
9825: my $startreserve = $slots{$slot}->{'startreserve'};
9826: my $endreserve = $slots{$slot}->{'endreserve'};
9827: my $symb = $slots{$slot}->{'symb'};
9828: if (($startreserve < $now) &&
9829: (!$endreserve || $endreserve > $now)) {
9830: my $lastres = $endreserve;
9831: if (!$lastres) {
9832: $lastres = $slots{$slot}->{'starttime'};
9833: }
9834: $reservable_now{$slot} = {
9835: symb => $symb,
9836: endreserve => $lastres
9837: };
9838: } elsif (($startreserve > $now) &&
9839: (!$endreserve || $endreserve > $startreserve)) {
9840: $future_reservable{$slot} = {
9841: symb => $symb,
9842: startreserve => $startreserve
9843: };
9844: }
9845: }
9846: }
9847: my @unsorted_reservable = keys(%reservable_now);
9848: if (@unsorted_reservable > 0) {
9849: @sorted_reservable =
9850: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9851: }
9852: my @unsorted_future = keys(%future_reservable);
9853: if (@unsorted_future > 0) {
9854: @sorted_future =
9855: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9856: }
9857: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9858: }
1.780 raeburn 9859:
9860: =pod
9861:
1.1057 foxr 9862: =back
9863:
1.549 albertel 9864: =head1 HTTP Helpers
9865:
9866: =over 4
9867:
1.648 raeburn 9868: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9869:
1.258 albertel 9870: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9871: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9872: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9873:
9874: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9875: $possible_names is an ref to an array of form element names. As an example:
9876: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9877: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9878:
9879: =cut
1.1 albertel 9880:
1.6 albertel 9881: sub get_unprocessed_cgi {
1.25 albertel 9882: my ($query,$possible_names)= @_;
1.26 matthew 9883: # $Apache::lonxml::debug=1;
1.356 albertel 9884: foreach my $pair (split(/&/,$query)) {
9885: my ($name, $value) = split(/=/,$pair);
1.369 www 9886: $name = &unescape($name);
1.25 albertel 9887: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9888: $value =~ tr/+/ /;
9889: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9890: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9891: }
1.16 harris41 9892: }
1.6 albertel 9893: }
9894:
1.112 bowersj2 9895: =pod
9896:
1.648 raeburn 9897: =item * &cacheheader()
1.112 bowersj2 9898:
9899: returns cache-controlling header code
9900:
9901: =cut
9902:
1.7 albertel 9903: sub cacheheader {
1.258 albertel 9904: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9905: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9906: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9907: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9908: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9909: return $output;
1.7 albertel 9910: }
9911:
1.112 bowersj2 9912: =pod
9913:
1.648 raeburn 9914: =item * &no_cache($r)
1.112 bowersj2 9915:
9916: specifies header code to not have cache
9917:
9918: =cut
9919:
1.9 albertel 9920: sub no_cache {
1.216 albertel 9921: my ($r) = @_;
9922: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9923: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9924: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9925: $r->no_cache(1);
9926: $r->header_out("Expires" => $date);
9927: $r->header_out("Pragma" => "no-cache");
1.123 www 9928: }
9929:
9930: sub content_type {
1.181 albertel 9931: my ($r,$type,$charset) = @_;
1.299 foxr 9932: if ($r) {
9933: # Note that printout.pl calls this with undef for $r.
9934: &no_cache($r);
9935: }
1.258 albertel 9936: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9937: unless ($charset) {
9938: $charset=&Apache::lonlocal::current_encoding;
9939: }
9940: if ($charset) { $type.='; charset='.$charset; }
9941: if ($r) {
9942: $r->content_type($type);
9943: } else {
9944: print("Content-type: $type\n\n");
9945: }
1.9 albertel 9946: }
1.25 albertel 9947:
1.112 bowersj2 9948: =pod
9949:
1.648 raeburn 9950: =item * &add_to_env($name,$value)
1.112 bowersj2 9951:
1.258 albertel 9952: adds $name to the %env hash with value
1.112 bowersj2 9953: $value, if $name already exists, the entry is converted to an array
9954: reference and $value is added to the array.
9955:
9956: =cut
9957:
1.25 albertel 9958: sub add_to_env {
9959: my ($name,$value)=@_;
1.258 albertel 9960: if (defined($env{$name})) {
9961: if (ref($env{$name})) {
1.25 albertel 9962: #already have multiple values
1.258 albertel 9963: push(@{ $env{$name} },$value);
1.25 albertel 9964: } else {
9965: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9966: my $first=$env{$name};
9967: undef($env{$name});
9968: push(@{ $env{$name} },$first,$value);
1.25 albertel 9969: }
9970: } else {
1.258 albertel 9971: $env{$name}=$value;
1.25 albertel 9972: }
1.31 albertel 9973: }
1.149 albertel 9974:
9975: =pod
9976:
1.648 raeburn 9977: =item * &get_env_multiple($name)
1.149 albertel 9978:
1.258 albertel 9979: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9980: values may be defined and end up as an array ref.
9981:
9982: returns an array of values
9983:
9984: =cut
9985:
9986: sub get_env_multiple {
9987: my ($name) = @_;
9988: my @values;
1.258 albertel 9989: if (defined($env{$name})) {
1.149 albertel 9990: # exists is it an array
1.258 albertel 9991: if (ref($env{$name})) {
9992: @values=@{ $env{$name} };
1.149 albertel 9993: } else {
1.258 albertel 9994: $values[0]=$env{$name};
1.149 albertel 9995: }
9996: }
9997: return(@values);
9998: }
9999:
1.660 raeburn 10000: sub ask_for_embedded_content {
10001: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10002: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 10003: %currsubfile,%unused,$rem);
1.1071 raeburn 10004: my $counter = 0;
10005: my $numnew = 0;
1.987 raeburn 10006: my $numremref = 0;
10007: my $numinvalid = 0;
10008: my $numpathchg = 0;
10009: my $numexisting = 0;
1.1071 raeburn 10010: my $numunused = 0;
10011: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 10012: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10013: my $heading = &mt('Upload embedded files');
10014: my $buttontext = &mt('Upload');
10015:
1.1075.2.11 raeburn 10016: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 10017: if ($actionurl eq '/adm/dependencies') {
10018: $navmap = Apache::lonnavmaps::navmap->new();
10019: }
10020: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10021: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 10022: }
1.1075.2.35 raeburn 10023: if (($actionurl eq '/adm/portfolio') ||
10024: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10025: my $current_path='/';
10026: if ($env{'form.currentpath'}) {
10027: $current_path = $env{'form.currentpath'};
10028: }
10029: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 10030: $udom = $cdom;
10031: $uname = $cnum;
1.984 raeburn 10032: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10033: } else {
10034: $udom = $env{'user.domain'};
10035: $uname = $env{'user.name'};
10036: $url = '/userfiles/portfolio';
10037: }
1.987 raeburn 10038: $toplevel = $url.'/';
1.984 raeburn 10039: $url .= $current_path;
10040: $getpropath = 1;
1.987 raeburn 10041: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10042: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10043: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10044: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10045: $toplevel = $url;
1.984 raeburn 10046: if ($rest ne '') {
1.987 raeburn 10047: $url .= $rest;
10048: }
10049: } elsif ($actionurl eq '/adm/coursedocs') {
10050: if (ref($args) eq 'HASH') {
1.1071 raeburn 10051: $url = $args->{'docs_url'};
10052: $toplevel = $url;
1.1075.2.11 raeburn 10053: if ($args->{'context'} eq 'paste') {
10054: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10055: ($path) =
10056: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10057: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10058: $fileloc =~ s{^/}{};
10059: }
1.1071 raeburn 10060: }
10061: } elsif ($actionurl eq '/adm/dependencies') {
10062: if ($env{'request.course.id'} ne '') {
10063: if (ref($args) eq 'HASH') {
10064: $url = $args->{'docs_url'};
10065: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 10066: $toplevel = $url;
10067: unless ($toplevel =~ m{^/}) {
10068: $toplevel = "/$url";
10069: }
1.1075.2.11 raeburn 10070: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 10071: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10072: $path = $1;
10073: } else {
10074: ($path) =
10075: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10076: }
1.1075.2.79 raeburn 10077: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10078: $fileloc = $toplevel;
10079: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10080: my ($udom,$uname,$fname) =
10081: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10082: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10083: } else {
10084: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10085: }
1.1071 raeburn 10086: $fileloc =~ s{^/}{};
10087: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10088: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10089: }
1.987 raeburn 10090: }
1.1075.2.35 raeburn 10091: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10092: $udom = $cdom;
10093: $uname = $cnum;
10094: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10095: $toplevel = $url;
10096: $path = $url;
10097: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10098: $fileloc =~ s{^/}{};
10099: }
10100: foreach my $file (keys(%{$allfiles})) {
10101: my $embed_file;
10102: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10103: $embed_file = $1;
10104: } else {
10105: $embed_file = $file;
10106: }
1.1075.2.55 raeburn 10107: my ($absolutepath,$cleaned_file);
10108: if ($embed_file =~ m{^\w+://}) {
10109: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 10110: $newfiles{$cleaned_file} = 1;
10111: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10112: } else {
1.1075.2.55 raeburn 10113: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10114: if ($embed_file =~ m{^/}) {
10115: $absolutepath = $embed_file;
10116: }
1.1075.2.47 raeburn 10117: if ($cleaned_file =~ m{/}) {
10118: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10119: $path = &check_for_traversal($path,$url,$toplevel);
10120: my $item = $fname;
10121: if ($path ne '') {
10122: $item = $path.'/'.$fname;
10123: $subdependencies{$path}{$fname} = 1;
10124: } else {
10125: $dependencies{$item} = 1;
10126: }
10127: if ($absolutepath) {
10128: $mapping{$item} = $absolutepath;
10129: } else {
10130: $mapping{$item} = $embed_file;
10131: }
10132: } else {
10133: $dependencies{$embed_file} = 1;
10134: if ($absolutepath) {
1.1075.2.47 raeburn 10135: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10136: } else {
1.1075.2.47 raeburn 10137: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10138: }
10139: }
1.984 raeburn 10140: }
10141: }
1.1071 raeburn 10142: my $dirptr = 16384;
1.984 raeburn 10143: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10144: $currsubfile{$path} = {};
1.1075.2.35 raeburn 10145: if (($actionurl eq '/adm/portfolio') ||
10146: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10147: my ($sublistref,$listerror) =
10148: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10149: if (ref($sublistref) eq 'ARRAY') {
10150: foreach my $line (@{$sublistref}) {
10151: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10152: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10153: }
1.984 raeburn 10154: }
1.987 raeburn 10155: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10156: if (opendir(my $dir,$url.'/'.$path)) {
10157: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10158: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10159: }
1.1075.2.11 raeburn 10160: } elsif (($actionurl eq '/adm/dependencies') ||
10161: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10162: ($args->{'context'} eq 'paste')) ||
10163: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10164: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 10165: my $dir;
10166: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10167: $dir = $fileloc;
10168: } else {
10169: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10170: }
1.1071 raeburn 10171: if ($dir ne '') {
10172: my ($sublistref,$listerror) =
10173: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10174: if (ref($sublistref) eq 'ARRAY') {
10175: foreach my $line (@{$sublistref}) {
10176: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10177: undef,$mtime)=split(/\&/,$line,12);
10178: unless (($testdir&$dirptr) ||
10179: ($file_name =~ /^\.\.?$/)) {
10180: $currsubfile{$path}{$file_name} = [$size,$mtime];
10181: }
10182: }
10183: }
10184: }
1.984 raeburn 10185: }
10186: }
10187: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10188: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10189: my $item = $path.'/'.$file;
10190: unless ($mapping{$item} eq $item) {
10191: $pathchanges{$item} = 1;
10192: }
10193: $existing{$item} = 1;
10194: $numexisting ++;
10195: } else {
10196: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10197: }
10198: }
1.1071 raeburn 10199: if ($actionurl eq '/adm/dependencies') {
10200: foreach my $path (keys(%currsubfile)) {
10201: if (ref($currsubfile{$path}) eq 'HASH') {
10202: foreach my $file (keys(%{$currsubfile{$path}})) {
10203: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 10204: next if (($rem ne '') &&
10205: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10206: (ref($navmap) &&
10207: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10208: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10209: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10210: $unused{$path.'/'.$file} = 1;
10211: }
10212: }
10213: }
10214: }
10215: }
1.984 raeburn 10216: }
1.987 raeburn 10217: my %currfile;
1.1075.2.35 raeburn 10218: if (($actionurl eq '/adm/portfolio') ||
10219: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10220: my ($dirlistref,$listerror) =
10221: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10222: if (ref($dirlistref) eq 'ARRAY') {
10223: foreach my $line (@{$dirlistref}) {
10224: my ($file_name,$rest) = split(/\&/,$line,2);
10225: $currfile{$file_name} = 1;
10226: }
1.984 raeburn 10227: }
1.987 raeburn 10228: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10229: if (opendir(my $dir,$url)) {
1.987 raeburn 10230: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10231: map {$currfile{$_} = 1;} @dir_list;
10232: }
1.1075.2.11 raeburn 10233: } elsif (($actionurl eq '/adm/dependencies') ||
10234: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10235: ($args->{'context'} eq 'paste')) ||
10236: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10237: if ($env{'request.course.id'} ne '') {
10238: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10239: if ($dir ne '') {
10240: my ($dirlistref,$listerror) =
10241: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10242: if (ref($dirlistref) eq 'ARRAY') {
10243: foreach my $line (@{$dirlistref}) {
10244: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10245: $size,undef,$mtime)=split(/\&/,$line,12);
10246: unless (($testdir&$dirptr) ||
10247: ($file_name =~ /^\.\.?$/)) {
10248: $currfile{$file_name} = [$size,$mtime];
10249: }
10250: }
10251: }
10252: }
10253: }
1.984 raeburn 10254: }
10255: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10256: if (exists($currfile{$file})) {
1.987 raeburn 10257: unless ($mapping{$file} eq $file) {
10258: $pathchanges{$file} = 1;
10259: }
10260: $existing{$file} = 1;
10261: $numexisting ++;
10262: } else {
1.984 raeburn 10263: $newfiles{$file} = 1;
10264: }
10265: }
1.1071 raeburn 10266: foreach my $file (keys(%currfile)) {
10267: unless (($file eq $filename) ||
10268: ($file eq $filename.'.bak') ||
10269: ($dependencies{$file})) {
1.1075.2.11 raeburn 10270: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 10271: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10272: next if (($rem ne '') &&
10273: (($env{"httpref.$rem".$file} ne '') ||
10274: (ref($navmap) &&
10275: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10276: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10277: ($navmap->getResourceByUrl($rem.$1)))))));
10278: }
1.1075.2.11 raeburn 10279: }
1.1071 raeburn 10280: $unused{$file} = 1;
10281: }
10282: }
1.1075.2.11 raeburn 10283: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10284: ($args->{'context'} eq 'paste')) {
10285: $counter = scalar(keys(%existing));
10286: $numpathchg = scalar(keys(%pathchanges));
10287: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 10288: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10289: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10290: $counter = scalar(keys(%existing));
10291: $numpathchg = scalar(keys(%pathchanges));
10292: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 10293: }
1.984 raeburn 10294: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10295: if ($actionurl eq '/adm/dependencies') {
10296: next if ($embed_file =~ m{^\w+://});
10297: }
1.660 raeburn 10298: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10299: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10300: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10301: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 10302: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10303: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10304: }
1.1075.2.35 raeburn 10305: $upload_output .= '</td>';
1.1071 raeburn 10306: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 10307: $upload_output.='<td align="right">'.
10308: '<span class="LC_info LC_fontsize_medium">'.
10309: &mt("URL points to web address").'</span>';
1.987 raeburn 10310: $numremref++;
1.660 raeburn 10311: } elsif ($args->{'error_on_invalid_names'}
10312: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 10313: $upload_output.='<td align="right"><span class="LC_warning">'.
10314: &mt('Invalid characters').'</span>';
1.987 raeburn 10315: $numinvalid++;
1.660 raeburn 10316: } else {
1.1075.2.35 raeburn 10317: $upload_output .= '<td>'.
10318: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10319: $embed_file,\%mapping,
1.1071 raeburn 10320: $allfiles,$codebase,'upload');
10321: $counter ++;
10322: $numnew ++;
1.987 raeburn 10323: }
10324: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10325: }
10326: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10327: if ($actionurl eq '/adm/dependencies') {
10328: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10329: $modify_output .= &start_data_table_row().
10330: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10331: '<img src="'.&icon($embed_file).'" border="0" />'.
10332: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10333: '<td>'.$size.'</td>'.
10334: '<td>'.$mtime.'</td>'.
10335: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10336: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10337: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10338: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10339: &embedded_file_element('upload_embedded',$counter,
10340: $embed_file,\%mapping,
10341: $allfiles,$codebase,'modify').
10342: '</div></td>'.
10343: &end_data_table_row()."\n";
10344: $counter ++;
10345: } else {
10346: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10347: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10348: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10349: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10350: &Apache::loncommon::end_data_table_row()."\n";
10351: }
10352: }
10353: my $delidx = $counter;
10354: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10355: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10356: $delete_output .= &start_data_table_row().
10357: '<td><img src="'.&icon($oldfile).'" />'.
10358: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10359: '<td>'.$size.'</td>'.
10360: '<td>'.$mtime.'</td>'.
10361: '<td><label><input type="checkbox" name="del_upload_dep" '.
10362: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10363: &embedded_file_element('upload_embedded',$delidx,
10364: $oldfile,\%mapping,$allfiles,
10365: $codebase,'delete').'</td>'.
10366: &end_data_table_row()."\n";
10367: $numunused ++;
10368: $delidx ++;
1.987 raeburn 10369: }
10370: if ($upload_output) {
10371: $upload_output = &start_data_table().
10372: $upload_output.
10373: &end_data_table()."\n";
10374: }
1.1071 raeburn 10375: if ($modify_output) {
10376: $modify_output = &start_data_table().
10377: &start_data_table_header_row().
10378: '<th>'.&mt('File').'</th>'.
10379: '<th>'.&mt('Size (KB)').'</th>'.
10380: '<th>'.&mt('Modified').'</th>'.
10381: '<th>'.&mt('Upload replacement?').'</th>'.
10382: &end_data_table_header_row().
10383: $modify_output.
10384: &end_data_table()."\n";
10385: }
10386: if ($delete_output) {
10387: $delete_output = &start_data_table().
10388: &start_data_table_header_row().
10389: '<th>'.&mt('File').'</th>'.
10390: '<th>'.&mt('Size (KB)').'</th>'.
10391: '<th>'.&mt('Modified').'</th>'.
10392: '<th>'.&mt('Delete?').'</th>'.
10393: &end_data_table_header_row().
10394: $delete_output.
10395: &end_data_table()."\n";
10396: }
1.987 raeburn 10397: my $applies = 0;
10398: if ($numremref) {
10399: $applies ++;
10400: }
10401: if ($numinvalid) {
10402: $applies ++;
10403: }
10404: if ($numexisting) {
10405: $applies ++;
10406: }
1.1071 raeburn 10407: if ($counter || $numunused) {
1.987 raeburn 10408: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10409: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10410: $state.'<h3>'.$heading.'</h3>';
10411: if ($actionurl eq '/adm/dependencies') {
10412: if ($numnew) {
10413: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10414: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10415: $upload_output.'<br />'."\n";
10416: }
10417: if ($numexisting) {
10418: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10419: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10420: $modify_output.'<br />'."\n";
10421: $buttontext = &mt('Save changes');
10422: }
10423: if ($numunused) {
10424: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10425: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10426: $delete_output.'<br />'."\n";
10427: $buttontext = &mt('Save changes');
10428: }
10429: } else {
10430: $output .= $upload_output.'<br />'."\n";
10431: }
10432: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10433: $counter.'" />'."\n";
10434: if ($actionurl eq '/adm/dependencies') {
10435: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10436: $numnew.'" />'."\n";
10437: } elsif ($actionurl eq '') {
1.987 raeburn 10438: $output .= '<input type="hidden" name="phase" value="three" />';
10439: }
10440: } elsif ($applies) {
10441: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10442: if ($applies > 1) {
10443: $output .=
1.1075.2.35 raeburn 10444: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10445: if ($numremref) {
10446: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10447: }
10448: if ($numinvalid) {
10449: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10450: }
10451: if ($numexisting) {
10452: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10453: }
10454: $output .= '</ul><br />';
10455: } elsif ($numremref) {
10456: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10457: } elsif ($numinvalid) {
10458: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10459: } elsif ($numexisting) {
10460: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10461: }
10462: $output .= $upload_output.'<br />';
10463: }
10464: my ($pathchange_output,$chgcount);
1.1071 raeburn 10465: $chgcount = $counter;
1.987 raeburn 10466: if (keys(%pathchanges) > 0) {
10467: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10468: if ($counter) {
1.987 raeburn 10469: $output .= &embedded_file_element('pathchange',$chgcount,
10470: $embed_file,\%mapping,
1.1071 raeburn 10471: $allfiles,$codebase,'change');
1.987 raeburn 10472: } else {
10473: $pathchange_output .=
10474: &start_data_table_row().
10475: '<td><input type ="checkbox" name="namechange" value="'.
10476: $chgcount.'" checked="checked" /></td>'.
10477: '<td>'.$mapping{$embed_file}.'</td>'.
10478: '<td>'.$embed_file.
10479: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10480: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10481: '</td>'.&end_data_table_row();
1.660 raeburn 10482: }
1.987 raeburn 10483: $numpathchg ++;
10484: $chgcount ++;
1.660 raeburn 10485: }
10486: }
1.1075.2.35 raeburn 10487: if (($counter) || ($numunused)) {
1.987 raeburn 10488: if ($numpathchg) {
10489: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10490: $numpathchg.'" />'."\n";
10491: }
10492: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10493: ($actionurl eq '/adm/imsimport')) {
10494: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10495: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10496: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10497: } elsif ($actionurl eq '/adm/dependencies') {
10498: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10499: }
1.1075.2.35 raeburn 10500: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10501: } elsif ($numpathchg) {
10502: my %pathchange = ();
10503: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10504: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10505: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 10506: }
1.987 raeburn 10507: }
1.1071 raeburn 10508: return ($output,$counter,$numpathchg);
1.987 raeburn 10509: }
10510:
1.1075.2.47 raeburn 10511: =pod
10512:
10513: =item * clean_path($name)
10514:
10515: Performs clean-up of directories, subdirectories and filename in an
10516: embedded object, referenced in an HTML file which is being uploaded
10517: to a course or portfolio, where
10518: "Upload embedded images/multimedia files if HTML file" checkbox was
10519: checked.
10520:
10521: Clean-up is similar to replacements in lonnet::clean_filename()
10522: except each / between sub-directory and next level is preserved.
10523:
10524: =cut
10525:
10526: sub clean_path {
10527: my ($embed_file) = @_;
10528: $embed_file =~s{^/+}{};
10529: my @contents;
10530: if ($embed_file =~ m{/}) {
10531: @contents = split(/\//,$embed_file);
10532: } else {
10533: @contents = ($embed_file);
10534: }
10535: my $lastidx = scalar(@contents)-1;
10536: for (my $i=0; $i<=$lastidx; $i++) {
10537: $contents[$i]=~s{\\}{/}g;
10538: $contents[$i]=~s/\s+/\_/g;
10539: $contents[$i]=~s{[^/\w\.\-]}{}g;
10540: if ($i == $lastidx) {
10541: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10542: }
10543: }
10544: if ($lastidx > 0) {
10545: return join('/',@contents);
10546: } else {
10547: return $contents[0];
10548: }
10549: }
10550:
1.987 raeburn 10551: sub embedded_file_element {
1.1071 raeburn 10552: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10553: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10554: (ref($codebase) eq 'HASH'));
10555: my $output;
1.1071 raeburn 10556: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10557: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10558: }
10559: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10560: &escape($embed_file).'" />';
10561: unless (($context eq 'upload_embedded') &&
10562: ($mapping->{$embed_file} eq $embed_file)) {
10563: $output .='
10564: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10565: }
10566: my $attrib;
10567: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10568: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10569: }
10570: $output .=
10571: "\n\t\t".
10572: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10573: $attrib.'" />';
10574: if (exists($codebase->{$mapping->{$embed_file}})) {
10575: $output .=
10576: "\n\t\t".
10577: '<input name="codebase_'.$num.'" type="hidden" value="'.
10578: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10579: }
1.987 raeburn 10580: return $output;
1.660 raeburn 10581: }
10582:
1.1071 raeburn 10583: sub get_dependency_details {
10584: my ($currfile,$currsubfile,$embed_file) = @_;
10585: my ($size,$mtime,$showsize,$showmtime);
10586: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10587: if ($embed_file =~ m{/}) {
10588: my ($path,$fname) = split(/\//,$embed_file);
10589: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10590: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10591: }
10592: } else {
10593: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10594: ($size,$mtime) = @{$currfile->{$embed_file}};
10595: }
10596: }
10597: $showsize = $size/1024.0;
10598: $showsize = sprintf("%.1f",$showsize);
10599: if ($mtime > 0) {
10600: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10601: }
10602: }
10603: return ($showsize,$showmtime);
10604: }
10605:
10606: sub ask_embedded_js {
10607: return <<"END";
10608: <script type="text/javascript"">
10609: // <![CDATA[
10610: function toggleBrowse(counter) {
10611: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10612: var fileid = document.getElementById('embedded_item_'+counter);
10613: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10614: if (chkboxid.checked == true) {
10615: uploaddivid.style.display='block';
10616: } else {
10617: uploaddivid.style.display='none';
10618: fileid.value = '';
10619: }
10620: }
10621: // ]]>
10622: </script>
10623:
10624: END
10625: }
10626:
1.661 raeburn 10627: sub upload_embedded {
10628: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10629: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10630: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10631: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10632: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10633: my $orig_uploaded_filename =
10634: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10635: foreach my $type ('orig','ref','attrib','codebase') {
10636: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10637: $env{'form.embedded_'.$type.'_'.$i} =
10638: &unescape($env{'form.embedded_'.$type.'_'.$i});
10639: }
10640: }
1.661 raeburn 10641: my ($path,$fname) =
10642: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10643: # no path, whole string is fname
10644: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10645: $fname = &Apache::lonnet::clean_filename($fname);
10646: # See if there is anything left
10647: next if ($fname eq '');
10648:
10649: # Check if file already exists as a file or directory.
10650: my ($state,$msg);
10651: if ($context eq 'portfolio') {
10652: my $port_path = $dirpath;
10653: if ($group ne '') {
10654: $port_path = "groups/$group/$port_path";
10655: }
1.987 raeburn 10656: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10657: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10658: $dir_root,$port_path,$disk_quota,
10659: $current_disk_usage,$uname,$udom);
10660: if ($state eq 'will_exceed_quota'
1.984 raeburn 10661: || $state eq 'file_locked') {
1.661 raeburn 10662: $output .= $msg;
10663: next;
10664: }
10665: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10666: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10667: if ($state eq 'exists') {
10668: $output .= $msg;
10669: next;
10670: }
10671: }
10672: # Check if extension is valid
10673: if (($fname =~ /\.(\w+)$/) &&
10674: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 10675: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10676: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10677: next;
10678: } elsif (($fname =~ /\.(\w+)$/) &&
10679: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10680: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10681: next;
10682: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 10683: $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 10684: next;
10685: }
10686: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 10687: my $subdir = $path;
10688: $subdir =~ s{/+$}{};
1.661 raeburn 10689: if ($context eq 'portfolio') {
1.984 raeburn 10690: my $result;
10691: if ($state eq 'existingfile') {
10692: $result=
10693: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 10694: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10695: } else {
1.984 raeburn 10696: $result=
10697: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10698: $dirpath.
1.1075.2.35 raeburn 10699: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10700: if ($result !~ m|^/uploaded/|) {
10701: $output .= '<span class="LC_error">'
10702: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10703: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10704: .'</span><br />';
10705: next;
10706: } else {
1.987 raeburn 10707: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10708: $path.$fname.'</span>').'<br />';
1.984 raeburn 10709: }
1.661 raeburn 10710: }
1.1075.2.35 raeburn 10711: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
10712: my $extendedsubdir = $dirpath.'/'.$subdir;
10713: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10714: my $result =
1.1075.2.35 raeburn 10715: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10716: if ($result !~ m|^/uploaded/|) {
10717: $output .= '<span class="LC_error">'
10718: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10719: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10720: .'</span><br />';
10721: next;
10722: } else {
10723: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10724: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 10725: if ($context eq 'syllabus') {
10726: &Apache::lonnet::make_public_indefinitely($result);
10727: }
1.987 raeburn 10728: }
1.661 raeburn 10729: } else {
10730: # Save the file
10731: my $target = $env{'form.embedded_item_'.$i};
10732: my $fullpath = $dir_root.$dirpath.'/'.$path;
10733: my $dest = $fullpath.$fname;
10734: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10735: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10736: my $count;
10737: my $filepath = $dir_root;
1.1027 raeburn 10738: foreach my $subdir (@parts) {
10739: $filepath .= "/$subdir";
10740: if (!-e $filepath) {
1.661 raeburn 10741: mkdir($filepath,0770);
10742: }
10743: }
10744: my $fh;
10745: if (!open($fh,'>'.$dest)) {
10746: &Apache::lonnet::logthis('Failed to create '.$dest);
10747: $output .= '<span class="LC_error">'.
1.1071 raeburn 10748: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10749: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10750: '</span><br />';
10751: } else {
10752: if (!print $fh $env{'form.embedded_item_'.$i}) {
10753: &Apache::lonnet::logthis('Failed to write to '.$dest);
10754: $output .= '<span class="LC_error">'.
1.1071 raeburn 10755: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10756: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10757: '</span><br />';
10758: } else {
1.987 raeburn 10759: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10760: $url.'</span>').'<br />';
10761: unless ($context eq 'testbank') {
10762: $footer .= &mt('View embedded file: [_1]',
10763: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10764: }
10765: }
10766: close($fh);
10767: }
10768: }
10769: if ($env{'form.embedded_ref_'.$i}) {
10770: $pathchange{$i} = 1;
10771: }
10772: }
10773: if ($output) {
10774: $output = '<p>'.$output.'</p>';
10775: }
10776: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10777: $returnflag = 'ok';
1.1071 raeburn 10778: my $numpathchgs = scalar(keys(%pathchange));
10779: if ($numpathchgs > 0) {
1.987 raeburn 10780: if ($context eq 'portfolio') {
10781: $output .= '<p>'.&mt('or').'</p>';
10782: } elsif ($context eq 'testbank') {
1.1071 raeburn 10783: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10784: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10785: $returnflag = 'modify_orightml';
10786: }
10787: }
1.1071 raeburn 10788: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10789: }
10790:
10791: sub modify_html_form {
10792: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10793: my $end = 0;
10794: my $modifyform;
10795: if ($context eq 'upload_embedded') {
10796: return unless (ref($pathchange) eq 'HASH');
10797: if ($env{'form.number_embedded_items'}) {
10798: $end += $env{'form.number_embedded_items'};
10799: }
10800: if ($env{'form.number_pathchange_items'}) {
10801: $end += $env{'form.number_pathchange_items'};
10802: }
10803: if ($end) {
10804: for (my $i=0; $i<$end; $i++) {
10805: if ($i < $env{'form.number_embedded_items'}) {
10806: next unless($pathchange->{$i});
10807: }
10808: $modifyform .=
10809: &start_data_table_row().
10810: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10811: 'checked="checked" /></td>'.
10812: '<td>'.$env{'form.embedded_ref_'.$i}.
10813: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10814: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10815: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10816: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10817: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10818: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10819: '<td>'.$env{'form.embedded_orig_'.$i}.
10820: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10821: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10822: &end_data_table_row();
1.1071 raeburn 10823: }
1.987 raeburn 10824: }
10825: } else {
10826: $modifyform = $pathchgtable;
10827: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10828: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10829: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10830: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10831: }
10832: }
10833: if ($modifyform) {
1.1071 raeburn 10834: if ($actionurl eq '/adm/dependencies') {
10835: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10836: }
1.987 raeburn 10837: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10838: '<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".
10839: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10840: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10841: '</ol></p>'."\n".'<p>'.
10842: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10843: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10844: &start_data_table()."\n".
10845: &start_data_table_header_row().
10846: '<th>'.&mt('Change?').'</th>'.
10847: '<th>'.&mt('Current reference').'</th>'.
10848: '<th>'.&mt('Required reference').'</th>'.
10849: &end_data_table_header_row()."\n".
10850: $modifyform.
10851: &end_data_table().'<br />'."\n".$hiddenstate.
10852: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10853: '</form>'."\n";
10854: }
10855: return;
10856: }
10857:
10858: sub modify_html_refs {
1.1075.2.35 raeburn 10859: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10860: my $container;
10861: if ($context eq 'portfolio') {
10862: $container = $env{'form.container'};
10863: } elsif ($context eq 'coursedoc') {
10864: $container = $env{'form.primaryurl'};
1.1071 raeburn 10865: } elsif ($context eq 'manage_dependencies') {
10866: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10867: $container = "/$container";
1.1075.2.35 raeburn 10868: } elsif ($context eq 'syllabus') {
10869: $container = $url;
1.987 raeburn 10870: } else {
1.1027 raeburn 10871: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10872: }
10873: my (%allfiles,%codebase,$output,$content);
10874: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 10875: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10876: if (wantarray) {
10877: return ('',0,0);
10878: } else {
10879: return;
10880: }
10881: }
10882: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 10883: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10884: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10885: if (wantarray) {
10886: return ('',0,0);
10887: } else {
10888: return;
10889: }
10890: }
1.987 raeburn 10891: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10892: if ($content eq '-1') {
10893: if (wantarray) {
10894: return ('',0,0);
10895: } else {
10896: return;
10897: }
10898: }
1.987 raeburn 10899: } else {
1.1071 raeburn 10900: unless ($container =~ /^\Q$dir_root\E/) {
10901: if (wantarray) {
10902: return ('',0,0);
10903: } else {
10904: return;
10905: }
10906: }
1.987 raeburn 10907: if (open(my $fh,"<$container")) {
10908: $content = join('', <$fh>);
10909: close($fh);
10910: } else {
1.1071 raeburn 10911: if (wantarray) {
10912: return ('',0,0);
10913: } else {
10914: return;
10915: }
1.987 raeburn 10916: }
10917: }
10918: my ($count,$codebasecount) = (0,0);
10919: my $mm = new File::MMagic;
10920: my $mime_type = $mm->checktype_contents($content);
10921: if ($mime_type eq 'text/html') {
10922: my $parse_result =
10923: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10924: \%codebase,\$content);
10925: if ($parse_result eq 'ok') {
10926: foreach my $i (@changes) {
10927: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10928: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10929: if ($allfiles{$ref}) {
10930: my $newname = $orig;
10931: my ($attrib_regexp,$codebase);
1.1006 raeburn 10932: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10933: if ($attrib_regexp =~ /:/) {
10934: $attrib_regexp =~ s/\:/|/g;
10935: }
10936: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10937: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10938: $count += $numchg;
1.1075.2.35 raeburn 10939: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 10940: delete($allfiles{$ref});
1.987 raeburn 10941: }
10942: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10943: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10944: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10945: $codebasecount ++;
10946: }
10947: }
10948: }
1.1075.2.35 raeburn 10949: my $skiprewrites;
1.987 raeburn 10950: if ($count || $codebasecount) {
10951: my $saveresult;
1.1071 raeburn 10952: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 10953: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 10954: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10955: if ($url eq $container) {
10956: my ($fname) = ($container =~ m{/([^/]+)$});
10957: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10958: $count,'<span class="LC_filename">'.
1.1071 raeburn 10959: $fname.'</span>').'</p>';
1.987 raeburn 10960: } else {
10961: $output = '<p class="LC_error">'.
10962: &mt('Error: update failed for: [_1].',
10963: '<span class="LC_filename">'.
10964: $container.'</span>').'</p>';
10965: }
1.1075.2.35 raeburn 10966: if ($context eq 'syllabus') {
10967: unless ($saveresult eq 'ok') {
10968: $skiprewrites = 1;
10969: }
10970: }
1.987 raeburn 10971: } else {
10972: if (open(my $fh,">$container")) {
10973: print $fh $content;
10974: close($fh);
10975: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10976: $count,'<span class="LC_filename">'.
10977: $container.'</span>').'</p>';
1.661 raeburn 10978: } else {
1.987 raeburn 10979: $output = '<p class="LC_error">'.
10980: &mt('Error: could not update [_1].',
10981: '<span class="LC_filename">'.
10982: $container.'</span>').'</p>';
1.661 raeburn 10983: }
10984: }
10985: }
1.1075.2.35 raeburn 10986: if (($context eq 'syllabus') && (!$skiprewrites)) {
10987: my ($actionurl,$state);
10988: $actionurl = "/public/$udom/$uname/syllabus";
10989: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
10990: &ask_for_embedded_content($actionurl,$state,\%allfiles,
10991: \%codebase,
10992: {'context' => 'rewrites',
10993: 'ignore_remote_references' => 1,});
10994: if (ref($mapping) eq 'HASH') {
10995: my $rewrites = 0;
10996: foreach my $key (keys(%{$mapping})) {
10997: next if ($key =~ m{^https?://});
10998: my $ref = $mapping->{$key};
10999: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11000: my $attrib;
11001: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11002: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11003: }
11004: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11005: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11006: $rewrites += $numchg;
11007: }
11008: }
11009: if ($rewrites) {
11010: my $saveresult;
11011: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11012: if ($url eq $container) {
11013: my ($fname) = ($container =~ m{/([^/]+)$});
11014: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11015: $count,'<span class="LC_filename">'.
11016: $fname.'</span>').'</p>';
11017: } else {
11018: $output .= '<p class="LC_error">'.
11019: &mt('Error: could not update links in [_1].',
11020: '<span class="LC_filename">'.
11021: $container.'</span>').'</p>';
11022:
11023: }
11024: }
11025: }
11026: }
1.987 raeburn 11027: } else {
11028: &logthis('Failed to parse '.$container.
11029: ' to modify references: '.$parse_result);
1.661 raeburn 11030: }
11031: }
1.1071 raeburn 11032: if (wantarray) {
11033: return ($output,$count,$codebasecount);
11034: } else {
11035: return $output;
11036: }
1.661 raeburn 11037: }
11038:
11039: sub check_for_existing {
11040: my ($path,$fname,$element) = @_;
11041: my ($state,$msg);
11042: if (-d $path.'/'.$fname) {
11043: $state = 'exists';
11044: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11045: } elsif (-e $path.'/'.$fname) {
11046: $state = 'exists';
11047: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11048: }
11049: if ($state eq 'exists') {
11050: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11051: }
11052: return ($state,$msg);
11053: }
11054:
11055: sub check_for_upload {
11056: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11057: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11058: my $filesize = length($env{'form.'.$element});
11059: if (!$filesize) {
11060: my $msg = '<span class="LC_error">'.
11061: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11062: '<span class="LC_filename">'.$fname.'</span>',
11063: $filesize).'<br />'.
1.1007 raeburn 11064: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11065: '</span>';
11066: return ('zero_bytes',$msg);
11067: }
11068: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11069: my $getpropath = 1;
1.1021 raeburn 11070: my ($dirlistref,$listerror) =
11071: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11072: my $found_file = 0;
11073: my $locked_file = 0;
1.991 raeburn 11074: my @lockers;
11075: my $navmap;
11076: if ($env{'request.course.id'}) {
11077: $navmap = Apache::lonnavmaps::navmap->new();
11078: }
1.1021 raeburn 11079: if (ref($dirlistref) eq 'ARRAY') {
11080: foreach my $line (@{$dirlistref}) {
11081: my ($file_name,$rest)=split(/\&/,$line,2);
11082: if ($file_name eq $fname){
11083: $file_name = $path.$file_name;
11084: if ($group ne '') {
11085: $file_name = $group.$file_name;
11086: }
11087: $found_file = 1;
11088: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11089: foreach my $lock (@lockers) {
11090: if (ref($lock) eq 'ARRAY') {
11091: my ($symb,$crsid) = @{$lock};
11092: if ($crsid eq $env{'request.course.id'}) {
11093: if (ref($navmap)) {
11094: my $res = $navmap->getBySymb($symb);
11095: foreach my $part (@{$res->parts()}) {
11096: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11097: unless (($slot_status == $res->RESERVED) ||
11098: ($slot_status == $res->RESERVED_LOCATION)) {
11099: $locked_file = 1;
11100: }
1.991 raeburn 11101: }
1.1021 raeburn 11102: } else {
11103: $locked_file = 1;
1.991 raeburn 11104: }
11105: } else {
11106: $locked_file = 1;
11107: }
11108: }
1.1021 raeburn 11109: }
11110: } else {
11111: my @info = split(/\&/,$rest);
11112: my $currsize = $info[6]/1000;
11113: if ($currsize < $filesize) {
11114: my $extra = $filesize - $currsize;
11115: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 11116: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11117: &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 11118: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11119: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11120: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11121: return ('will_exceed_quota',$msg);
11122: }
1.984 raeburn 11123: }
11124: }
1.661 raeburn 11125: }
11126: }
11127: }
11128: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 11129: my $msg = '<p class="LC_warning">'.
11130: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
11131: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11132: return ('will_exceed_quota',$msg);
11133: } elsif ($found_file) {
11134: if ($locked_file) {
1.1075.2.69 raeburn 11135: my $msg = '<p class="LC_warning">';
1.661 raeburn 11136: $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 11137: $msg .= '</p>';
1.661 raeburn 11138: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11139: return ('file_locked',$msg);
11140: } else {
1.1075.2.69 raeburn 11141: my $msg = '<p class="LC_error">';
1.984 raeburn 11142: $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 11143: $msg .= '</p>';
1.984 raeburn 11144: return ('existingfile',$msg);
1.661 raeburn 11145: }
11146: }
11147: }
11148:
1.987 raeburn 11149: sub check_for_traversal {
11150: my ($path,$url,$toplevel) = @_;
11151: my @parts=split(/\//,$path);
11152: my $cleanpath;
11153: my $fullpath = $url;
11154: for (my $i=0;$i<@parts;$i++) {
11155: next if ($parts[$i] eq '.');
11156: if ($parts[$i] eq '..') {
11157: $fullpath =~ s{([^/]+/)$}{};
11158: } else {
11159: $fullpath .= $parts[$i].'/';
11160: }
11161: }
11162: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11163: $cleanpath = $1;
11164: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11165: my $curr_toprel = $1;
11166: my @parts = split(/\//,$curr_toprel);
11167: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11168: my @urlparts = split(/\//,$url_toprel);
11169: my $doubledots;
11170: my $startdiff = -1;
11171: for (my $i=0; $i<@urlparts; $i++) {
11172: if ($startdiff == -1) {
11173: unless ($urlparts[$i] eq $parts[$i]) {
11174: $startdiff = $i;
11175: $doubledots .= '../';
11176: }
11177: } else {
11178: $doubledots .= '../';
11179: }
11180: }
11181: if ($startdiff > -1) {
11182: $cleanpath = $doubledots;
11183: for (my $i=$startdiff; $i<@parts; $i++) {
11184: $cleanpath .= $parts[$i].'/';
11185: }
11186: }
11187: }
11188: $cleanpath =~ s{(/)$}{};
11189: return $cleanpath;
11190: }
1.31 albertel 11191:
1.1053 raeburn 11192: sub is_archive_file {
11193: my ($mimetype) = @_;
11194: if (($mimetype eq 'application/octet-stream') ||
11195: ($mimetype eq 'application/x-stuffit') ||
11196: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11197: return 1;
11198: }
11199: return;
11200: }
11201:
11202: sub decompress_form {
1.1065 raeburn 11203: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11204: my %lt = &Apache::lonlocal::texthash (
11205: this => 'This file is an archive file.',
1.1067 raeburn 11206: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11207: itsc => 'Its contents are as follows:',
1.1053 raeburn 11208: youm => 'You may wish to extract its contents.',
11209: extr => 'Extract contents',
1.1067 raeburn 11210: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11211: proa => 'Process automatically?',
1.1053 raeburn 11212: yes => 'Yes',
11213: no => 'No',
1.1067 raeburn 11214: fold => 'Title for folder containing movie',
11215: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11216: );
1.1065 raeburn 11217: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11218: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11219: my $info = &list_archive_contents($fileloc,\@paths);
11220: if (@paths) {
11221: foreach my $path (@paths) {
11222: $path =~ s{^/}{};
1.1067 raeburn 11223: if ($path =~ m{^([^/]+)/$}) {
11224: $topdir = $1;
11225: }
1.1065 raeburn 11226: if ($path =~ m{^([^/]+)/}) {
11227: $toplevel{$1} = $path;
11228: } else {
11229: $toplevel{$path} = $path;
11230: }
11231: }
11232: }
1.1067 raeburn 11233: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 11234: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11235: "$topdir/media/",
11236: "$topdir/media/$topdir.mp4",
11237: "$topdir/media/FirstFrame.png",
11238: "$topdir/media/player.swf",
11239: "$topdir/media/swfobject.js",
11240: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 11241: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 11242: "$topdir/$topdir.mp4",
11243: "$topdir/$topdir\_config.xml",
11244: "$topdir/$topdir\_controller.swf",
11245: "$topdir/$topdir\_embed.css",
11246: "$topdir/$topdir\_First_Frame.png",
11247: "$topdir/$topdir\_player.html",
11248: "$topdir/$topdir\_Thumbnails.png",
11249: "$topdir/playerProductInstall.swf",
11250: "$topdir/scripts/",
11251: "$topdir/scripts/config_xml.js",
11252: "$topdir/scripts/handlebars.js",
11253: "$topdir/scripts/jquery-1.7.1.min.js",
11254: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11255: "$topdir/scripts/modernizr.js",
11256: "$topdir/scripts/player-min.js",
11257: "$topdir/scripts/swfobject.js",
11258: "$topdir/skins/",
11259: "$topdir/skins/configuration_express.xml",
11260: "$topdir/skins/express_show/",
11261: "$topdir/skins/express_show/player-min.css",
11262: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 11263: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11264: "$topdir/$topdir.mp4",
11265: "$topdir/$topdir\_config.xml",
11266: "$topdir/$topdir\_controller.swf",
11267: "$topdir/$topdir\_embed.css",
11268: "$topdir/$topdir\_First_Frame.png",
11269: "$topdir/$topdir\_player.html",
11270: "$topdir/$topdir\_Thumbnails.png",
11271: "$topdir/playerProductInstall.swf",
11272: "$topdir/scripts/",
11273: "$topdir/scripts/config_xml.js",
11274: "$topdir/scripts/techsmith-smart-player.min.js",
11275: "$topdir/skins/",
11276: "$topdir/skins/configuration_express.xml",
11277: "$topdir/skins/express_show/",
11278: "$topdir/skins/express_show/spritesheet.min.css",
11279: "$topdir/skins/express_show/spritesheet.png",
11280: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 11281: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11282: if (@diffs == 0) {
1.1075.2.59 raeburn 11283: $is_camtasia = 6;
11284: } else {
1.1075.2.81 raeburn 11285: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 11286: if (@diffs == 0) {
11287: $is_camtasia = 8;
1.1075.2.81 raeburn 11288: } else {
11289: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11290: if (@diffs == 0) {
11291: $is_camtasia = 8;
11292: }
1.1075.2.59 raeburn 11293: }
1.1067 raeburn 11294: }
11295: }
11296: my $output;
11297: if ($is_camtasia) {
11298: $output = <<"ENDCAM";
11299: <script type="text/javascript" language="Javascript">
11300: // <![CDATA[
11301:
11302: function camtasiaToggle() {
11303: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11304: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 11305: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11306: document.getElementById('camtasia_titles').style.display='block';
11307: } else {
11308: document.getElementById('camtasia_titles').style.display='none';
11309: }
11310: }
11311: }
11312: return;
11313: }
11314:
11315: // ]]>
11316: </script>
11317: <p>$lt{'camt'}</p>
11318: ENDCAM
1.1065 raeburn 11319: } else {
1.1067 raeburn 11320: $output = '<p>'.$lt{'this'};
11321: if ($info eq '') {
11322: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11323: } else {
11324: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11325: '<div><pre>'.$info.'</pre></div>';
11326: }
1.1065 raeburn 11327: }
1.1067 raeburn 11328: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11329: my $duplicates;
11330: my $num = 0;
11331: if (ref($dirlist) eq 'ARRAY') {
11332: foreach my $item (@{$dirlist}) {
11333: if (ref($item) eq 'ARRAY') {
11334: if (exists($toplevel{$item->[0]})) {
11335: $duplicates .=
11336: &start_data_table_row().
11337: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11338: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11339: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11340: 'value="1" />'.&mt('Yes').'</label>'.
11341: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11342: '<td>'.$item->[0].'</td>';
11343: if ($item->[2]) {
11344: $duplicates .= '<td>'.&mt('Directory').'</td>';
11345: } else {
11346: $duplicates .= '<td>'.&mt('File').'</td>';
11347: }
11348: $duplicates .= '<td>'.$item->[3].'</td>'.
11349: '<td>'.
11350: &Apache::lonlocal::locallocaltime($item->[4]).
11351: '</td>'.
11352: &end_data_table_row();
11353: $num ++;
11354: }
11355: }
11356: }
11357: }
11358: my $itemcount;
11359: if (@paths > 0) {
11360: $itemcount = scalar(@paths);
11361: } else {
11362: $itemcount = 1;
11363: }
1.1067 raeburn 11364: if ($is_camtasia) {
11365: $output .= $lt{'auto'}.'<br />'.
11366: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 11367: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11368: $lt{'yes'}.'</label> <label>'.
11369: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11370: $lt{'no'}.'</label></span><br />'.
11371: '<div id="camtasia_titles" style="display:block">'.
11372: &Apache::lonhtmlcommon::start_pick_box().
11373: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11374: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11375: &Apache::lonhtmlcommon::row_closure().
11376: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11377: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11378: &Apache::lonhtmlcommon::row_closure(1).
11379: &Apache::lonhtmlcommon::end_pick_box().
11380: '</div>';
11381: }
1.1065 raeburn 11382: $output .=
11383: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11384: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11385: "\n";
1.1065 raeburn 11386: if ($duplicates ne '') {
11387: $output .= '<p><span class="LC_warning">'.
11388: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11389: &start_data_table().
11390: &start_data_table_header_row().
11391: '<th>'.&mt('Overwrite?').'</th>'.
11392: '<th>'.&mt('Name').'</th>'.
11393: '<th>'.&mt('Type').'</th>'.
11394: '<th>'.&mt('Size').'</th>'.
11395: '<th>'.&mt('Last modified').'</th>'.
11396: &end_data_table_header_row().
11397: $duplicates.
11398: &end_data_table().
11399: '</p>';
11400: }
1.1067 raeburn 11401: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11402: if (ref($hiddenelements) eq 'HASH') {
11403: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11404: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11405: }
11406: }
11407: $output .= <<"END";
1.1067 raeburn 11408: <br />
1.1053 raeburn 11409: <input type="submit" name="decompress" value="$lt{'extr'}" />
11410: </form>
11411: $noextract
11412: END
11413: return $output;
11414: }
11415:
1.1065 raeburn 11416: sub decompression_utility {
11417: my ($program) = @_;
11418: my @utilities = ('tar','gunzip','bunzip2','unzip');
11419: my $location;
11420: if (grep(/^\Q$program\E$/,@utilities)) {
11421: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11422: '/usr/sbin/') {
11423: if (-x $dir.$program) {
11424: $location = $dir.$program;
11425: last;
11426: }
11427: }
11428: }
11429: return $location;
11430: }
11431:
11432: sub list_archive_contents {
11433: my ($file,$pathsref) = @_;
11434: my (@cmd,$output);
11435: my $needsregexp;
11436: if ($file =~ /\.zip$/) {
11437: @cmd = (&decompression_utility('unzip'),"-l");
11438: $needsregexp = 1;
11439: } elsif (($file =~ m/\.tar\.gz$/) ||
11440: ($file =~ /\.tgz$/)) {
11441: @cmd = (&decompression_utility('tar'),"-ztf");
11442: } elsif ($file =~ /\.tar\.bz2$/) {
11443: @cmd = (&decompression_utility('tar'),"-jtf");
11444: } elsif ($file =~ m|\.tar$|) {
11445: @cmd = (&decompression_utility('tar'),"-tf");
11446: }
11447: if (@cmd) {
11448: undef($!);
11449: undef($@);
11450: if (open(my $fh,"-|", @cmd, $file)) {
11451: while (my $line = <$fh>) {
11452: $output .= $line;
11453: chomp($line);
11454: my $item;
11455: if ($needsregexp) {
11456: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11457: } else {
11458: $item = $line;
11459: }
11460: if ($item ne '') {
11461: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11462: push(@{$pathsref},$item);
11463: }
11464: }
11465: }
11466: close($fh);
11467: }
11468: }
11469: return $output;
11470: }
11471:
1.1053 raeburn 11472: sub decompress_uploaded_file {
11473: my ($file,$dir) = @_;
11474: &Apache::lonnet::appenv({'cgi.file' => $file});
11475: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11476: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11477: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11478: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11479: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11480: my $decompressed = $env{'cgi.decompressed'};
11481: &Apache::lonnet::delenv('cgi.file');
11482: &Apache::lonnet::delenv('cgi.dir');
11483: &Apache::lonnet::delenv('cgi.decompressed');
11484: return ($decompressed,$result);
11485: }
11486:
1.1055 raeburn 11487: sub process_decompression {
11488: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11489: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 11490: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 11491: $error = &mt('Filename not a supported archive file type.').
11492: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11493: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11494: } else {
11495: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11496: if ($docuhome eq 'no_host') {
11497: $error = &mt('Could not determine home server for course.');
11498: } else {
11499: my @ids=&Apache::lonnet::current_machine_ids();
11500: my $currdir = "$dir_root/$destination";
11501: if (grep(/^\Q$docuhome\E$/,@ids)) {
11502: $dir = &LONCAPA::propath($docudom,$docuname).
11503: "$dir_root/$destination";
11504: } else {
11505: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11506: "$dir_root/$docudom/$docuname/$destination";
11507: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11508: $error = &mt('Archive file not found.');
11509: }
11510: }
1.1065 raeburn 11511: my (@to_overwrite,@to_skip);
11512: if ($env{'form.archive_overwrite_total'} > 0) {
11513: my $total = $env{'form.archive_overwrite_total'};
11514: for (my $i=0; $i<$total; $i++) {
11515: if ($env{'form.archive_overwrite_'.$i} == 1) {
11516: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11517: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11518: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11519: }
11520: }
11521: }
11522: my $numskip = scalar(@to_skip);
11523: if (($numskip > 0) &&
11524: ($numskip == $env{'form.archive_itemcount'})) {
11525: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11526: } elsif ($dir eq '') {
1.1055 raeburn 11527: $error = &mt('Directory containing archive file unavailable.');
11528: } elsif (!$error) {
1.1065 raeburn 11529: my ($decompressed,$display);
11530: if ($numskip > 0) {
11531: my $tempdir = time.'_'.$$.int(rand(10000));
11532: mkdir("$dir/$tempdir",0755);
11533: system("mv $dir/$file $dir/$tempdir/$file");
11534: ($decompressed,$display) =
11535: &decompress_uploaded_file($file,"$dir/$tempdir");
11536: foreach my $item (@to_skip) {
11537: if (($item ne '') && ($item !~ /\.\./)) {
11538: if (-f "$dir/$tempdir/$item") {
11539: unlink("$dir/$tempdir/$item");
11540: } elsif (-d "$dir/$tempdir/$item") {
11541: system("rm -rf $dir/$tempdir/$item");
11542: }
11543: }
11544: }
11545: system("mv $dir/$tempdir/* $dir");
11546: rmdir("$dir/$tempdir");
11547: } else {
11548: ($decompressed,$display) =
11549: &decompress_uploaded_file($file,$dir);
11550: }
1.1055 raeburn 11551: if ($decompressed eq 'ok') {
1.1065 raeburn 11552: $output = '<p class="LC_info">'.
11553: &mt('Files extracted successfully from archive.').
11554: '</p>'."\n";
1.1055 raeburn 11555: my ($warning,$result,@contents);
11556: my ($newdirlistref,$newlisterror) =
11557: &Apache::lonnet::dirlist($currdir,$docudom,
11558: $docuname,1);
11559: my (%is_dir,%changes,@newitems);
11560: my $dirptr = 16384;
1.1065 raeburn 11561: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11562: foreach my $dir_line (@{$newdirlistref}) {
11563: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11564: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11565: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11566: push(@newitems,$item);
11567: if ($dirptr&$testdir) {
11568: $is_dir{$item} = 1;
11569: }
11570: $changes{$item} = 1;
11571: }
11572: }
11573: }
11574: if (keys(%changes) > 0) {
11575: foreach my $item (sort(@newitems)) {
11576: if ($changes{$item}) {
11577: push(@contents,$item);
11578: }
11579: }
11580: }
11581: if (@contents > 0) {
1.1067 raeburn 11582: my $wantform;
11583: unless ($env{'form.autoextract_camtasia'}) {
11584: $wantform = 1;
11585: }
1.1056 raeburn 11586: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11587: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11588: $currdir,\%is_dir,
11589: \%children,\%parent,
1.1056 raeburn 11590: \@contents,\%dirorder,
11591: \%titles,$wantform);
1.1055 raeburn 11592: if ($datatable ne '') {
11593: $output .= &archive_options_form('decompressed',$datatable,
11594: $count,$hiddenelem);
1.1065 raeburn 11595: my $startcount = 6;
1.1055 raeburn 11596: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11597: \%titles,\%children);
1.1055 raeburn 11598: }
1.1067 raeburn 11599: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 11600: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11601: my %displayed;
11602: my $total = 1;
11603: $env{'form.archive_directory'} = [];
11604: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11605: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11606: $path =~ s{/$}{};
11607: my $item;
11608: if ($path ne '') {
11609: $item = "$path/$titles{$i}";
11610: } else {
11611: $item = $titles{$i};
11612: }
11613: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11614: if ($item eq $contents[0]) {
11615: push(@{$env{'form.archive_directory'}},$i);
11616: $env{'form.archive_'.$i} = 'display';
11617: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11618: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 11619: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11620: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11621: $env{'form.archive_'.$i} = 'display';
11622: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11623: $displayed{'web'} = $i;
11624: } else {
1.1075.2.59 raeburn 11625: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11626: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11627: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11628: push(@{$env{'form.archive_directory'}},$i);
11629: }
11630: $env{'form.archive_'.$i} = 'dependency';
11631: }
11632: $total ++;
11633: }
11634: for (my $i=1; $i<$total; $i++) {
11635: next if ($i == $displayed{'web'});
11636: next if ($i == $displayed{'folder'});
11637: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11638: }
11639: $env{'form.phase'} = 'decompress_cleanup';
11640: $env{'form.archivedelete'} = 1;
11641: $env{'form.archive_count'} = $total-1;
11642: $output .=
11643: &process_extracted_files('coursedocs',$docudom,
11644: $docuname,$destination,
11645: $dir_root,$hiddenelem);
11646: }
1.1055 raeburn 11647: } else {
11648: $warning = &mt('No new items extracted from archive file.');
11649: }
11650: } else {
11651: $output = $display;
11652: $error = &mt('An error occurred during extraction from the archive file.');
11653: }
11654: }
11655: }
11656: }
11657: if ($error) {
11658: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11659: $error.'</p>'."\n";
11660: }
11661: if ($warning) {
11662: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11663: }
11664: return $output;
11665: }
11666:
11667: sub get_extracted {
1.1056 raeburn 11668: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11669: $titles,$wantform) = @_;
1.1055 raeburn 11670: my $count = 0;
11671: my $depth = 0;
11672: my $datatable;
1.1056 raeburn 11673: my @hierarchy;
1.1055 raeburn 11674: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11675: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11676: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11677: foreach my $item (@{$contents}) {
11678: $count ++;
1.1056 raeburn 11679: @{$dirorder->{$count}} = @hierarchy;
11680: $titles->{$count} = $item;
1.1055 raeburn 11681: &archive_hierarchy($depth,$count,$parent,$children);
11682: if ($wantform) {
11683: $datatable .= &archive_row($is_dir->{$item},$item,
11684: $currdir,$depth,$count);
11685: }
11686: if ($is_dir->{$item}) {
11687: $depth ++;
1.1056 raeburn 11688: push(@hierarchy,$count);
11689: $parent->{$depth} = $count;
1.1055 raeburn 11690: $datatable .=
11691: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11692: \$depth,\$count,\@hierarchy,$dirorder,
11693: $children,$parent,$titles,$wantform);
1.1055 raeburn 11694: $depth --;
1.1056 raeburn 11695: pop(@hierarchy);
1.1055 raeburn 11696: }
11697: }
11698: return ($count,$datatable);
11699: }
11700:
11701: sub recurse_extracted_archive {
1.1056 raeburn 11702: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11703: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11704: my $result='';
1.1056 raeburn 11705: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11706: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11707: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11708: return $result;
11709: }
11710: my $dirptr = 16384;
11711: my ($newdirlistref,$newlisterror) =
11712: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11713: if (ref($newdirlistref) eq 'ARRAY') {
11714: foreach my $dir_line (@{$newdirlistref}) {
11715: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11716: unless ($item =~ /^\.+$/) {
11717: $$count ++;
1.1056 raeburn 11718: @{$dirorder->{$$count}} = @{$hierarchy};
11719: $titles->{$$count} = $item;
1.1055 raeburn 11720: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11721:
1.1055 raeburn 11722: my $is_dir;
11723: if ($dirptr&$testdir) {
11724: $is_dir = 1;
11725: }
11726: if ($wantform) {
11727: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11728: }
11729: if ($is_dir) {
11730: $$depth ++;
1.1056 raeburn 11731: push(@{$hierarchy},$$count);
11732: $parent->{$$depth} = $$count;
1.1055 raeburn 11733: $result .=
11734: &recurse_extracted_archive("$currdir/$item",$docudom,
11735: $docuname,$depth,$count,
1.1056 raeburn 11736: $hierarchy,$dirorder,$children,
11737: $parent,$titles,$wantform);
1.1055 raeburn 11738: $$depth --;
1.1056 raeburn 11739: pop(@{$hierarchy});
1.1055 raeburn 11740: }
11741: }
11742: }
11743: }
11744: return $result;
11745: }
11746:
11747: sub archive_hierarchy {
11748: my ($depth,$count,$parent,$children) =@_;
11749: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11750: if (exists($parent->{$depth})) {
11751: $children->{$parent->{$depth}} .= $count.':';
11752: }
11753: }
11754: return;
11755: }
11756:
11757: sub archive_row {
11758: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11759: my ($name) = ($item =~ m{([^/]+)$});
11760: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11761: 'display' => 'Add as file',
1.1055 raeburn 11762: 'dependency' => 'Include as dependency',
11763: 'discard' => 'Discard',
11764: );
11765: if ($is_dir) {
1.1059 raeburn 11766: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11767: }
1.1056 raeburn 11768: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11769: my $offset = 0;
1.1055 raeburn 11770: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11771: $offset ++;
1.1065 raeburn 11772: if ($action ne 'display') {
11773: $offset ++;
11774: }
1.1055 raeburn 11775: $output .= '<td><span class="LC_nobreak">'.
11776: '<label><input type="radio" name="archive_'.$count.
11777: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11778: my $text = $choices{$action};
11779: if ($is_dir) {
11780: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11781: if ($action eq 'display') {
1.1059 raeburn 11782: $text = &mt('Add as folder');
1.1055 raeburn 11783: }
1.1056 raeburn 11784: } else {
11785: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11786:
11787: }
11788: $output .= ' /> '.$choices{$action}.'</label></span>';
11789: if ($action eq 'dependency') {
11790: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11791: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11792: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11793: '<option value=""></option>'."\n".
11794: '</select>'."\n".
11795: '</div>';
1.1059 raeburn 11796: } elsif ($action eq 'display') {
11797: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11798: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11799: '</div>';
1.1055 raeburn 11800: }
1.1056 raeburn 11801: $output .= '</td>';
1.1055 raeburn 11802: }
11803: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11804: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11805: for (my $i=0; $i<$depth; $i++) {
11806: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11807: }
11808: if ($is_dir) {
11809: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11810: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11811: } else {
11812: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11813: }
11814: $output .= ' '.$name.'</td>'."\n".
11815: &end_data_table_row();
11816: return $output;
11817: }
11818:
11819: sub archive_options_form {
1.1065 raeburn 11820: my ($form,$display,$count,$hiddenelem) = @_;
11821: my %lt = &Apache::lonlocal::texthash(
11822: perm => 'Permanently remove archive file?',
11823: hows => 'How should each extracted item be incorporated in the course?',
11824: cont => 'Content actions for all',
11825: addf => 'Add as folder/file',
11826: incd => 'Include as dependency for a displayed file',
11827: disc => 'Discard',
11828: no => 'No',
11829: yes => 'Yes',
11830: save => 'Save',
11831: );
11832: my $output = <<"END";
11833: <form name="$form" method="post" action="">
11834: <p><span class="LC_nobreak">$lt{'perm'}
11835: <label>
11836: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11837: </label>
11838:
11839: <label>
11840: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11841: </span>
11842: </p>
11843: <input type="hidden" name="phase" value="decompress_cleanup" />
11844: <br />$lt{'hows'}
11845: <div class="LC_columnSection">
11846: <fieldset>
11847: <legend>$lt{'cont'}</legend>
11848: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11849: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11850: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11851: </fieldset>
11852: </div>
11853: END
11854: return $output.
1.1055 raeburn 11855: &start_data_table()."\n".
1.1065 raeburn 11856: $display."\n".
1.1055 raeburn 11857: &end_data_table()."\n".
11858: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11859: $hiddenelem.
1.1065 raeburn 11860: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11861: '</form>';
11862: }
11863:
11864: sub archive_javascript {
1.1056 raeburn 11865: my ($startcount,$numitems,$titles,$children) = @_;
11866: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11867: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11868: my $scripttag = <<START;
11869: <script type="text/javascript">
11870: // <![CDATA[
11871:
11872: function checkAll(form,prefix) {
11873: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11874: for (var i=0; i < form.elements.length; i++) {
11875: var id = form.elements[i].id;
11876: if ((id != '') && (id != undefined)) {
11877: if (idstr.test(id)) {
11878: if (form.elements[i].type == 'radio') {
11879: form.elements[i].checked = true;
1.1056 raeburn 11880: var nostart = i-$startcount;
1.1059 raeburn 11881: var offset = nostart%7;
11882: var count = (nostart-offset)/7;
1.1056 raeburn 11883: dependencyCheck(form,count,offset);
1.1055 raeburn 11884: }
11885: }
11886: }
11887: }
11888: }
11889:
11890: function propagateCheck(form,count) {
11891: if (count > 0) {
1.1059 raeburn 11892: var startelement = $startcount + ((count-1) * 7);
11893: for (var j=1; j<6; j++) {
11894: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11895: var item = startelement + j;
11896: if (form.elements[item].type == 'radio') {
11897: if (form.elements[item].checked) {
11898: containerCheck(form,count,j);
11899: break;
11900: }
1.1055 raeburn 11901: }
11902: }
11903: }
11904: }
11905: }
11906:
11907: numitems = $numitems
1.1056 raeburn 11908: var titles = new Array(numitems);
11909: var parents = new Array(numitems);
1.1055 raeburn 11910: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11911: parents[i] = new Array;
1.1055 raeburn 11912: }
1.1059 raeburn 11913: var maintitle = '$maintitle';
1.1055 raeburn 11914:
11915: START
11916:
1.1056 raeburn 11917: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11918: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11919: for (my $i=0; $i<@contents; $i ++) {
11920: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11921: }
11922: }
11923:
1.1056 raeburn 11924: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11925: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11926: }
11927:
1.1055 raeburn 11928: $scripttag .= <<END;
11929:
11930: function containerCheck(form,count,offset) {
11931: if (count > 0) {
1.1056 raeburn 11932: dependencyCheck(form,count,offset);
1.1059 raeburn 11933: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11934: form.elements[item].checked = true;
11935: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11936: if (parents[count].length > 0) {
11937: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11938: containerCheck(form,parents[count][j],offset);
11939: }
11940: }
11941: }
11942: }
11943: }
11944:
11945: function dependencyCheck(form,count,offset) {
11946: if (count > 0) {
1.1059 raeburn 11947: var chosen = (offset+$startcount)+7*(count-1);
11948: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11949: var currtype = form.elements[depitem].type;
11950: if (form.elements[chosen].value == 'dependency') {
11951: document.getElementById('arc_depon_'+count).style.display='block';
11952: form.elements[depitem].options.length = 0;
11953: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 11954: for (var i=1; i<=numitems; i++) {
11955: if (i == count) {
11956: continue;
11957: }
1.1059 raeburn 11958: var startelement = $startcount + (i-1) * 7;
11959: for (var j=1; j<6; j++) {
11960: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11961: var item = startelement + j;
11962: if (form.elements[item].type == 'radio') {
11963: if (form.elements[item].checked) {
11964: if (form.elements[item].value == 'display') {
11965: var n = form.elements[depitem].options.length;
11966: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11967: }
11968: }
11969: }
11970: }
11971: }
11972: }
11973: } else {
11974: document.getElementById('arc_depon_'+count).style.display='none';
11975: form.elements[depitem].options.length = 0;
11976: form.elements[depitem].options[0] = new Option('Select','',true,true);
11977: }
1.1059 raeburn 11978: titleCheck(form,count,offset);
1.1056 raeburn 11979: }
11980: }
11981:
11982: function propagateSelect(form,count,offset) {
11983: if (count > 0) {
1.1065 raeburn 11984: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11985: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11986: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11987: if (parents[count].length > 0) {
11988: for (var j=0; j<parents[count].length; j++) {
11989: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11990: }
11991: }
11992: }
11993: }
11994: }
1.1056 raeburn 11995:
11996: function containerSelect(form,count,offset,picked) {
11997: if (count > 0) {
1.1065 raeburn 11998: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11999: if (form.elements[item].type == 'radio') {
12000: if (form.elements[item].value == 'dependency') {
12001: if (form.elements[item+1].type == 'select-one') {
12002: for (var i=0; i<form.elements[item+1].options.length; i++) {
12003: if (form.elements[item+1].options[i].value == picked) {
12004: form.elements[item+1].selectedIndex = i;
12005: break;
12006: }
12007: }
12008: }
12009: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12010: if (parents[count].length > 0) {
12011: for (var j=0; j<parents[count].length; j++) {
12012: containerSelect(form,parents[count][j],offset,picked);
12013: }
12014: }
12015: }
12016: }
12017: }
12018: }
12019: }
12020:
1.1059 raeburn 12021: function titleCheck(form,count,offset) {
12022: if (count > 0) {
12023: var chosen = (offset+$startcount)+7*(count-1);
12024: var depitem = $startcount + ((count-1) * 7) + 2;
12025: var currtype = form.elements[depitem].type;
12026: if (form.elements[chosen].value == 'display') {
12027: document.getElementById('arc_title_'+count).style.display='block';
12028: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12029: document.getElementById('archive_title_'+count).value=maintitle;
12030: }
12031: } else {
12032: document.getElementById('arc_title_'+count).style.display='none';
12033: if (currtype == 'text') {
12034: document.getElementById('archive_title_'+count).value='';
12035: }
12036: }
12037: }
12038: return;
12039: }
12040:
1.1055 raeburn 12041: // ]]>
12042: </script>
12043: END
12044: return $scripttag;
12045: }
12046:
12047: sub process_extracted_files {
1.1067 raeburn 12048: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12049: my $numitems = $env{'form.archive_count'};
12050: return unless ($numitems);
12051: my @ids=&Apache::lonnet::current_machine_ids();
12052: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12053: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12054: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12055: if (grep(/^\Q$docuhome\E$/,@ids)) {
12056: $prefix = &LONCAPA::propath($docudom,$docuname);
12057: $pathtocheck = "$dir_root/$destination";
12058: $dir = $dir_root;
12059: $ishome = 1;
12060: } else {
12061: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12062: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12063: $dir = "$dir_root/$docudom/$docuname";
12064: }
12065: my $currdir = "$dir_root/$destination";
12066: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12067: if ($env{'form.folderpath'}) {
12068: my @items = split('&',$env{'form.folderpath'});
12069: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 12070: if ($env{'form.folderpath'} =~ /\:1$/) {
12071: $containers{'0'}='page';
12072: } else {
12073: $containers{'0'}='sequence';
12074: }
1.1055 raeburn 12075: }
12076: my @archdirs = &get_env_multiple('form.archive_directory');
12077: if ($numitems) {
12078: for (my $i=1; $i<=$numitems; $i++) {
12079: my $path = $env{'form.archive_content_'.$i};
12080: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12081: my $item = $1;
12082: $toplevelitems{$item} = $i;
12083: if (grep(/^\Q$i\E$/,@archdirs)) {
12084: $is_dir{$item} = 1;
12085: }
12086: }
12087: }
12088: }
1.1067 raeburn 12089: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12090: if (keys(%toplevelitems) > 0) {
12091: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12092: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12093: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12094: }
1.1066 raeburn 12095: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12096: if ($numitems) {
12097: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 12098: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12099: my $path = $env{'form.archive_content_'.$i};
12100: if ($path =~ /^\Q$pathtocheck\E/) {
12101: if ($env{'form.archive_'.$i} eq 'discard') {
12102: if ($prefix ne '' && $path ne '') {
12103: if (-e $prefix.$path) {
1.1066 raeburn 12104: if ((@archdirs > 0) &&
12105: (grep(/^\Q$i\E$/,@archdirs))) {
12106: $todeletedir{$prefix.$path} = 1;
12107: } else {
12108: $todelete{$prefix.$path} = 1;
12109: }
1.1055 raeburn 12110: }
12111: }
12112: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12113: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12114: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12115: $docstitle = $env{'form.archive_title_'.$i};
12116: if ($docstitle eq '') {
12117: $docstitle = $title;
12118: }
1.1055 raeburn 12119: $outer = 0;
1.1056 raeburn 12120: if (ref($dirorder{$i}) eq 'ARRAY') {
12121: if (@{$dirorder{$i}} > 0) {
12122: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12123: if ($env{'form.archive_'.$item} eq 'display') {
12124: $outer = $item;
12125: last;
12126: }
12127: }
12128: }
12129: }
12130: my ($errtext,$fatal) =
12131: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12132: '/'.$folders{$outer}.'.'.
12133: $containers{$outer});
12134: next if ($fatal);
12135: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12136: if ($context eq 'coursedocs') {
1.1056 raeburn 12137: $mapinner{$i} = time;
1.1055 raeburn 12138: $folders{$i} = 'default_'.$mapinner{$i};
12139: $containers{$i} = 'sequence';
12140: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12141: $folders{$i}.'.'.$containers{$i};
12142: my $newidx = &LONCAPA::map::getresidx();
12143: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12144: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12145: push(@LONCAPA::map::order,$newidx);
12146: my ($outtext,$errtext) =
12147: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12148: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12149: '.'.$containers{$outer},1,1);
1.1056 raeburn 12150: $newseqid{$i} = $newidx;
1.1067 raeburn 12151: unless ($errtext) {
12152: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12153: }
1.1055 raeburn 12154: }
12155: } else {
12156: if ($context eq 'coursedocs') {
12157: my $newidx=&LONCAPA::map::getresidx();
12158: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12159: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12160: $title;
12161: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12162: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12163: }
12164: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12165: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12166: }
12167: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12168: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12169: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12170: unless ($ishome) {
12171: my $fetch = "$newdest{$i}/$title";
12172: $fetch =~ s/^\Q$prefix$dir\E//;
12173: $prompttofetch{$fetch} = 1;
12174: }
1.1055 raeburn 12175: }
12176: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12177: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12178: push(@LONCAPA::map::order, $newidx);
12179: my ($outtext,$errtext)=
12180: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12181: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12182: '.'.$containers{$outer},1,1);
1.1067 raeburn 12183: unless ($errtext) {
12184: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12185: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12186: }
12187: }
1.1055 raeburn 12188: }
12189: }
1.1075.2.11 raeburn 12190: }
12191: } else {
12192: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12193: }
12194: }
12195: for (my $i=1; $i<=$numitems; $i++) {
12196: next unless ($env{'form.archive_'.$i} eq 'dependency');
12197: my $path = $env{'form.archive_content_'.$i};
12198: if ($path =~ /^\Q$pathtocheck\E/) {
12199: my ($title) = ($path =~ m{/([^/]+)$});
12200: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12201: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12202: if (ref($dirorder{$i}) eq 'ARRAY') {
12203: my ($itemidx,$fullpath,$relpath);
12204: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12205: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12206: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 12207: if ($dirorder{$i}->[$j] eq $container) {
12208: $itemidx = $j;
1.1056 raeburn 12209: }
12210: }
1.1075.2.11 raeburn 12211: }
12212: if ($itemidx eq '') {
12213: $itemidx = 0;
12214: }
12215: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12216: if ($mapinner{$referrer{$i}}) {
12217: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12218: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12219: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12220: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12221: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12222: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12223: if (!-e $fullpath) {
12224: mkdir($fullpath,0755);
1.1056 raeburn 12225: }
12226: }
1.1075.2.11 raeburn 12227: } else {
12228: last;
1.1056 raeburn 12229: }
1.1075.2.11 raeburn 12230: }
12231: }
12232: } elsif ($newdest{$referrer{$i}}) {
12233: $fullpath = $newdest{$referrer{$i}};
12234: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12235: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12236: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12237: last;
12238: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12239: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12240: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12241: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12242: if (!-e $fullpath) {
12243: mkdir($fullpath,0755);
1.1056 raeburn 12244: }
12245: }
1.1075.2.11 raeburn 12246: } else {
12247: last;
1.1056 raeburn 12248: }
1.1075.2.11 raeburn 12249: }
12250: }
12251: if ($fullpath ne '') {
12252: if (-e "$prefix$path") {
12253: system("mv $prefix$path $fullpath/$title");
12254: }
12255: if (-e "$fullpath/$title") {
12256: my $showpath;
12257: if ($relpath ne '') {
12258: $showpath = "$relpath/$title";
12259: } else {
12260: $showpath = "/$title";
1.1056 raeburn 12261: }
1.1075.2.11 raeburn 12262: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12263: }
12264: unless ($ishome) {
12265: my $fetch = "$fullpath/$title";
12266: $fetch =~ s/^\Q$prefix$dir\E//;
12267: $prompttofetch{$fetch} = 1;
1.1055 raeburn 12268: }
12269: }
12270: }
1.1075.2.11 raeburn 12271: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12272: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12273: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12274: }
12275: } else {
1.1075.2.11 raeburn 12276: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055 raeburn 12277: }
12278: }
12279: if (keys(%todelete)) {
12280: foreach my $key (keys(%todelete)) {
12281: unlink($key);
1.1066 raeburn 12282: }
12283: }
12284: if (keys(%todeletedir)) {
12285: foreach my $key (keys(%todeletedir)) {
12286: rmdir($key);
12287: }
12288: }
12289: foreach my $dir (sort(keys(%is_dir))) {
12290: if (($pathtocheck ne '') && ($dir ne '')) {
12291: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12292: }
12293: }
1.1067 raeburn 12294: if ($result ne '') {
12295: $output .= '<ul>'."\n".
12296: $result."\n".
12297: '</ul>';
12298: }
12299: unless ($ishome) {
12300: my $replicationfail;
12301: foreach my $item (keys(%prompttofetch)) {
12302: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12303: unless ($fetchresult eq 'ok') {
12304: $replicationfail .= '<li>'.$item.'</li>'."\n";
12305: }
12306: }
12307: if ($replicationfail) {
12308: $output .= '<p class="LC_error">'.
12309: &mt('Course home server failed to retrieve:').'<ul>'.
12310: $replicationfail.
12311: '</ul></p>';
12312: }
12313: }
1.1055 raeburn 12314: } else {
12315: $warning = &mt('No items found in archive.');
12316: }
12317: if ($error) {
12318: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12319: $error.'</p>'."\n";
12320: }
12321: if ($warning) {
12322: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12323: }
12324: return $output;
12325: }
12326:
1.1066 raeburn 12327: sub cleanup_empty_dirs {
12328: my ($path) = @_;
12329: if (($path ne '') && (-d $path)) {
12330: if (opendir(my $dirh,$path)) {
12331: my @dircontents = grep(!/^\./,readdir($dirh));
12332: my $numitems = 0;
12333: foreach my $item (@dircontents) {
12334: if (-d "$path/$item") {
1.1075.2.28 raeburn 12335: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12336: if (-e "$path/$item") {
12337: $numitems ++;
12338: }
12339: } else {
12340: $numitems ++;
12341: }
12342: }
12343: if ($numitems == 0) {
12344: rmdir($path);
12345: }
12346: closedir($dirh);
12347: }
12348: }
12349: return;
12350: }
12351:
1.41 ng 12352: =pod
1.45 matthew 12353:
1.1075.2.56 raeburn 12354: =item * &get_folder_hierarchy()
1.1068 raeburn 12355:
12356: Provides hierarchy of names of folders/sub-folders containing the current
12357: item,
12358:
12359: Inputs: 3
12360: - $navmap - navmaps object
12361:
12362: - $map - url for map (either the trigger itself, or map containing
12363: the resource, which is the trigger).
12364:
12365: - $showitem - 1 => show title for map itself; 0 => do not show.
12366:
12367: Outputs: 1 @pathitems - array of folder/subfolder names.
12368:
12369: =cut
12370:
12371: sub get_folder_hierarchy {
12372: my ($navmap,$map,$showitem) = @_;
12373: my @pathitems;
12374: if (ref($navmap)) {
12375: my $mapres = $navmap->getResourceByUrl($map);
12376: if (ref($mapres)) {
12377: my $pcslist = $mapres->map_hierarchy();
12378: if ($pcslist ne '') {
12379: my @pcs = split(/,/,$pcslist);
12380: foreach my $pc (@pcs) {
12381: if ($pc == 1) {
1.1075.2.38 raeburn 12382: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12383: } else {
12384: my $res = $navmap->getByMapPc($pc);
12385: if (ref($res)) {
12386: my $title = $res->compTitle();
12387: $title =~ s/\W+/_/g;
12388: if ($title ne '') {
12389: push(@pathitems,$title);
12390: }
12391: }
12392: }
12393: }
12394: }
1.1071 raeburn 12395: if ($showitem) {
12396: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 12397: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12398: } else {
12399: my $maptitle = $mapres->compTitle();
12400: $maptitle =~ s/\W+/_/g;
12401: if ($maptitle ne '') {
12402: push(@pathitems,$maptitle);
12403: }
1.1068 raeburn 12404: }
12405: }
12406: }
12407: }
12408: return @pathitems;
12409: }
12410:
12411: =pod
12412:
1.1015 raeburn 12413: =item * &get_turnedin_filepath()
12414:
12415: Determines path in a user's portfolio file for storage of files uploaded
12416: to a specific essayresponse or dropbox item.
12417:
12418: Inputs: 3 required + 1 optional.
12419: $symb is symb for resource, $uname and $udom are for current user (required).
12420: $caller is optional (can be "submission", if routine is called when storing
12421: an upoaded file when "Submit Answer" button was pressed).
12422:
12423: Returns array containing $path and $multiresp.
12424: $path is path in portfolio. $multiresp is 1 if this resource contains more
12425: than one file upload item. Callers of routine should append partid as a
12426: subdirectory to $path in cases where $multiresp is 1.
12427:
12428: Called by: homework/essayresponse.pm and homework/structuretags.pm
12429:
12430: =cut
12431:
12432: sub get_turnedin_filepath {
12433: my ($symb,$uname,$udom,$caller) = @_;
12434: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12435: my $turnindir;
12436: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12437: $turnindir = $userhash{'turnindir'};
12438: my ($path,$multiresp);
12439: if ($turnindir eq '') {
12440: if ($caller eq 'submission') {
12441: $turnindir = &mt('turned in');
12442: $turnindir =~ s/\W+/_/g;
12443: my %newhash = (
12444: 'turnindir' => $turnindir,
12445: );
12446: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12447: }
12448: }
12449: if ($turnindir ne '') {
12450: $path = '/'.$turnindir.'/';
12451: my ($multipart,$turnin,@pathitems);
12452: my $navmap = Apache::lonnavmaps::navmap->new();
12453: if (defined($navmap)) {
12454: my $mapres = $navmap->getResourceByUrl($map);
12455: if (ref($mapres)) {
12456: my $pcslist = $mapres->map_hierarchy();
12457: if ($pcslist ne '') {
12458: foreach my $pc (split(/,/,$pcslist)) {
12459: my $res = $navmap->getByMapPc($pc);
12460: if (ref($res)) {
12461: my $title = $res->compTitle();
12462: $title =~ s/\W+/_/g;
12463: if ($title ne '') {
1.1075.2.48 raeburn 12464: if (($pc > 1) && (length($title) > 12)) {
12465: $title = substr($title,0,12);
12466: }
1.1015 raeburn 12467: push(@pathitems,$title);
12468: }
12469: }
12470: }
12471: }
12472: my $maptitle = $mapres->compTitle();
12473: $maptitle =~ s/\W+/_/g;
12474: if ($maptitle ne '') {
1.1075.2.48 raeburn 12475: if (length($maptitle) > 12) {
12476: $maptitle = substr($maptitle,0,12);
12477: }
1.1015 raeburn 12478: push(@pathitems,$maptitle);
12479: }
12480: unless ($env{'request.state'} eq 'construct') {
12481: my $res = $navmap->getBySymb($symb);
12482: if (ref($res)) {
12483: my $partlist = $res->parts();
12484: my $totaluploads = 0;
12485: if (ref($partlist) eq 'ARRAY') {
12486: foreach my $part (@{$partlist}) {
12487: my @types = $res->responseType($part);
12488: my @ids = $res->responseIds($part);
12489: for (my $i=0; $i < scalar(@ids); $i++) {
12490: if ($types[$i] eq 'essay') {
12491: my $partid = $part.'_'.$ids[$i];
12492: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12493: $totaluploads ++;
12494: }
12495: }
12496: }
12497: }
12498: if ($totaluploads > 1) {
12499: $multiresp = 1;
12500: }
12501: }
12502: }
12503: }
12504: } else {
12505: return;
12506: }
12507: } else {
12508: return;
12509: }
12510: my $restitle=&Apache::lonnet::gettitle($symb);
12511: $restitle =~ s/\W+/_/g;
12512: if ($restitle eq '') {
12513: $restitle = ($resurl =~ m{/[^/]+$});
12514: if ($restitle eq '') {
12515: $restitle = time;
12516: }
12517: }
1.1075.2.48 raeburn 12518: if (length($restitle) > 12) {
12519: $restitle = substr($restitle,0,12);
12520: }
1.1015 raeburn 12521: push(@pathitems,$restitle);
12522: $path .= join('/',@pathitems);
12523: }
12524: return ($path,$multiresp);
12525: }
12526:
12527: =pod
12528:
1.464 albertel 12529: =back
1.41 ng 12530:
1.112 bowersj2 12531: =head1 CSV Upload/Handling functions
1.38 albertel 12532:
1.41 ng 12533: =over 4
12534:
1.648 raeburn 12535: =item * &upfile_store($r)
1.41 ng 12536:
12537: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12538: needs $env{'form.upfile'}
1.41 ng 12539: returns $datatoken to be put into hidden field
12540:
12541: =cut
1.31 albertel 12542:
12543: sub upfile_store {
12544: my $r=shift;
1.258 albertel 12545: $env{'form.upfile'}=~s/\r/\n/gs;
12546: $env{'form.upfile'}=~s/\f/\n/gs;
12547: $env{'form.upfile'}=~s/\n+/\n/gs;
12548: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12549:
1.258 albertel 12550: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12551: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12552: {
1.158 raeburn 12553: my $datafile = $r->dir_config('lonDaemons').
12554: '/tmp/'.$datatoken.'.tmp';
12555: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12556: print $fh $env{'form.upfile'};
1.158 raeburn 12557: close($fh);
12558: }
1.31 albertel 12559: }
12560: return $datatoken;
12561: }
12562:
1.56 matthew 12563: =pod
12564:
1.648 raeburn 12565: =item * &load_tmp_file($r)
1.41 ng 12566:
12567: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12568: needs $env{'form.datatoken'},
12569: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12570:
12571: =cut
1.31 albertel 12572:
12573: sub load_tmp_file {
12574: my $r=shift;
12575: my @studentdata=();
12576: {
1.158 raeburn 12577: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12578: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12579: if ( open(my $fh,"<$studentfile") ) {
12580: @studentdata=<$fh>;
12581: close($fh);
12582: }
1.31 albertel 12583: }
1.258 albertel 12584: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12585: }
12586:
1.56 matthew 12587: =pod
12588:
1.648 raeburn 12589: =item * &upfile_record_sep()
1.41 ng 12590:
12591: Separate uploaded file into records
12592: returns array of records,
1.258 albertel 12593: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12594:
12595: =cut
1.31 albertel 12596:
12597: sub upfile_record_sep {
1.258 albertel 12598: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12599: } else {
1.248 albertel 12600: my @records;
1.258 albertel 12601: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12602: if ($line=~/^\s*$/) { next; }
12603: push(@records,$line);
12604: }
12605: return @records;
1.31 albertel 12606: }
12607: }
12608:
1.56 matthew 12609: =pod
12610:
1.648 raeburn 12611: =item * &record_sep($record)
1.41 ng 12612:
1.258 albertel 12613: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12614:
12615: =cut
12616:
1.263 www 12617: sub takeleft {
12618: my $index=shift;
12619: return substr('0000'.$index,-4,4);
12620: }
12621:
1.31 albertel 12622: sub record_sep {
12623: my $record=shift;
12624: my %components=();
1.258 albertel 12625: if ($env{'form.upfiletype'} eq 'xml') {
12626: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12627: my $i=0;
1.356 albertel 12628: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12629: $field=~s/^(\"|\')//;
12630: $field=~s/(\"|\')$//;
1.263 www 12631: $components{&takeleft($i)}=$field;
1.31 albertel 12632: $i++;
12633: }
1.258 albertel 12634: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12635: my $i=0;
1.356 albertel 12636: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12637: $field=~s/^(\"|\')//;
12638: $field=~s/(\"|\')$//;
1.263 www 12639: $components{&takeleft($i)}=$field;
1.31 albertel 12640: $i++;
12641: }
12642: } else {
1.561 www 12643: my $separator=',';
1.480 banghart 12644: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12645: $separator=';';
1.480 banghart 12646: }
1.31 albertel 12647: my $i=0;
1.561 www 12648: # the character we are looking for to indicate the end of a quote or a record
12649: my $looking_for=$separator;
12650: # do not add the characters to the fields
12651: my $ignore=0;
12652: # we just encountered a separator (or the beginning of the record)
12653: my $just_found_separator=1;
12654: # store the field we are working on here
12655: my $field='';
12656: # work our way through all characters in record
12657: foreach my $character ($record=~/(.)/g) {
12658: if ($character eq $looking_for) {
12659: if ($character ne $separator) {
12660: # Found the end of a quote, again looking for separator
12661: $looking_for=$separator;
12662: $ignore=1;
12663: } else {
12664: # Found a separator, store away what we got
12665: $components{&takeleft($i)}=$field;
12666: $i++;
12667: $just_found_separator=1;
12668: $ignore=0;
12669: $field='';
12670: }
12671: next;
12672: }
12673: # single or double quotation marks after a separator indicate beginning of a quote
12674: # we are now looking for the end of the quote and need to ignore separators
12675: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12676: $looking_for=$character;
12677: next;
12678: }
12679: # ignore would be true after we reached the end of a quote
12680: if ($ignore) { next; }
12681: if (($just_found_separator) && ($character=~/\s/)) { next; }
12682: $field.=$character;
12683: $just_found_separator=0;
1.31 albertel 12684: }
1.561 www 12685: # catch the very last entry, since we never encountered the separator
12686: $components{&takeleft($i)}=$field;
1.31 albertel 12687: }
12688: return %components;
12689: }
12690:
1.144 matthew 12691: ######################################################
12692: ######################################################
12693:
1.56 matthew 12694: =pod
12695:
1.648 raeburn 12696: =item * &upfile_select_html()
1.41 ng 12697:
1.144 matthew 12698: Return HTML code to select a file from the users machine and specify
12699: the file type.
1.41 ng 12700:
12701: =cut
12702:
1.144 matthew 12703: ######################################################
12704: ######################################################
1.31 albertel 12705: sub upfile_select_html {
1.144 matthew 12706: my %Types = (
12707: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12708: semisv => &mt('Semicolon separated values'),
1.144 matthew 12709: space => &mt('Space separated'),
12710: tab => &mt('Tabulator separated'),
12711: # xml => &mt('HTML/XML'),
12712: );
12713: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12714: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12715: foreach my $type (sort(keys(%Types))) {
12716: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12717: }
12718: $Str .= "</select>\n";
12719: return $Str;
1.31 albertel 12720: }
12721:
1.301 albertel 12722: sub get_samples {
12723: my ($records,$toget) = @_;
12724: my @samples=({});
12725: my $got=0;
12726: foreach my $rec (@$records) {
12727: my %temp = &record_sep($rec);
12728: if (! grep(/\S/, values(%temp))) { next; }
12729: if (%temp) {
12730: $samples[$got]=\%temp;
12731: $got++;
12732: if ($got == $toget) { last; }
12733: }
12734: }
12735: return \@samples;
12736: }
12737:
1.144 matthew 12738: ######################################################
12739: ######################################################
12740:
1.56 matthew 12741: =pod
12742:
1.648 raeburn 12743: =item * &csv_print_samples($r,$records)
1.41 ng 12744:
12745: Prints a table of sample values from each column uploaded $r is an
12746: Apache Request ref, $records is an arrayref from
12747: &Apache::loncommon::upfile_record_sep
12748:
12749: =cut
12750:
1.144 matthew 12751: ######################################################
12752: ######################################################
1.31 albertel 12753: sub csv_print_samples {
12754: my ($r,$records) = @_;
1.662 bisitz 12755: my $samples = &get_samples($records,5);
1.301 albertel 12756:
1.594 raeburn 12757: $r->print(&mt('Samples').'<br />'.&start_data_table().
12758: &start_data_table_header_row());
1.356 albertel 12759: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12760: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12761: $r->print(&end_data_table_header_row());
1.301 albertel 12762: foreach my $hash (@$samples) {
1.594 raeburn 12763: $r->print(&start_data_table_row());
1.356 albertel 12764: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12765: $r->print('<td>');
1.356 albertel 12766: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12767: $r->print('</td>');
12768: }
1.594 raeburn 12769: $r->print(&end_data_table_row());
1.31 albertel 12770: }
1.594 raeburn 12771: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12772: }
12773:
1.144 matthew 12774: ######################################################
12775: ######################################################
12776:
1.56 matthew 12777: =pod
12778:
1.648 raeburn 12779: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12780:
12781: Prints a table to create associations between values and table columns.
1.144 matthew 12782:
1.41 ng 12783: $r is an Apache Request ref,
12784: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12785: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12786:
12787: =cut
12788:
1.144 matthew 12789: ######################################################
12790: ######################################################
1.31 albertel 12791: sub csv_print_select_table {
12792: my ($r,$records,$d) = @_;
1.301 albertel 12793: my $i=0;
12794: my $samples = &get_samples($records,1);
1.144 matthew 12795: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12796: &start_data_table().&start_data_table_header_row().
1.144 matthew 12797: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12798: '<th>'.&mt('Column').'</th>'.
12799: &end_data_table_header_row()."\n");
1.356 albertel 12800: foreach my $array_ref (@$d) {
12801: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12802: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12803:
1.875 bisitz 12804: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12805: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12806: $r->print('<option value="none"></option>');
1.356 albertel 12807: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12808: $r->print('<option value="'.$sample.'"'.
12809: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12810: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12811: }
1.594 raeburn 12812: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12813: $i++;
12814: }
1.594 raeburn 12815: $r->print(&end_data_table());
1.31 albertel 12816: $i--;
12817: return $i;
12818: }
1.56 matthew 12819:
1.144 matthew 12820: ######################################################
12821: ######################################################
12822:
1.56 matthew 12823: =pod
1.31 albertel 12824:
1.648 raeburn 12825: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12826:
12827: Prints a table of sample values from the upload and can make associate samples to internal names.
12828:
12829: $r is an Apache Request ref,
12830: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12831: $d is an array of 2 element arrays (internal name, displayed name)
12832:
12833: =cut
12834:
1.144 matthew 12835: ######################################################
12836: ######################################################
1.31 albertel 12837: sub csv_samples_select_table {
12838: my ($r,$records,$d) = @_;
12839: my $i=0;
1.144 matthew 12840: #
1.662 bisitz 12841: my $max_samples = 5;
12842: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12843: $r->print(&start_data_table().
12844: &start_data_table_header_row().'<th>'.
12845: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12846: &end_data_table_header_row());
1.301 albertel 12847:
12848: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12849: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12850: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12851: foreach my $option (@$d) {
12852: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12853: $r->print('<option value="'.$value.'"'.
1.253 albertel 12854: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12855: $display.'</option>');
1.31 albertel 12856: }
12857: $r->print('</select></td><td>');
1.662 bisitz 12858: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12859: if (defined($samples->[$line]{$key})) {
12860: $r->print($samples->[$line]{$key}."<br />\n");
12861: }
12862: }
1.594 raeburn 12863: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12864: $i++;
12865: }
1.594 raeburn 12866: $r->print(&end_data_table());
1.31 albertel 12867: $i--;
12868: return($i);
1.115 matthew 12869: }
12870:
1.144 matthew 12871: ######################################################
12872: ######################################################
12873:
1.115 matthew 12874: =pod
12875:
1.648 raeburn 12876: =item * &clean_excel_name($name)
1.115 matthew 12877:
12878: Returns a replacement for $name which does not contain any illegal characters.
12879:
12880: =cut
12881:
1.144 matthew 12882: ######################################################
12883: ######################################################
1.115 matthew 12884: sub clean_excel_name {
12885: my ($name) = @_;
12886: $name =~ s/[:\*\?\/\\]//g;
12887: if (length($name) > 31) {
12888: $name = substr($name,0,31);
12889: }
12890: return $name;
1.25 albertel 12891: }
1.84 albertel 12892:
1.85 albertel 12893: =pod
12894:
1.648 raeburn 12895: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12896:
12897: Returns either 1 or undef
12898:
12899: 1 if the part is to be hidden, undef if it is to be shown
12900:
12901: Arguments are:
12902:
12903: $id the id of the part to be checked
12904: $symb, optional the symb of the resource to check
12905: $udom, optional the domain of the user to check for
12906: $uname, optional the username of the user to check for
12907:
12908: =cut
1.84 albertel 12909:
12910: sub check_if_partid_hidden {
12911: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12912: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12913: $symb,$udom,$uname);
1.141 albertel 12914: my $truth=1;
12915: #if the string starts with !, then the list is the list to show not hide
12916: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12917: my @hiddenlist=split(/,/,$hiddenparts);
12918: foreach my $checkid (@hiddenlist) {
1.141 albertel 12919: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12920: }
1.141 albertel 12921: return !$truth;
1.84 albertel 12922: }
1.127 matthew 12923:
1.138 matthew 12924:
12925: ############################################################
12926: ############################################################
12927:
12928: =pod
12929:
1.157 matthew 12930: =back
12931:
1.138 matthew 12932: =head1 cgi-bin script and graphing routines
12933:
1.157 matthew 12934: =over 4
12935:
1.648 raeburn 12936: =item * &get_cgi_id()
1.138 matthew 12937:
12938: Inputs: none
12939:
12940: Returns an id which can be used to pass environment variables
12941: to various cgi-bin scripts. These environment variables will
12942: be removed from the users environment after a given time by
12943: the routine &Apache::lonnet::transfer_profile_to_env.
12944:
12945: =cut
12946:
12947: ############################################################
12948: ############################################################
1.152 albertel 12949: my $uniq=0;
1.136 matthew 12950: sub get_cgi_id {
1.154 albertel 12951: $uniq=($uniq+1)%100000;
1.280 albertel 12952: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12953: }
12954:
1.127 matthew 12955: ############################################################
12956: ############################################################
12957:
12958: =pod
12959:
1.648 raeburn 12960: =item * &DrawBarGraph()
1.127 matthew 12961:
1.138 matthew 12962: Facilitates the plotting of data in a (stacked) bar graph.
12963: Puts plot definition data into the users environment in order for
12964: graph.png to plot it. Returns an <img> tag for the plot.
12965: The bars on the plot are labeled '1','2',...,'n'.
12966:
12967: Inputs:
12968:
12969: =over 4
12970:
12971: =item $Title: string, the title of the plot
12972:
12973: =item $xlabel: string, text describing the X-axis of the plot
12974:
12975: =item $ylabel: string, text describing the Y-axis of the plot
12976:
12977: =item $Max: scalar, the maximum Y value to use in the plot
12978: If $Max is < any data point, the graph will not be rendered.
12979:
1.140 matthew 12980: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12981: they are plotted. If undefined, default values will be used.
12982:
1.178 matthew 12983: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12984:
1.138 matthew 12985: =item @Values: An array of array references. Each array reference holds data
12986: to be plotted in a stacked bar chart.
12987:
1.239 matthew 12988: =item If the final element of @Values is a hash reference the key/value
12989: pairs will be added to the graph definition.
12990:
1.138 matthew 12991: =back
12992:
12993: Returns:
12994:
12995: An <img> tag which references graph.png and the appropriate identifying
12996: information for the plot.
12997:
1.127 matthew 12998: =cut
12999:
13000: ############################################################
13001: ############################################################
1.134 matthew 13002: sub DrawBarGraph {
1.178 matthew 13003: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13004: #
13005: if (! defined($colors)) {
13006: $colors = ['#33ff00',
13007: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13008: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13009: ];
13010: }
1.228 matthew 13011: my $extra_settings = {};
13012: if (ref($Values[-1]) eq 'HASH') {
13013: $extra_settings = pop(@Values);
13014: }
1.127 matthew 13015: #
1.136 matthew 13016: my $identifier = &get_cgi_id();
13017: my $id = 'cgi.'.$identifier;
1.129 matthew 13018: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13019: return '';
13020: }
1.225 matthew 13021: #
13022: my @Labels;
13023: if (defined($labels)) {
13024: @Labels = @$labels;
13025: } else {
13026: for (my $i=0;$i<@{$Values[0]};$i++) {
13027: push (@Labels,$i+1);
13028: }
13029: }
13030: #
1.129 matthew 13031: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13032: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13033: my %ValuesHash;
13034: my $NumSets=1;
13035: foreach my $array (@Values) {
13036: next if (! ref($array));
1.136 matthew 13037: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13038: join(',',@$array);
1.129 matthew 13039: }
1.127 matthew 13040: #
1.136 matthew 13041: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13042: if ($NumBars < 3) {
13043: $width = 120+$NumBars*32;
1.220 matthew 13044: $xskip = 1;
1.225 matthew 13045: $bar_width = 30;
13046: } elsif ($NumBars < 5) {
13047: $width = 120+$NumBars*20;
13048: $xskip = 1;
13049: $bar_width = 20;
1.220 matthew 13050: } elsif ($NumBars < 10) {
1.136 matthew 13051: $width = 120+$NumBars*15;
13052: $xskip = 1;
13053: $bar_width = 15;
13054: } elsif ($NumBars <= 25) {
13055: $width = 120+$NumBars*11;
13056: $xskip = 5;
13057: $bar_width = 8;
13058: } elsif ($NumBars <= 50) {
13059: $width = 120+$NumBars*8;
13060: $xskip = 5;
13061: $bar_width = 4;
13062: } else {
13063: $width = 120+$NumBars*8;
13064: $xskip = 5;
13065: $bar_width = 4;
13066: }
13067: #
1.137 matthew 13068: $Max = 1 if ($Max < 1);
13069: if ( int($Max) < $Max ) {
13070: $Max++;
13071: $Max = int($Max);
13072: }
1.127 matthew 13073: $Title = '' if (! defined($Title));
13074: $xlabel = '' if (! defined($xlabel));
13075: $ylabel = '' if (! defined($ylabel));
1.369 www 13076: $ValuesHash{$id.'.title'} = &escape($Title);
13077: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13078: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13079: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13080: $ValuesHash{$id.'.NumBars'} = $NumBars;
13081: $ValuesHash{$id.'.NumSets'} = $NumSets;
13082: $ValuesHash{$id.'.PlotType'} = 'bar';
13083: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13084: $ValuesHash{$id.'.height'} = $height;
13085: $ValuesHash{$id.'.width'} = $width;
13086: $ValuesHash{$id.'.xskip'} = $xskip;
13087: $ValuesHash{$id.'.bar_width'} = $bar_width;
13088: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13089: #
1.228 matthew 13090: # Deal with other parameters
13091: while (my ($key,$value) = each(%$extra_settings)) {
13092: $ValuesHash{$id.'.'.$key} = $value;
13093: }
13094: #
1.646 raeburn 13095: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13096: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13097: }
13098:
13099: ############################################################
13100: ############################################################
13101:
13102: =pod
13103:
1.648 raeburn 13104: =item * &DrawXYGraph()
1.137 matthew 13105:
1.138 matthew 13106: Facilitates the plotting of data in an XY graph.
13107: Puts plot definition data into the users environment in order for
13108: graph.png to plot it. Returns an <img> tag for the plot.
13109:
13110: Inputs:
13111:
13112: =over 4
13113:
13114: =item $Title: string, the title of the plot
13115:
13116: =item $xlabel: string, text describing the X-axis of the plot
13117:
13118: =item $ylabel: string, text describing the Y-axis of the plot
13119:
13120: =item $Max: scalar, the maximum Y value to use in the plot
13121: If $Max is < any data point, the graph will not be rendered.
13122:
13123: =item $colors: Array ref containing the hex color codes for the data to be
13124: plotted in. If undefined, default values will be used.
13125:
13126: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13127:
13128: =item $Ydata: Array ref containing Array refs.
1.185 www 13129: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13130:
13131: =item %Values: hash indicating or overriding any default values which are
13132: passed to graph.png.
13133: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13134:
13135: =back
13136:
13137: Returns:
13138:
13139: An <img> tag which references graph.png and the appropriate identifying
13140: information for the plot.
13141:
1.137 matthew 13142: =cut
13143:
13144: ############################################################
13145: ############################################################
13146: sub DrawXYGraph {
13147: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13148: #
13149: # Create the identifier for the graph
13150: my $identifier = &get_cgi_id();
13151: my $id = 'cgi.'.$identifier;
13152: #
13153: $Title = '' if (! defined($Title));
13154: $xlabel = '' if (! defined($xlabel));
13155: $ylabel = '' if (! defined($ylabel));
13156: my %ValuesHash =
13157: (
1.369 www 13158: $id.'.title' => &escape($Title),
13159: $id.'.xlabel' => &escape($xlabel),
13160: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13161: $id.'.y_max_value'=> $Max,
13162: $id.'.labels' => join(',',@$Xlabels),
13163: $id.'.PlotType' => 'XY',
13164: );
13165: #
13166: if (defined($colors) && ref($colors) eq 'ARRAY') {
13167: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13168: }
13169: #
13170: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13171: return '';
13172: }
13173: my $NumSets=1;
1.138 matthew 13174: foreach my $array (@{$Ydata}){
1.137 matthew 13175: next if (! ref($array));
13176: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13177: }
1.138 matthew 13178: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13179: #
13180: # Deal with other parameters
13181: while (my ($key,$value) = each(%Values)) {
13182: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13183: }
13184: #
1.646 raeburn 13185: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13186: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13187: }
13188:
13189: ############################################################
13190: ############################################################
13191:
13192: =pod
13193:
1.648 raeburn 13194: =item * &DrawXYYGraph()
1.138 matthew 13195:
13196: Facilitates the plotting of data in an XY graph with two Y axes.
13197: Puts plot definition data into the users environment in order for
13198: graph.png to plot it. Returns an <img> tag for the plot.
13199:
13200: Inputs:
13201:
13202: =over 4
13203:
13204: =item $Title: string, the title of the plot
13205:
13206: =item $xlabel: string, text describing the X-axis of the plot
13207:
13208: =item $ylabel: string, text describing the Y-axis of the plot
13209:
13210: =item $colors: Array ref containing the hex color codes for the data to be
13211: plotted in. If undefined, default values will be used.
13212:
13213: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13214:
13215: =item $Ydata1: The first data set
13216:
13217: =item $Min1: The minimum value of the left Y-axis
13218:
13219: =item $Max1: The maximum value of the left Y-axis
13220:
13221: =item $Ydata2: The second data set
13222:
13223: =item $Min2: The minimum value of the right Y-axis
13224:
13225: =item $Max2: The maximum value of the left Y-axis
13226:
13227: =item %Values: hash indicating or overriding any default values which are
13228: passed to graph.png.
13229: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13230:
13231: =back
13232:
13233: Returns:
13234:
13235: An <img> tag which references graph.png and the appropriate identifying
13236: information for the plot.
1.136 matthew 13237:
13238: =cut
13239:
13240: ############################################################
13241: ############################################################
1.137 matthew 13242: sub DrawXYYGraph {
13243: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13244: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13245: #
13246: # Create the identifier for the graph
13247: my $identifier = &get_cgi_id();
13248: my $id = 'cgi.'.$identifier;
13249: #
13250: $Title = '' if (! defined($Title));
13251: $xlabel = '' if (! defined($xlabel));
13252: $ylabel = '' if (! defined($ylabel));
13253: my %ValuesHash =
13254: (
1.369 www 13255: $id.'.title' => &escape($Title),
13256: $id.'.xlabel' => &escape($xlabel),
13257: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13258: $id.'.labels' => join(',',@$Xlabels),
13259: $id.'.PlotType' => 'XY',
13260: $id.'.NumSets' => 2,
1.137 matthew 13261: $id.'.two_axes' => 1,
13262: $id.'.y1_max_value' => $Max1,
13263: $id.'.y1_min_value' => $Min1,
13264: $id.'.y2_max_value' => $Max2,
13265: $id.'.y2_min_value' => $Min2,
1.136 matthew 13266: );
13267: #
1.137 matthew 13268: if (defined($colors) && ref($colors) eq 'ARRAY') {
13269: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13270: }
13271: #
13272: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13273: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13274: return '';
13275: }
13276: my $NumSets=1;
1.137 matthew 13277: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13278: next if (! ref($array));
13279: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13280: }
13281: #
13282: # Deal with other parameters
13283: while (my ($key,$value) = each(%Values)) {
13284: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13285: }
13286: #
1.646 raeburn 13287: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13288: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13289: }
13290:
13291: ############################################################
13292: ############################################################
13293:
13294: =pod
13295:
1.157 matthew 13296: =back
13297:
1.139 matthew 13298: =head1 Statistics helper routines?
13299:
13300: Bad place for them but what the hell.
13301:
1.157 matthew 13302: =over 4
13303:
1.648 raeburn 13304: =item * &chartlink()
1.139 matthew 13305:
13306: Returns a link to the chart for a specific student.
13307:
13308: Inputs:
13309:
13310: =over 4
13311:
13312: =item $linktext: The text of the link
13313:
13314: =item $sname: The students username
13315:
13316: =item $sdomain: The students domain
13317:
13318: =back
13319:
1.157 matthew 13320: =back
13321:
1.139 matthew 13322: =cut
13323:
13324: ############################################################
13325: ############################################################
13326: sub chartlink {
13327: my ($linktext, $sname, $sdomain) = @_;
13328: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13329: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13330: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13331: '">'.$linktext.'</a>';
1.153 matthew 13332: }
13333:
13334: #######################################################
13335: #######################################################
13336:
13337: =pod
13338:
13339: =head1 Course Environment Routines
1.157 matthew 13340:
13341: =over 4
1.153 matthew 13342:
1.648 raeburn 13343: =item * &restore_course_settings()
1.153 matthew 13344:
1.648 raeburn 13345: =item * &store_course_settings()
1.153 matthew 13346:
13347: Restores/Store indicated form parameters from the course environment.
13348: Will not overwrite existing values of the form parameters.
13349:
13350: Inputs:
13351: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13352:
13353: a hash ref describing the data to be stored. For example:
13354:
13355: %Save_Parameters = ('Status' => 'scalar',
13356: 'chartoutputmode' => 'scalar',
13357: 'chartoutputdata' => 'scalar',
13358: 'Section' => 'array',
1.373 raeburn 13359: 'Group' => 'array',
1.153 matthew 13360: 'StudentData' => 'array',
13361: 'Maps' => 'array');
13362:
13363: Returns: both routines return nothing
13364:
1.631 raeburn 13365: =back
13366:
1.153 matthew 13367: =cut
13368:
13369: #######################################################
13370: #######################################################
13371: sub store_course_settings {
1.496 albertel 13372: return &store_settings($env{'request.course.id'},@_);
13373: }
13374:
13375: sub store_settings {
1.153 matthew 13376: # save to the environment
13377: # appenv the same items, just to be safe
1.300 albertel 13378: my $udom = $env{'user.domain'};
13379: my $uname = $env{'user.name'};
1.496 albertel 13380: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13381: my %SaveHash;
13382: my %AppHash;
13383: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13384: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13385: my $envname = 'environment.'.$basename;
1.258 albertel 13386: if (exists($env{'form.'.$setting})) {
1.153 matthew 13387: # Save this value away
13388: if ($type eq 'scalar' &&
1.258 albertel 13389: (! exists($env{$envname}) ||
13390: $env{$envname} ne $env{'form.'.$setting})) {
13391: $SaveHash{$basename} = $env{'form.'.$setting};
13392: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13393: } elsif ($type eq 'array') {
13394: my $stored_form;
1.258 albertel 13395: if (ref($env{'form.'.$setting})) {
1.153 matthew 13396: $stored_form = join(',',
13397: map {
1.369 www 13398: &escape($_);
1.258 albertel 13399: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13400: } else {
13401: $stored_form =
1.369 www 13402: &escape($env{'form.'.$setting});
1.153 matthew 13403: }
13404: # Determine if the array contents are the same.
1.258 albertel 13405: if ($stored_form ne $env{$envname}) {
1.153 matthew 13406: $SaveHash{$basename} = $stored_form;
13407: $AppHash{$envname} = $stored_form;
13408: }
13409: }
13410: }
13411: }
13412: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13413: $udom,$uname);
1.153 matthew 13414: if ($put_result !~ /^(ok|delayed)/) {
13415: &Apache::lonnet::logthis('unable to save form parameters, '.
13416: 'got error:'.$put_result);
13417: }
13418: # Make sure these settings stick around in this session, too
1.646 raeburn 13419: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13420: return;
13421: }
13422:
13423: sub restore_course_settings {
1.499 albertel 13424: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13425: }
13426:
13427: sub restore_settings {
13428: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13429: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13430: next if (exists($env{'form.'.$setting}));
1.496 albertel 13431: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13432: '.'.$setting;
1.258 albertel 13433: if (exists($env{$envname})) {
1.153 matthew 13434: if ($type eq 'scalar') {
1.258 albertel 13435: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13436: } elsif ($type eq 'array') {
1.258 albertel 13437: $env{'form.'.$setting} = [
1.153 matthew 13438: map {
1.369 www 13439: &unescape($_);
1.258 albertel 13440: } split(',',$env{$envname})
1.153 matthew 13441: ];
13442: }
13443: }
13444: }
1.127 matthew 13445: }
13446:
1.618 raeburn 13447: #######################################################
13448: #######################################################
13449:
13450: =pod
13451:
13452: =head1 Domain E-mail Routines
13453:
13454: =over 4
13455:
1.648 raeburn 13456: =item * &build_recipient_list()
1.618 raeburn 13457:
1.1075.2.44 raeburn 13458: Build recipient lists for following types of e-mail:
1.766 raeburn 13459: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 13460: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13461: module change checking, student/employee ID conflict checks, as
13462: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13463: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13464:
13465: Inputs:
1.1075.2.44 raeburn 13466: defmail (scalar - email address of default recipient),
13467: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13468: requestsmail, updatesmail, or idconflictsmail).
13469:
1.619 raeburn 13470: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 13471:
13472: origmail (scalar - email address of recipient from loncapa.conf,
13473: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13474:
1.655 raeburn 13475: Returns: comma separated list of addresses to which to send e-mail.
13476:
13477: =back
1.618 raeburn 13478:
13479: =cut
13480:
13481: ############################################################
13482: ############################################################
13483: sub build_recipient_list {
1.619 raeburn 13484: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13485: my @recipients;
13486: my $otheremails;
13487: my %domconfig =
13488: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13489: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13490: if (exists($domconfig{'contacts'}{$mailing})) {
13491: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13492: my @contacts = ('adminemail','supportemail');
13493: foreach my $item (@contacts) {
13494: if ($domconfig{'contacts'}{$mailing}{$item}) {
13495: my $addr = $domconfig{'contacts'}{$item};
13496: if (!grep(/^\Q$addr\E$/,@recipients)) {
13497: push(@recipients,$addr);
13498: }
1.619 raeburn 13499: }
1.766 raeburn 13500: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13501: }
13502: }
1.766 raeburn 13503: } elsif ($origmail ne '') {
13504: push(@recipients,$origmail);
1.618 raeburn 13505: }
1.619 raeburn 13506: } elsif ($origmail ne '') {
13507: push(@recipients,$origmail);
1.618 raeburn 13508: }
1.688 raeburn 13509: if (defined($defmail)) {
13510: if ($defmail ne '') {
13511: push(@recipients,$defmail);
13512: }
1.618 raeburn 13513: }
13514: if ($otheremails) {
1.619 raeburn 13515: my @others;
13516: if ($otheremails =~ /,/) {
13517: @others = split(/,/,$otheremails);
1.618 raeburn 13518: } else {
1.619 raeburn 13519: push(@others,$otheremails);
13520: }
13521: foreach my $addr (@others) {
13522: if (!grep(/^\Q$addr\E$/,@recipients)) {
13523: push(@recipients,$addr);
13524: }
1.618 raeburn 13525: }
13526: }
1.619 raeburn 13527: my $recipientlist = join(',',@recipients);
1.618 raeburn 13528: return $recipientlist;
13529: }
13530:
1.127 matthew 13531: ############################################################
13532: ############################################################
1.154 albertel 13533:
1.655 raeburn 13534: =pod
13535:
13536: =head1 Course Catalog Routines
13537:
13538: =over 4
13539:
13540: =item * &gather_categories()
13541:
13542: Converts category definitions - keys of categories hash stored in
13543: coursecategories in configuration.db on the primary library server in a
13544: domain - to an array. Also generates javascript and idx hash used to
13545: generate Domain Coordinator interface for editing Course Categories.
13546:
13547: Inputs:
1.663 raeburn 13548:
1.655 raeburn 13549: categories (reference to hash of category definitions).
1.663 raeburn 13550:
1.655 raeburn 13551: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13552: categories and subcategories).
1.663 raeburn 13553:
1.655 raeburn 13554: idx (reference to hash of counters used in Domain Coordinator interface for
13555: editing Course Categories).
1.663 raeburn 13556:
1.655 raeburn 13557: jsarray (reference to array of categories used to create Javascript arrays for
13558: Domain Coordinator interface for editing Course Categories).
13559:
13560: Returns: nothing
13561:
13562: Side effects: populates cats, idx and jsarray.
13563:
13564: =cut
13565:
13566: sub gather_categories {
13567: my ($categories,$cats,$idx,$jsarray) = @_;
13568: my %counters;
13569: my $num = 0;
13570: foreach my $item (keys(%{$categories})) {
13571: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13572: if ($container eq '' && $depth == 0) {
13573: $cats->[$depth][$categories->{$item}] = $cat;
13574: } else {
13575: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13576: }
13577: my ($escitem,$tail) = split(/:/,$item,2);
13578: if ($counters{$tail} eq '') {
13579: $counters{$tail} = $num;
13580: $num ++;
13581: }
13582: if (ref($idx) eq 'HASH') {
13583: $idx->{$item} = $counters{$tail};
13584: }
13585: if (ref($jsarray) eq 'ARRAY') {
13586: push(@{$jsarray->[$counters{$tail}]},$item);
13587: }
13588: }
13589: return;
13590: }
13591:
13592: =pod
13593:
13594: =item * &extract_categories()
13595:
13596: Used to generate breadcrumb trails for course categories.
13597:
13598: Inputs:
1.663 raeburn 13599:
1.655 raeburn 13600: categories (reference to hash of category definitions).
1.663 raeburn 13601:
1.655 raeburn 13602: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13603: categories and subcategories).
1.663 raeburn 13604:
1.655 raeburn 13605: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13606:
1.655 raeburn 13607: allitems (reference to hash - key is category key
13608: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13609:
1.655 raeburn 13610: idx (reference to hash of counters used in Domain Coordinator interface for
13611: editing Course Categories).
1.663 raeburn 13612:
1.655 raeburn 13613: jsarray (reference to array of categories used to create Javascript arrays for
13614: Domain Coordinator interface for editing Course Categories).
13615:
1.665 raeburn 13616: subcats (reference to hash of arrays containing all subcategories within each
13617: category, -recursive)
13618:
1.655 raeburn 13619: Returns: nothing
13620:
13621: Side effects: populates trails and allitems hash references.
13622:
13623: =cut
13624:
13625: sub extract_categories {
1.665 raeburn 13626: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13627: if (ref($categories) eq 'HASH') {
13628: &gather_categories($categories,$cats,$idx,$jsarray);
13629: if (ref($cats->[0]) eq 'ARRAY') {
13630: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13631: my $name = $cats->[0][$i];
13632: my $item = &escape($name).'::0';
13633: my $trailstr;
13634: if ($name eq 'instcode') {
13635: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13636: } elsif ($name eq 'communities') {
13637: $trailstr = &mt('Communities');
1.655 raeburn 13638: } else {
13639: $trailstr = $name;
13640: }
13641: if ($allitems->{$item} eq '') {
13642: push(@{$trails},$trailstr);
13643: $allitems->{$item} = scalar(@{$trails})-1;
13644: }
13645: my @parents = ($name);
13646: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13647: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13648: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13649: if (ref($subcats) eq 'HASH') {
13650: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13651: }
13652: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13653: }
13654: } else {
13655: if (ref($subcats) eq 'HASH') {
13656: $subcats->{$item} = [];
1.655 raeburn 13657: }
13658: }
13659: }
13660: }
13661: }
13662: return;
13663: }
13664:
13665: =pod
13666:
1.1075.2.56 raeburn 13667: =item * &recurse_categories()
1.655 raeburn 13668:
13669: Recursively used to generate breadcrumb trails for course categories.
13670:
13671: Inputs:
1.663 raeburn 13672:
1.655 raeburn 13673: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13674: categories and subcategories).
1.663 raeburn 13675:
1.655 raeburn 13676: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13677:
13678: category (current course category, for which breadcrumb trail is being generated).
13679:
13680: trails (reference to array of breadcrumb trails for each category).
13681:
1.655 raeburn 13682: allitems (reference to hash - key is category key
13683: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13684:
1.655 raeburn 13685: parents (array containing containers directories for current category,
13686: back to top level).
13687:
13688: Returns: nothing
13689:
13690: Side effects: populates trails and allitems hash references
13691:
13692: =cut
13693:
13694: sub recurse_categories {
1.665 raeburn 13695: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13696: my $shallower = $depth - 1;
13697: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13698: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13699: my $name = $cats->[$depth]{$category}[$k];
13700: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13701: my $trailstr = join(' -> ',(@{$parents},$category));
13702: if ($allitems->{$item} eq '') {
13703: push(@{$trails},$trailstr);
13704: $allitems->{$item} = scalar(@{$trails})-1;
13705: }
13706: my $deeper = $depth+1;
13707: push(@{$parents},$category);
1.665 raeburn 13708: if (ref($subcats) eq 'HASH') {
13709: my $subcat = &escape($name).':'.$category.':'.$depth;
13710: for (my $j=@{$parents}; $j>=0; $j--) {
13711: my $higher;
13712: if ($j > 0) {
13713: $higher = &escape($parents->[$j]).':'.
13714: &escape($parents->[$j-1]).':'.$j;
13715: } else {
13716: $higher = &escape($parents->[$j]).'::'.$j;
13717: }
13718: push(@{$subcats->{$higher}},$subcat);
13719: }
13720: }
13721: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13722: $subcats);
1.655 raeburn 13723: pop(@{$parents});
13724: }
13725: } else {
13726: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13727: my $trailstr = join(' -> ',(@{$parents},$category));
13728: if ($allitems->{$item} eq '') {
13729: push(@{$trails},$trailstr);
13730: $allitems->{$item} = scalar(@{$trails})-1;
13731: }
13732: }
13733: return;
13734: }
13735:
1.663 raeburn 13736: =pod
13737:
1.1075.2.56 raeburn 13738: =item * &assign_categories_table()
1.663 raeburn 13739:
13740: Create a datatable for display of hierarchical categories in a domain,
13741: with checkboxes to allow a course to be categorized.
13742:
13743: Inputs:
13744:
13745: cathash - reference to hash of categories defined for the domain (from
13746: configuration.db)
13747:
13748: currcat - scalar with an & separated list of categories assigned to a course.
13749:
1.919 raeburn 13750: type - scalar contains course type (Course or Community).
13751:
1.663 raeburn 13752: Returns: $output (markup to be displayed)
13753:
13754: =cut
13755:
13756: sub assign_categories_table {
1.919 raeburn 13757: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13758: my $output;
13759: if (ref($cathash) eq 'HASH') {
13760: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13761: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13762: $maxdepth = scalar(@cats);
13763: if (@cats > 0) {
13764: my $itemcount = 0;
13765: if (ref($cats[0]) eq 'ARRAY') {
13766: my @currcategories;
13767: if ($currcat ne '') {
13768: @currcategories = split('&',$currcat);
13769: }
1.919 raeburn 13770: my $table;
1.663 raeburn 13771: for (my $i=0; $i<@{$cats[0]}; $i++) {
13772: my $parent = $cats[0][$i];
1.919 raeburn 13773: next if ($parent eq 'instcode');
13774: if ($type eq 'Community') {
13775: next unless ($parent eq 'communities');
13776: } else {
13777: next if ($parent eq 'communities');
13778: }
1.663 raeburn 13779: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13780: my $item = &escape($parent).'::0';
13781: my $checked = '';
13782: if (@currcategories > 0) {
13783: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13784: $checked = ' checked="checked"';
1.663 raeburn 13785: }
13786: }
1.919 raeburn 13787: my $parent_title = $parent;
13788: if ($parent eq 'communities') {
13789: $parent_title = &mt('Communities');
13790: }
13791: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13792: '<input type="checkbox" name="usecategory" value="'.
13793: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13794: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13795: my $depth = 1;
13796: push(@path,$parent);
1.919 raeburn 13797: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13798: pop(@path);
1.919 raeburn 13799: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13800: $itemcount ++;
13801: }
1.919 raeburn 13802: if ($itemcount) {
13803: $output = &Apache::loncommon::start_data_table().
13804: $table.
13805: &Apache::loncommon::end_data_table();
13806: }
1.663 raeburn 13807: }
13808: }
13809: }
13810: return $output;
13811: }
13812:
13813: =pod
13814:
1.1075.2.56 raeburn 13815: =item * &assign_category_rows()
1.663 raeburn 13816:
13817: Create a datatable row for display of nested categories in a domain,
13818: with checkboxes to allow a course to be categorized,called recursively.
13819:
13820: Inputs:
13821:
13822: itemcount - track row number for alternating colors
13823:
13824: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13825: categories and subcategories.
13826:
13827: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13828:
13829: parent - parent of current category item
13830:
13831: path - Array containing all categories back up through the hierarchy from the
13832: current category to the top level.
13833:
13834: currcategories - reference to array of current categories assigned to the course
13835:
13836: Returns: $output (markup to be displayed).
13837:
13838: =cut
13839:
13840: sub assign_category_rows {
13841: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13842: my ($text,$name,$item,$chgstr);
13843: if (ref($cats) eq 'ARRAY') {
13844: my $maxdepth = scalar(@{$cats});
13845: if (ref($cats->[$depth]) eq 'HASH') {
13846: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13847: my $numchildren = @{$cats->[$depth]{$parent}};
13848: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 13849: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13850: for (my $j=0; $j<$numchildren; $j++) {
13851: $name = $cats->[$depth]{$parent}[$j];
13852: $item = &escape($name).':'.&escape($parent).':'.$depth;
13853: my $deeper = $depth+1;
13854: my $checked = '';
13855: if (ref($currcategories) eq 'ARRAY') {
13856: if (@{$currcategories} > 0) {
13857: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13858: $checked = ' checked="checked"';
1.663 raeburn 13859: }
13860: }
13861: }
1.664 raeburn 13862: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13863: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13864: $item.'"'.$checked.' />'.$name.'</label></span>'.
13865: '<input type="hidden" name="catname" value="'.$name.'" />'.
13866: '</td><td>';
1.663 raeburn 13867: if (ref($path) eq 'ARRAY') {
13868: push(@{$path},$name);
13869: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13870: pop(@{$path});
13871: }
13872: $text .= '</td></tr>';
13873: }
13874: $text .= '</table></td>';
13875: }
13876: }
13877: }
13878: return $text;
13879: }
13880:
1.1075.2.69 raeburn 13881: =pod
13882:
13883: =back
13884:
13885: =cut
13886:
1.655 raeburn 13887: ############################################################
13888: ############################################################
13889:
13890:
1.443 albertel 13891: sub commit_customrole {
1.664 raeburn 13892: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13893: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13894: ($start?', '.&mt('starting').' '.localtime($start):'').
13895: ($end?', ending '.localtime($end):'').': <b>'.
13896: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13897: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13898: '</b><br />';
13899: return $output;
13900: }
13901:
13902: sub commit_standardrole {
1.1075.2.31 raeburn 13903: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13904: my ($output,$logmsg,$linefeed);
13905: if ($context eq 'auto') {
13906: $linefeed = "\n";
13907: } else {
13908: $linefeed = "<br />\n";
13909: }
1.443 albertel 13910: if ($three eq 'st') {
1.541 raeburn 13911: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 13912: $one,$two,$sec,$context,$credits);
1.541 raeburn 13913: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13914: ($result eq 'unknown_course') || ($result eq 'refused')) {
13915: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13916: } else {
1.541 raeburn 13917: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13918: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13919: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13920: if ($context eq 'auto') {
13921: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13922: } else {
13923: $output .= '<b>'.$result.'</b>'.$linefeed.
13924: &mt('Add to classlist').': <b>ok</b>';
13925: }
13926: $output .= $linefeed;
1.443 albertel 13927: }
13928: } else {
13929: $output = &mt('Assigning').' '.$three.' in '.$url.
13930: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13931: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13932: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13933: if ($context eq 'auto') {
13934: $output .= $result.$linefeed;
13935: } else {
13936: $output .= '<b>'.$result.'</b>'.$linefeed;
13937: }
1.443 albertel 13938: }
13939: return $output;
13940: }
13941:
13942: sub commit_studentrole {
1.1075.2.31 raeburn 13943: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
13944: $credits) = @_;
1.626 raeburn 13945: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13946: if ($context eq 'auto') {
13947: $linefeed = "\n";
13948: } else {
13949: $linefeed = '<br />'."\n";
13950: }
1.443 albertel 13951: if (defined($one) && defined($two)) {
13952: my $cid=$one.'_'.$two;
13953: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13954: my $secchange = 0;
13955: my $expire_role_result;
13956: my $modify_section_result;
1.628 raeburn 13957: if ($oldsec ne '-1') {
13958: if ($oldsec ne $sec) {
1.443 albertel 13959: $secchange = 1;
1.628 raeburn 13960: my $now = time;
1.443 albertel 13961: my $uurl='/'.$cid;
13962: $uurl=~s/\_/\//g;
13963: if ($oldsec) {
13964: $uurl.='/'.$oldsec;
13965: }
1.626 raeburn 13966: $oldsecurl = $uurl;
1.628 raeburn 13967: $expire_role_result =
1.652 raeburn 13968: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13969: if ($env{'request.course.sec'} ne '') {
13970: if ($expire_role_result eq 'refused') {
13971: my @roles = ('st');
13972: my @statuses = ('previous');
13973: my @roledoms = ($one);
13974: my $withsec = 1;
13975: my %roleshash =
13976: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13977: \@statuses,\@roles,\@roledoms,$withsec);
13978: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13979: my ($oldstart,$oldend) =
13980: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13981: if ($oldend > 0 && $oldend <= $now) {
13982: $expire_role_result = 'ok';
13983: }
13984: }
13985: }
13986: }
1.443 albertel 13987: $result = $expire_role_result;
13988: }
13989: }
13990: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 13991: $modify_section_result =
13992: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
13993: undef,undef,undef,$sec,
13994: $end,$start,'','',$cid,
13995: '',$context,$credits);
1.443 albertel 13996: if ($modify_section_result =~ /^ok/) {
13997: if ($secchange == 1) {
1.628 raeburn 13998: if ($sec eq '') {
13999: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14000: } else {
14001: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14002: }
1.443 albertel 14003: } elsif ($oldsec eq '-1') {
1.628 raeburn 14004: if ($sec eq '') {
14005: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14006: } else {
14007: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14008: }
1.443 albertel 14009: } else {
1.628 raeburn 14010: if ($sec eq '') {
14011: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14012: } else {
14013: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14014: }
1.443 albertel 14015: }
14016: } else {
1.628 raeburn 14017: if ($secchange) {
14018: $$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;
14019: } else {
14020: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14021: }
1.443 albertel 14022: }
14023: $result = $modify_section_result;
14024: } elsif ($secchange == 1) {
1.628 raeburn 14025: if ($oldsec eq '') {
1.1075.2.20 raeburn 14026: $$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 14027: } else {
14028: $$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;
14029: }
1.626 raeburn 14030: if ($expire_role_result eq 'refused') {
14031: my $newsecurl = '/'.$cid;
14032: $newsecurl =~ s/\_/\//g;
14033: if ($sec ne '') {
14034: $newsecurl.='/'.$sec;
14035: }
14036: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14037: if ($sec eq '') {
14038: $$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;
14039: } else {
14040: $$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;
14041: }
14042: }
14043: }
1.443 albertel 14044: }
14045: } else {
1.626 raeburn 14046: $$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 14047: $result = "error: incomplete course id\n";
14048: }
14049: return $result;
14050: }
14051:
1.1075.2.25 raeburn 14052: sub show_role_extent {
14053: my ($scope,$context,$role) = @_;
14054: $scope =~ s{^/}{};
14055: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14056: push(@courseroles,'co');
14057: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14058: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14059: $scope =~ s{/}{_};
14060: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14061: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14062: my ($audom,$auname) = split(/\//,$scope);
14063: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14064: &Apache::loncommon::plainname($auname,$audom).'</span>');
14065: } else {
14066: $scope =~ s{/$}{};
14067: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14068: &Apache::lonnet::domain($scope,'description').'</span>');
14069: }
14070: }
14071:
1.443 albertel 14072: ############################################################
14073: ############################################################
14074:
1.566 albertel 14075: sub check_clone {
1.578 raeburn 14076: my ($args,$linefeed) = @_;
1.566 albertel 14077: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14078: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14079: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14080: my $clonemsg;
14081: my $can_clone = 0;
1.944 raeburn 14082: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14083: if ($lctype ne 'community') {
14084: $lctype = 'course';
14085: }
1.566 albertel 14086: if ($clonehome eq 'no_host') {
1.944 raeburn 14087: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14088: $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'});
14089: } else {
14090: $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'});
14091: }
1.566 albertel 14092: } else {
14093: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14094: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14095: if ($clonedesc{'type'} ne 'Community') {
14096: $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'});
14097: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14098: }
14099: }
1.882 raeburn 14100: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14101: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14102: $can_clone = 1;
14103: } else {
14104: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
14105: $args->{'clonedomain'},$args->{'clonecourse'});
14106: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 14107: if (grep(/^\*$/,@cloners)) {
14108: $can_clone = 1;
14109: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14110: $can_clone = 1;
14111: } else {
1.908 raeburn 14112: my $ccrole = 'cc';
1.944 raeburn 14113: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14114: $ccrole = 'co';
14115: }
1.578 raeburn 14116: my %roleshash =
14117: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14118: $args->{'ccdomain'},
1.908 raeburn 14119: 'userroles',['active'],[$ccrole],
1.578 raeburn 14120: [$args->{'clonedomain'}]);
1.908 raeburn 14121: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 14122: $can_clone = 1;
14123: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
14124: $can_clone = 1;
14125: } else {
1.944 raeburn 14126: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14127: $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'});
14128: } else {
14129: $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'});
14130: }
1.578 raeburn 14131: }
1.566 albertel 14132: }
1.578 raeburn 14133: }
1.566 albertel 14134: }
14135: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14136: }
14137:
1.444 albertel 14138: sub construct_course {
1.1075.2.59 raeburn 14139: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14140: my $outcome;
1.541 raeburn 14141: my $linefeed = '<br />'."\n";
14142: if ($context eq 'auto') {
14143: $linefeed = "\n";
14144: }
1.566 albertel 14145:
14146: #
14147: # Are we cloning?
14148: #
14149: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14150: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14151: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14152: if ($context ne 'auto') {
1.578 raeburn 14153: if ($clonemsg ne '') {
14154: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14155: }
1.566 albertel 14156: }
14157: $outcome .= $clonemsg.$linefeed;
14158:
14159: if (!$can_clone) {
14160: return (0,$outcome);
14161: }
14162: }
14163:
1.444 albertel 14164: #
14165: # Open course
14166: #
14167: my $crstype = lc($args->{'crstype'});
14168: my %cenv=();
14169: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14170: $args->{'cdescr'},
14171: $args->{'curl'},
14172: $args->{'course_home'},
14173: $args->{'nonstandard'},
14174: $args->{'crscode'},
14175: $args->{'ccuname'}.':'.
14176: $args->{'ccdomain'},
1.882 raeburn 14177: $args->{'crstype'},
1.885 raeburn 14178: $cnum,$context,$category);
1.444 albertel 14179:
14180: # Note: The testing routines depend on this being output; see
14181: # Utils::Course. This needs to at least be output as a comment
14182: # if anyone ever decides to not show this, and Utils::Course::new
14183: # will need to be suitably modified.
1.541 raeburn 14184: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14185: if ($$courseid =~ /^error:/) {
14186: return (0,$outcome);
14187: }
14188:
1.444 albertel 14189: #
14190: # Check if created correctly
14191: #
1.479 albertel 14192: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14193: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14194: if ($crsuhome eq 'no_host') {
14195: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14196: return (0,$outcome);
14197: }
1.541 raeburn 14198: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14199:
1.444 albertel 14200: #
1.566 albertel 14201: # Do the cloning
14202: #
14203: if ($can_clone && $cloneid) {
14204: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14205: if ($context ne 'auto') {
14206: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14207: }
14208: $outcome .= $clonemsg.$linefeed;
14209: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14210: # Copy all files
1.637 www 14211: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14212: # Restore URL
1.566 albertel 14213: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14214: # Restore title
1.566 albertel 14215: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14216: # Restore creation date, creator and creation context.
14217: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14218: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14219: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14220: # Mark as cloned
1.566 albertel 14221: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14222: # Need to clone grading mode
14223: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14224: $cenv{'grading'}=$newenv{'grading'};
14225: # Do not clone these environment entries
14226: &Apache::lonnet::del('environment',
14227: ['default_enrollment_start_date',
14228: 'default_enrollment_end_date',
14229: 'question.email',
14230: 'policy.email',
14231: 'comment.email',
14232: 'pch.users.denied',
1.725 raeburn 14233: 'plc.users.denied',
14234: 'hidefromcat',
1.1075.2.36 raeburn 14235: 'checkforpriv',
1.1075.2.59 raeburn 14236: 'categories',
14237: 'internal.uniquecode'],
1.638 www 14238: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 14239: if ($args->{'textbook'}) {
14240: $cenv{'internal.textbook'} = $args->{'textbook'};
14241: }
1.444 albertel 14242: }
1.566 albertel 14243:
1.444 albertel 14244: #
14245: # Set environment (will override cloned, if existing)
14246: #
14247: my @sections = ();
14248: my @xlists = ();
14249: if ($args->{'crstype'}) {
14250: $cenv{'type'}=$args->{'crstype'};
14251: }
14252: if ($args->{'crsid'}) {
14253: $cenv{'courseid'}=$args->{'crsid'};
14254: }
14255: if ($args->{'crscode'}) {
14256: $cenv{'internal.coursecode'}=$args->{'crscode'};
14257: }
14258: if ($args->{'crsquota'} ne '') {
14259: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14260: } else {
14261: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14262: }
14263: if ($args->{'ccuname'}) {
14264: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14265: ':'.$args->{'ccdomain'};
14266: } else {
14267: $cenv{'internal.courseowner'} = $args->{'curruser'};
14268: }
1.1075.2.31 raeburn 14269: if ($args->{'defaultcredits'}) {
14270: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14271: }
1.444 albertel 14272: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14273: if ($args->{'crssections'}) {
14274: $cenv{'internal.sectionnums'} = '';
14275: if ($args->{'crssections'} =~ m/,/) {
14276: @sections = split/,/,$args->{'crssections'};
14277: } else {
14278: $sections[0] = $args->{'crssections'};
14279: }
14280: if (@sections > 0) {
14281: foreach my $item (@sections) {
14282: my ($sec,$gp) = split/:/,$item;
14283: my $class = $args->{'crscode'}.$sec;
14284: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14285: $cenv{'internal.sectionnums'} .= $item.',';
14286: unless ($addcheck eq 'ok') {
14287: push @badclasses, $class;
14288: }
14289: }
14290: $cenv{'internal.sectionnums'} =~ s/,$//;
14291: }
14292: }
14293: # do not hide course coordinator from staff listing,
14294: # even if privileged
14295: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 14296: # add course coordinator's domain to domains to check for privileged users
14297: # if different to course domain
14298: if ($$crsudom ne $args->{'ccdomain'}) {
14299: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14300: }
1.444 albertel 14301: # add crosslistings
14302: if ($args->{'crsxlist'}) {
14303: $cenv{'internal.crosslistings'}='';
14304: if ($args->{'crsxlist'} =~ m/,/) {
14305: @xlists = split/,/,$args->{'crsxlist'};
14306: } else {
14307: $xlists[0] = $args->{'crsxlist'};
14308: }
14309: if (@xlists > 0) {
14310: foreach my $item (@xlists) {
14311: my ($xl,$gp) = split/:/,$item;
14312: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14313: $cenv{'internal.crosslistings'} .= $item.',';
14314: unless ($addcheck eq 'ok') {
14315: push @badclasses, $xl;
14316: }
14317: }
14318: $cenv{'internal.crosslistings'} =~ s/,$//;
14319: }
14320: }
14321: if ($args->{'autoadds'}) {
14322: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14323: }
14324: if ($args->{'autodrops'}) {
14325: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14326: }
14327: # check for notification of enrollment changes
14328: my @notified = ();
14329: if ($args->{'notify_owner'}) {
14330: if ($args->{'ccuname'} ne '') {
14331: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14332: }
14333: }
14334: if ($args->{'notify_dc'}) {
14335: if ($uname ne '') {
1.630 raeburn 14336: push(@notified,$uname.':'.$udom);
1.444 albertel 14337: }
14338: }
14339: if (@notified > 0) {
14340: my $notifylist;
14341: if (@notified > 1) {
14342: $notifylist = join(',',@notified);
14343: } else {
14344: $notifylist = $notified[0];
14345: }
14346: $cenv{'internal.notifylist'} = $notifylist;
14347: }
14348: if (@badclasses > 0) {
14349: my %lt=&Apache::lonlocal::texthash(
14350: 'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',
14351: 'dnhr' => 'does not have rights to access enrollment in these classes',
14352: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14353: );
1.541 raeburn 14354: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14355: ' ('.$lt{'adby'}.')';
14356: if ($context eq 'auto') {
14357: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14358: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14359: foreach my $item (@badclasses) {
14360: if ($context eq 'auto') {
14361: $outcome .= " - $item\n";
14362: } else {
14363: $outcome .= "<li>$item</li>\n";
14364: }
14365: }
14366: if ($context eq 'auto') {
14367: $outcome .= $linefeed;
14368: } else {
1.566 albertel 14369: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14370: }
14371: }
1.444 albertel 14372: }
14373: if ($args->{'no_end_date'}) {
14374: $args->{'endaccess'} = 0;
14375: }
14376: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14377: $cenv{'internal.autoend'}=$args->{'enrollend'};
14378: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14379: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14380: if ($args->{'showphotos'}) {
14381: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14382: }
14383: $cenv{'internal.authtype'} = $args->{'authtype'};
14384: $cenv{'internal.autharg'} = $args->{'autharg'};
14385: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14386: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14387: 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');
14388: if ($context eq 'auto') {
14389: $outcome .= $krb_msg;
14390: } else {
1.566 albertel 14391: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14392: }
14393: $outcome .= $linefeed;
1.444 albertel 14394: }
14395: }
14396: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14397: if ($args->{'setpolicy'}) {
14398: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14399: }
14400: if ($args->{'setcontent'}) {
14401: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14402: }
14403: }
14404: if ($args->{'reshome'}) {
14405: $cenv{'reshome'}=$args->{'reshome'}.'/';
14406: $cenv{'reshome'}=~s/\/+$/\//;
14407: }
14408: #
14409: # course has keyed access
14410: #
14411: if ($args->{'setkeys'}) {
14412: $cenv{'keyaccess'}='yes';
14413: }
14414: # if specified, key authority is not course, but user
14415: # only active if keyaccess is yes
14416: if ($args->{'keyauth'}) {
1.487 albertel 14417: my ($user,$domain) = split(':',$args->{'keyauth'});
14418: $user = &LONCAPA::clean_username($user);
14419: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14420: if ($user ne '' && $domain ne '') {
1.487 albertel 14421: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14422: }
14423: }
14424:
1.1075.2.59 raeburn 14425: #
14426: # generate and store uniquecode (available to course requester), if course should have one.
14427: #
14428: if ($args->{'uniquecode'}) {
14429: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14430: if ($code) {
14431: $cenv{'internal.uniquecode'} = $code;
14432: my %crsinfo =
14433: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14434: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14435: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14436: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14437: }
14438: if (ref($coderef)) {
14439: $$coderef = $code;
14440: }
14441: }
14442: }
14443:
1.444 albertel 14444: if ($args->{'disresdis'}) {
14445: $cenv{'pch.roles.denied'}='st';
14446: }
14447: if ($args->{'disablechat'}) {
14448: $cenv{'plc.roles.denied'}='st';
14449: }
14450:
14451: # Record we've not yet viewed the Course Initialization Helper for this
14452: # course
14453: $cenv{'course.helper.not.run'} = 1;
14454: #
14455: # Use new Randomseed
14456: #
14457: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14458: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14459: #
14460: # The encryption code and receipt prefix for this course
14461: #
14462: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14463: $cenv{'internal.encpref'}=100+int(9*rand(99));
14464: #
14465: # By default, use standard grading
14466: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14467:
1.541 raeburn 14468: $outcome .= $linefeed.&mt('Setting environment').': '.
14469: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14470: #
14471: # Open all assignments
14472: #
14473: if ($args->{'openall'}) {
14474: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14475: my %storecontent = ($storeunder => time,
14476: $storeunder.'.type' => 'date_start');
14477:
14478: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14479: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14480: }
14481: #
14482: # Set first page
14483: #
14484: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14485: || ($cloneid)) {
1.445 albertel 14486: use LONCAPA::map;
1.444 albertel 14487: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14488:
14489: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14490: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14491:
1.444 albertel 14492: $outcome .= ($fatal?$errtext:'read ok').' - ';
14493: my $title; my $url;
14494: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14495: $title=&mt('Syllabus');
1.444 albertel 14496: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14497: } else {
1.963 raeburn 14498: $title=&mt('Table of Contents');
1.444 albertel 14499: $url='/adm/navmaps';
14500: }
1.445 albertel 14501:
14502: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14503: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14504:
14505: if ($errtext) { $fatal=2; }
1.541 raeburn 14506: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14507: }
1.566 albertel 14508:
14509: return (1,$outcome);
1.444 albertel 14510: }
14511:
1.1075.2.59 raeburn 14512: sub make_unique_code {
14513: my ($cdom,$cnum) = @_;
14514: # get lock on uniquecodes db
14515: my $lockhash = {
14516: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14517: ':'.$env{'user.domain'},
14518: };
14519: my $tries = 0;
14520: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14521: my ($code,$error);
14522:
14523: while (($gotlock ne 'ok') && ($tries<3)) {
14524: $tries ++;
14525: sleep 1;
14526: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14527: }
14528: if ($gotlock eq 'ok') {
14529: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14530: my $gotcode;
14531: my $attempts = 0;
14532: while ((!$gotcode) && ($attempts < 100)) {
14533: $code = &generate_code();
14534: if (!exists($currcodes{$code})) {
14535: $gotcode = 1;
14536: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14537: $error = 'nostore';
14538: }
14539: }
14540: $attempts ++;
14541: }
14542: my @del_lock = ($cnum."\0".'uniquecodes');
14543: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14544: } else {
14545: $error = 'nolock';
14546: }
14547: return ($code,$error);
14548: }
14549:
14550: sub generate_code {
14551: my $code;
14552: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14553: for (my $i=0; $i<6; $i++) {
14554: my $lettnum = int (rand 2);
14555: my $item = '';
14556: if ($lettnum) {
14557: $item = $letts[int( rand(18) )];
14558: } else {
14559: $item = 1+int( rand(8) );
14560: }
14561: $code .= $item;
14562: }
14563: return $code;
14564: }
14565:
1.444 albertel 14566: ############################################################
14567: ############################################################
14568:
1.953 droeschl 14569: #SD
14570: # only Community and Course, or anything else?
1.378 raeburn 14571: sub course_type {
14572: my ($cid) = @_;
14573: if (!defined($cid)) {
14574: $cid = $env{'request.course.id'};
14575: }
1.404 albertel 14576: if (defined($env{'course.'.$cid.'.type'})) {
14577: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14578: } else {
14579: return 'Course';
1.377 raeburn 14580: }
14581: }
1.156 albertel 14582:
1.406 raeburn 14583: sub group_term {
14584: my $crstype = &course_type();
14585: my %names = (
14586: 'Course' => 'group',
1.865 raeburn 14587: 'Community' => 'group',
1.406 raeburn 14588: );
14589: return $names{$crstype};
14590: }
14591:
1.902 raeburn 14592: sub course_types {
1.1075.2.59 raeburn 14593: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14594: my %typename = (
14595: official => 'Official course',
14596: unofficial => 'Unofficial course',
14597: community => 'Community',
1.1075.2.59 raeburn 14598: textbook => 'Textbook course',
1.902 raeburn 14599: );
14600: return (\@types,\%typename);
14601: }
14602:
1.156 albertel 14603: sub icon {
14604: my ($file)=@_;
1.505 albertel 14605: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14606: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14607: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14608: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14609: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14610: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14611: $curfext.".gif") {
14612: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14613: $curfext.".gif";
14614: }
14615: }
1.249 albertel 14616: return &lonhttpdurl($iconname);
1.154 albertel 14617: }
1.84 albertel 14618:
1.575 albertel 14619: sub lonhttpdurl {
1.692 www 14620: #
14621: # Had been used for "small fry" static images on separate port 8080.
14622: # Modify here if lightweight http functionality desired again.
14623: # Currently eliminated due to increasing firewall issues.
14624: #
1.575 albertel 14625: my ($url)=@_;
1.692 www 14626: return $url;
1.215 albertel 14627: }
14628:
1.213 albertel 14629: sub connection_aborted {
14630: my ($r)=@_;
14631: $r->print(" ");$r->rflush();
14632: my $c = $r->connection;
14633: return $c->aborted();
14634: }
14635:
1.221 foxr 14636: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14637: # strings as 'strings'.
14638: sub escape_single {
1.221 foxr 14639: my ($input) = @_;
1.223 albertel 14640: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14641: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14642: return $input;
14643: }
1.223 albertel 14644:
1.222 foxr 14645: # Same as escape_single, but escape's "'s This
14646: # can be used for "strings"
14647: sub escape_double {
14648: my ($input) = @_;
14649: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14650: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14651: return $input;
14652: }
1.223 albertel 14653:
1.222 foxr 14654: # Escapes the last element of a full URL.
14655: sub escape_url {
14656: my ($url) = @_;
1.238 raeburn 14657: my @urlslices = split(/\//, $url,-1);
1.369 www 14658: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 14659: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 14660: }
1.462 albertel 14661:
1.820 raeburn 14662: sub compare_arrays {
14663: my ($arrayref1,$arrayref2) = @_;
14664: my (@difference,%count);
14665: @difference = ();
14666: %count = ();
14667: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14668: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14669: foreach my $element (keys(%count)) {
14670: if ($count{$element} == 1) {
14671: push(@difference,$element);
14672: }
14673: }
14674: }
14675: return @difference;
14676: }
14677:
1.817 bisitz 14678: # -------------------------------------------------------- Initialize user login
1.462 albertel 14679: sub init_user_environment {
1.463 albertel 14680: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14681: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14682:
14683: my $public=($username eq 'public' && $domain eq 'public');
14684:
14685: # See if old ID present, if so, remove
14686:
1.1062 raeburn 14687: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14688: my $now=time;
14689:
14690: if ($public) {
14691: my $max_public=100;
14692: my $oldest;
14693: my $oldest_time=0;
14694: for(my $next=1;$next<=$max_public;$next++) {
14695: if (-e $lonids."/publicuser_$next.id") {
14696: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14697: if ($mtime<$oldest_time || !$oldest_time) {
14698: $oldest_time=$mtime;
14699: $oldest=$next;
14700: }
14701: } else {
14702: $cookie="publicuser_$next";
14703: last;
14704: }
14705: }
14706: if (!$cookie) { $cookie="publicuser_$oldest"; }
14707: } else {
1.463 albertel 14708: # if this isn't a robot, kill any existing non-robot sessions
14709: if (!$args->{'robot'}) {
14710: opendir(DIR,$lonids);
14711: while ($filename=readdir(DIR)) {
14712: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14713: unlink($lonids.'/'.$filename);
14714: }
1.462 albertel 14715: }
1.463 albertel 14716: closedir(DIR);
1.1075.2.84 raeburn 14717: # If there is a undeleted lockfile for the user's paste buffer remove it.
14718: my $namespace = 'nohist_courseeditor';
14719: my $lockingkey = 'paste'."\0".'locked_num';
14720: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
14721: $domain,$username);
14722: if (exists($lockhash{$lockingkey})) {
14723: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
14724: unless ($delresult eq 'ok') {
14725: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
14726: }
14727: }
1.462 albertel 14728: }
14729: # Give them a new cookie
1.463 albertel 14730: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14731: : $now.$$.int(rand(10000)));
1.463 albertel 14732: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14733:
14734: # Initialize roles
14735:
1.1062 raeburn 14736: ($userroles,$firstaccenv,$timerintenv) =
14737: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14738: }
14739: # ------------------------------------ Check browser type and MathML capability
14740:
1.1075.2.77 raeburn 14741: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14742: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14743:
14744: # ------------------------------------------------------------- Get environment
14745:
14746: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14747: my ($tmp) = keys(%userenv);
14748: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14749: } else {
14750: undef(%userenv);
14751: }
14752: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14753: $form->{'interface'}=$userenv{'interface'};
14754: }
14755: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14756:
14757: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14758: foreach my $option ('interface','localpath','localres') {
14759: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14760: }
14761: # --------------------------------------------------------- Write first profile
14762:
14763: {
14764: my %initial_env =
14765: ("user.name" => $username,
14766: "user.domain" => $domain,
14767: "user.home" => $authhost,
14768: "browser.type" => $clientbrowser,
14769: "browser.version" => $clientversion,
14770: "browser.mathml" => $clientmathml,
14771: "browser.unicode" => $clientunicode,
14772: "browser.os" => $clientos,
1.1075.2.42 raeburn 14773: "browser.mobile" => $clientmobile,
14774: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 14775: "browser.osversion" => $clientosversion,
1.462 albertel 14776: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14777: "request.course.fn" => '',
14778: "request.course.uri" => '',
14779: "request.course.sec" => '',
14780: "request.role" => 'cm',
14781: "request.role.adv" => $env{'user.adv'},
14782: "request.host" => $ENV{'REMOTE_ADDR'},);
14783:
14784: if ($form->{'localpath'}) {
14785: $initial_env{"browser.localpath"} = $form->{'localpath'};
14786: $initial_env{"browser.localres"} = $form->{'localres'};
14787: }
14788:
14789: if ($form->{'interface'}) {
14790: $form->{'interface'}=~s/\W//gs;
14791: $initial_env{"browser.interface"} = $form->{'interface'};
14792: $env{'browser.interface'}=$form->{'interface'};
14793: }
14794:
1.1075.2.54 raeburn 14795: if ($form->{'iptoken'}) {
14796: my $lonhost = $r->dir_config('lonHostID');
14797: $initial_env{"user.noloadbalance"} = $lonhost;
14798: $env{'user.noloadbalance'} = $lonhost;
14799: }
14800:
1.981 raeburn 14801: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14802: my %domdef;
14803: unless ($domain eq 'public') {
14804: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14805: }
1.980 raeburn 14806:
1.1075.2.7 raeburn 14807: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14808: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14809: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14810: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14811: }
14812:
1.1075.2.59 raeburn 14813: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14814: $userenv{'canrequest.'.$crstype} =
14815: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14816: 'reload','requestcourses',
14817: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14818: }
14819:
1.1075.2.14 raeburn 14820: $userenv{'canrequest.author'} =
14821: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14822: 'reload','requestauthor',
14823: \%userenv,\%domdef,\%is_adv);
14824: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14825: $domain,$username);
14826: my $reqstatus = $reqauthor{'author_status'};
14827: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14828: if (ref($reqauthor{'author'}) eq 'HASH') {
14829: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14830: $reqauthor{'author'}{'timestamp'};
14831: }
14832: }
14833:
1.462 albertel 14834: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14835:
1.462 albertel 14836: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14837: &GDBM_WRCREAT(),0640)) {
14838: &_add_to_env(\%disk_env,\%initial_env);
14839: &_add_to_env(\%disk_env,\%userenv,'environment.');
14840: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14841: if (ref($firstaccenv) eq 'HASH') {
14842: &_add_to_env(\%disk_env,$firstaccenv);
14843: }
14844: if (ref($timerintenv) eq 'HASH') {
14845: &_add_to_env(\%disk_env,$timerintenv);
14846: }
1.463 albertel 14847: if (ref($args->{'extra_env'})) {
14848: &_add_to_env(\%disk_env,$args->{'extra_env'});
14849: }
1.462 albertel 14850: untie(%disk_env);
14851: } else {
1.705 tempelho 14852: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14853: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14854: return 'error: '.$!;
14855: }
14856: }
14857: $env{'request.role'}='cm';
14858: $env{'request.role.adv'}=$env{'user.adv'};
14859: $env{'browser.type'}=$clientbrowser;
14860:
14861: return $cookie;
14862:
14863: }
14864:
14865: sub _add_to_env {
14866: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14867: if (ref($env_data) eq 'HASH') {
14868: while (my ($key,$value) = each(%$env_data)) {
14869: $idf->{$prefix.$key} = $value;
14870: $env{$prefix.$key} = $value;
14871: }
1.462 albertel 14872: }
14873: }
14874:
1.685 tempelho 14875: # --- Get the symbolic name of a problem and the url
14876: sub get_symb {
14877: my ($request,$silent) = @_;
1.726 raeburn 14878: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14879: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14880: if ($symb eq '') {
14881: if (!$silent) {
1.1071 raeburn 14882: if (ref($request)) {
14883: $request->print("Unable to handle ambiguous references:$url:.");
14884: }
1.685 tempelho 14885: return ();
14886: }
14887: }
14888: &Apache::lonenc::check_decrypt(\$symb);
14889: return ($symb);
14890: }
14891:
14892: # --------------------------------------------------------------Get annotation
14893:
14894: sub get_annotation {
14895: my ($symb,$enc) = @_;
14896:
14897: my $key = $symb;
14898: if (!$enc) {
14899: $key =
14900: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14901: }
14902: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14903: return $annotation{$key};
14904: }
14905:
14906: sub clean_symb {
1.731 raeburn 14907: my ($symb,$delete_enc) = @_;
1.685 tempelho 14908:
14909: &Apache::lonenc::check_decrypt(\$symb);
14910: my $enc = $env{'request.enc'};
1.731 raeburn 14911: if ($delete_enc) {
1.730 raeburn 14912: delete($env{'request.enc'});
14913: }
1.685 tempelho 14914:
14915: return ($symb,$enc);
14916: }
1.462 albertel 14917:
1.1075.2.69 raeburn 14918: ############################################################
14919: ############################################################
14920:
14921: =pod
14922:
14923: =head1 Routines for building display used to search for courses
14924:
14925:
14926: =over 4
14927:
14928: =item * &build_filters()
14929:
14930: Create markup for a table used to set filters to use when selecting
14931: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
14932: and quotacheck.pl
14933:
14934:
14935: Inputs:
14936:
14937: filterlist - anonymous array of fields to include as potential filters
14938:
14939: crstype - course type
14940:
14941: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
14942: to pop-open a course selector (will contain "extra element").
14943:
14944: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
14945:
14946: filter - anonymous hash of criteria and their values
14947:
14948: action - form action
14949:
14950: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
14951:
14952: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
14953:
14954: cloneruname - username of owner of new course who wants to clone
14955:
14956: clonerudom - domain of owner of new course who wants to clone
14957:
14958: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
14959:
14960: codetitlesref - reference to array of titles of components in institutional codes (official courses)
14961:
14962: codedom - domain
14963:
14964: formname - value of form element named "form".
14965:
14966: fixeddom - domain, if fixed.
14967:
14968: prevphase - value to assign to form element named "phase" when going back to the previous screen
14969:
14970: cnameelement - name of form element in form on opener page which will receive title of selected course
14971:
14972: cnumelement - name of form element in form on opener page which will receive courseID of selected course
14973:
14974: cdomelement - name of form element in form on opener page which will receive domain of selected course
14975:
14976: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
14977:
14978: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
14979:
14980: clonewarning - warning message about missing information for intended course owner when DC creates a course
14981:
14982:
14983: Returns: $output - HTML for display of search criteria, and hidden form elements.
14984:
14985:
14986: Side Effects: None
14987:
14988: =cut
14989:
14990: # ---------------------------------------------- search for courses based on last activity etc.
14991:
14992: sub build_filters {
14993: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
14994: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
14995: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
14996: $cnameelement,$cnumelement,$cdomelement,$setroles,
14997: $clonetext,$clonewarning) = @_;
14998: my ($list,$jscript);
14999: my $onchange = 'javascript:updateFilters(this)';
15000: my ($domainselectform,$sincefilterform,$createdfilterform,
15001: $ownerdomselectform,$persondomselectform,$instcodeform,
15002: $typeselectform,$instcodetitle);
15003: if ($formname eq '') {
15004: $formname = $caller;
15005: }
15006: foreach my $item (@{$filterlist}) {
15007: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
15008: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
15009: if ($item eq 'domainfilter') {
15010: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
15011: } elsif ($item eq 'coursefilter') {
15012: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
15013: } elsif ($item eq 'ownerfilter') {
15014: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15015: } elsif ($item eq 'ownerdomfilter') {
15016: $filter->{'ownerdomfilter'} =
15017: &LONCAPA::clean_domain($filter->{$item});
15018: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
15019: 'ownerdomfilter',1);
15020: } elsif ($item eq 'personfilter') {
15021: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15022: } elsif ($item eq 'persondomfilter') {
15023: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15024: 'persondomfilter',1);
15025: } else {
15026: $filter->{$item} =~ s/\W//g;
15027: }
15028: if (!$filter->{$item}) {
15029: $filter->{$item} = '';
15030: }
15031: }
15032: if ($item eq 'domainfilter') {
15033: my $allow_blank = 1;
15034: if ($formname eq 'portform') {
15035: $allow_blank=0;
15036: } elsif ($formname eq 'studentform') {
15037: $allow_blank=0;
15038: }
15039: if ($fixeddom) {
15040: $domainselectform = '<input type="hidden" name="domainfilter"'.
15041: ' value="'.$codedom.'" />'.
15042: &Apache::lonnet::domain($codedom,'description');
15043: } else {
15044: $domainselectform = &select_dom_form($filter->{$item},
15045: 'domainfilter',
15046: $allow_blank,'',$onchange);
15047: }
15048: } else {
15049: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15050: }
15051: }
15052:
15053: # last course activity filter and selection
15054: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15055:
15056: # course created filter and selection
15057: if (exists($filter->{'createdfilter'})) {
15058: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15059: }
15060:
15061: my %lt = &Apache::lonlocal::texthash(
15062: 'cac' => "$crstype Activity",
15063: 'ccr' => "$crstype Created",
15064: 'cde' => "$crstype Title",
15065: 'cdo' => "$crstype Domain",
15066: 'ins' => 'Institutional Code',
15067: 'inc' => 'Institutional Categorization',
15068: 'cow' => "$crstype Owner/Co-owner",
15069: 'cop' => "$crstype Personnel Includes",
15070: 'cog' => 'Type',
15071: );
15072:
15073: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15074: my $typeval = 'Course';
15075: if ($crstype eq 'Community') {
15076: $typeval = 'Community';
15077: }
15078: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15079: } else {
15080: $typeselectform = '<select name="type" size="1"';
15081: if ($onchange) {
15082: $typeselectform .= ' onchange="'.$onchange.'"';
15083: }
15084: $typeselectform .= '>'."\n";
15085: foreach my $posstype ('Course','Community') {
15086: $typeselectform.='<option value="'.$posstype.'"'.
15087: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
15088: }
15089: $typeselectform.="</select>";
15090: }
15091:
15092: my ($cloneableonlyform,$cloneabletitle);
15093: if (exists($filter->{'cloneableonly'})) {
15094: my $cloneableon = '';
15095: my $cloneableoff = ' checked="checked"';
15096: if ($filter->{'cloneableonly'}) {
15097: $cloneableon = $cloneableoff;
15098: $cloneableoff = '';
15099: }
15100: $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>';
15101: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 15102: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 15103: } else {
15104: $cloneabletitle = &mt('Cloneable by you');
15105: }
15106: }
15107: my $officialjs;
15108: if ($crstype eq 'Course') {
15109: if (exists($filter->{'instcodefilter'})) {
15110: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15111: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15112: if ($codedom) {
15113: $officialjs = 1;
15114: ($instcodeform,$jscript,$$numtitlesref) =
15115: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15116: $officialjs,$codetitlesref);
15117: if ($jscript) {
15118: $jscript = '<script type="text/javascript">'."\n".
15119: '// <![CDATA['."\n".
15120: $jscript."\n".
15121: '// ]]>'."\n".
15122: '</script>'."\n";
15123: }
15124: }
15125: if ($instcodeform eq '') {
15126: $instcodeform =
15127: '<input type="text" name="instcodefilter" size="10" value="'.
15128: $list->{'instcodefilter'}.'" />';
15129: $instcodetitle = $lt{'ins'};
15130: } else {
15131: $instcodetitle = $lt{'inc'};
15132: }
15133: if ($fixeddom) {
15134: $instcodetitle .= '<br />('.$codedom.')';
15135: }
15136: }
15137: }
15138: my $output = qq|
15139: <form method="post" name="filterpicker" action="$action">
15140: <input type="hidden" name="form" value="$formname" />
15141: |;
15142: if ($formname eq 'modifycourse') {
15143: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15144: '<input type="hidden" name="prevphase" value="'.
15145: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 15146: } elsif ($formname eq 'quotacheck') {
15147: $output .= qq|
15148: <input type="hidden" name="sortby" value="" />
15149: <input type="hidden" name="sortorder" value="" />
15150: |;
15151: } else {
1.1075.2.69 raeburn 15152: my $name_input;
15153: if ($cnameelement ne '') {
15154: $name_input = '<input type="hidden" name="cnameelement" value="'.
15155: $cnameelement.'" />';
15156: }
15157: $output .= qq|
15158: <input type="hidden" name="cnumelement" value="$cnumelement" />
15159: <input type="hidden" name="cdomelement" value="$cdomelement" />
15160: $name_input
15161: $roleelement
15162: $multelement
15163: $typeelement
15164: |;
15165: if ($formname eq 'portform') {
15166: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15167: }
15168: }
15169: if ($fixeddom) {
15170: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15171: }
15172: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15173: if ($sincefilterform) {
15174: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15175: .$sincefilterform
15176: .&Apache::lonhtmlcommon::row_closure();
15177: }
15178: if ($createdfilterform) {
15179: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15180: .$createdfilterform
15181: .&Apache::lonhtmlcommon::row_closure();
15182: }
15183: if ($domainselectform) {
15184: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15185: .$domainselectform
15186: .&Apache::lonhtmlcommon::row_closure();
15187: }
15188: if ($typeselectform) {
15189: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15190: $output .= $typeselectform;
15191: } else {
15192: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15193: .$typeselectform
15194: .&Apache::lonhtmlcommon::row_closure();
15195: }
15196: }
15197: if ($instcodeform) {
15198: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15199: .$instcodeform
15200: .&Apache::lonhtmlcommon::row_closure();
15201: }
15202: if (exists($filter->{'ownerfilter'})) {
15203: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15204: '<table><tr><td>'.&mt('Username').'<br />'.
15205: '<input type="text" name="ownerfilter" size="20" value="'.
15206: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15207: $ownerdomselectform.'</td></tr></table>'.
15208: &Apache::lonhtmlcommon::row_closure();
15209: }
15210: if (exists($filter->{'personfilter'})) {
15211: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15212: '<table><tr><td>'.&mt('Username').'<br />'.
15213: '<input type="text" name="personfilter" size="20" value="'.
15214: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15215: $persondomselectform.'</td></tr></table>'.
15216: &Apache::lonhtmlcommon::row_closure();
15217: }
15218: if (exists($filter->{'coursefilter'})) {
15219: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15220: .'<input type="text" name="coursefilter" size="25" value="'
15221: .$list->{'coursefilter'}.'" />'
15222: .&Apache::lonhtmlcommon::row_closure();
15223: }
15224: if ($cloneableonlyform) {
15225: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15226: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15227: }
15228: if (exists($filter->{'descriptfilter'})) {
15229: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15230: .'<input type="text" name="descriptfilter" size="40" value="'
15231: .$list->{'descriptfilter'}.'" />'
15232: .&Apache::lonhtmlcommon::row_closure(1);
15233: }
15234: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15235: '<input type="hidden" name="updater" value="" />'."\n".
15236: '<input type="submit" name="gosearch" value="'.
15237: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15238: return $jscript.$clonewarning.$output;
15239: }
15240:
15241: =pod
15242:
15243: =item * &timebased_select_form()
15244:
15245: Create markup for a dropdown list used to select a time-based
15246: filter e.g., Course Activity, Course Created, when searching for courses
15247: or communities
15248:
15249: Inputs:
15250:
15251: item - name of form element (sincefilter or createdfilter)
15252:
15253: filter - anonymous hash of criteria and their values
15254:
15255: Returns: HTML for a select box contained a blank, then six time selections,
15256: with value set in incoming form variables currently selected.
15257:
15258: Side Effects: None
15259:
15260: =cut
15261:
15262: sub timebased_select_form {
15263: my ($item,$filter) = @_;
15264: if (ref($filter) eq 'HASH') {
15265: $filter->{$item} =~ s/[^\d-]//g;
15266: if (!$filter->{$item}) { $filter->{$item}=-1; }
15267: return &select_form(
15268: $filter->{$item},
15269: $item,
15270: { '-1' => '',
15271: '86400' => &mt('today'),
15272: '604800' => &mt('last week'),
15273: '2592000' => &mt('last month'),
15274: '7776000' => &mt('last three months'),
15275: '15552000' => &mt('last six months'),
15276: '31104000' => &mt('last year'),
15277: 'select_form_order' =>
15278: ['-1','86400','604800','2592000','7776000',
15279: '15552000','31104000']});
15280: }
15281: }
15282:
15283: =pod
15284:
15285: =item * &js_changer()
15286:
15287: Create script tag containing Javascript used to submit course search form
15288: when course type or domain is changed, and also to hide 'Searching ...' on
15289: page load completion for page showing search result.
15290:
15291: Inputs: None
15292:
15293: Returns: markup containing updateFilters() and hideSearching() javascript functions.
15294:
15295: Side Effects: None
15296:
15297: =cut
15298:
15299: sub js_changer {
15300: return <<ENDJS;
15301: <script type="text/javascript">
15302: // <![CDATA[
15303: function updateFilters(caller) {
15304: if (typeof(caller) != "undefined") {
15305: document.filterpicker.updater.value = caller.name;
15306: }
15307: document.filterpicker.submit();
15308: }
15309:
15310: function hideSearching() {
15311: if (document.getElementById('searching')) {
15312: document.getElementById('searching').style.display = 'none';
15313: }
15314: return;
15315: }
15316:
15317: // ]]>
15318: </script>
15319:
15320: ENDJS
15321: }
15322:
15323: =pod
15324:
15325: =item * &search_courses()
15326:
15327: Process selected filters form course search form and pass to lonnet::courseiddump
15328: to retrieve a hash for which keys are courseIDs which match the selected filters.
15329:
15330: Inputs:
15331:
15332: dom - domain being searched
15333:
15334: type - course type ('Course' or 'Community' or '.' if any).
15335:
15336: filter - anonymous hash of criteria and their values
15337:
15338: numtitles - for institutional codes - number of categories
15339:
15340: cloneruname - optional username of new course owner
15341:
15342: clonerudom - optional domain of new course owner
15343:
15344: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
15345: (used when DC is using course creation form)
15346:
15347: codetitles - reference to array of titles of components in institutional codes (official courses).
15348:
15349:
15350: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15351:
15352:
15353: Side Effects: None
15354:
15355: =cut
15356:
15357:
15358: sub search_courses {
15359: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
15360: my (%courses,%showcourses,$cloner);
15361: if (($filter->{'ownerfilter'} ne '') ||
15362: ($filter->{'ownerdomfilter'} ne '')) {
15363: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15364: $filter->{'ownerdomfilter'};
15365: }
15366: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15367: if (!$filter->{$item}) {
15368: $filter->{$item}='.';
15369: }
15370: }
15371: my $now = time;
15372: my $timefilter =
15373: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15374: my ($createdbefore,$createdafter);
15375: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15376: $createdbefore = $now;
15377: $createdafter = $now-$filter->{'createdfilter'};
15378: }
15379: my ($instcodefilter,$regexpok);
15380: if ($numtitles) {
15381: if ($env{'form.official'} eq 'on') {
15382: $instcodefilter =
15383: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15384: $regexpok = 1;
15385: } elsif ($env{'form.official'} eq 'off') {
15386: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15387: unless ($instcodefilter eq '') {
15388: $regexpok = -1;
15389: }
15390: }
15391: } else {
15392: $instcodefilter = $filter->{'instcodefilter'};
15393: }
15394: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15395: if ($type eq '') { $type = '.'; }
15396:
15397: if (($clonerudom ne '') && ($cloneruname ne '')) {
15398: $cloner = $cloneruname.':'.$clonerudom;
15399: }
15400: %courses = &Apache::lonnet::courseiddump($dom,
15401: $filter->{'descriptfilter'},
15402: $timefilter,
15403: $instcodefilter,
15404: $filter->{'combownerfilter'},
15405: $filter->{'coursefilter'},
15406: undef,undef,$type,$regexpok,undef,undef,
15407: undef,undef,$cloner,$env{'form.cc_clone'},
15408: $filter->{'cloneableonly'},
15409: $createdbefore,$createdafter,undef,
15410: $domcloner);
15411: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15412: my $ccrole;
15413: if ($type eq 'Community') {
15414: $ccrole = 'co';
15415: } else {
15416: $ccrole = 'cc';
15417: }
15418: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15419: $filter->{'persondomfilter'},
15420: 'userroles',undef,
15421: [$ccrole,'in','ad','ep','ta','cr'],
15422: $dom);
15423: foreach my $role (keys(%rolehash)) {
15424: my ($cnum,$cdom,$courserole) = split(':',$role);
15425: my $cid = $cdom.'_'.$cnum;
15426: if (exists($courses{$cid})) {
15427: if (ref($courses{$cid}) eq 'HASH') {
15428: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15429: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15430: push (@{$courses{$cid}{roles}},$courserole);
15431: }
15432: } else {
15433: $courses{$cid}{roles} = [$courserole];
15434: }
15435: $showcourses{$cid} = $courses{$cid};
15436: }
15437: }
15438: }
15439: %courses = %showcourses;
15440: }
15441: return %courses;
15442: }
15443:
15444: =pod
15445:
15446: =back
15447:
1.1075.2.88 raeburn 15448: =head1 Routines for version requirements for current course.
15449:
15450: =over 4
15451:
15452: =item * &check_release_required()
15453:
15454: Compares required LON-CAPA version with version on server, and
15455: if required version is newer looks for a server with the required version.
15456:
15457: Looks first at servers in user's owen domain; if none suitable, looks at
15458: servers in course's domain are permitted to host sessions for user's domain.
15459:
15460: Inputs:
15461:
15462: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15463:
15464: $courseid - Course ID of current course
15465:
15466: $rolecode - User's current role in course (for switchserver query string).
15467:
15468: $required - LON-CAPA version needed by course (format: Major.Minor).
15469:
15470:
15471: Returns:
15472:
15473: $switchserver - query string tp append to /adm/switchserver call (if
15474: current server's LON-CAPA version is too old.
15475:
15476: $warning - Message is displayed if no suitable server could be found.
15477:
15478: =cut
15479:
15480: sub check_release_required {
15481: my ($loncaparev,$courseid,$rolecode,$required) = @_;
15482: my ($switchserver,$warning);
15483: if ($required ne '') {
15484: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
15485: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15486: if ($reqdmajor ne '' && $reqdminor ne '') {
15487: my $otherserver;
15488: if (($major eq '' && $minor eq '') ||
15489: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
15490: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
15491: my $switchlcrev =
15492: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
15493: $userdomserver);
15494: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15495: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
15496: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
15497: my $cdom = $env{'course.'.$courseid.'.domain'};
15498: if ($cdom ne $env{'user.domain'}) {
15499: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
15500: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
15501: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15502: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
15503: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
15504: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
15505: my $canhost =
15506: &Apache::lonnet::can_host_session($env{'user.domain'},
15507: $coursedomserver,
15508: $remoterev,
15509: $udomdefaults{'remotesessions'},
15510: $defdomdefaults{'hostedsessions'});
15511:
15512: if ($canhost) {
15513: $otherserver = $coursedomserver;
15514: } else {
15515: $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.");
15516: }
15517: } else {
15518: $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).");
15519: }
15520: } else {
15521: $otherserver = $userdomserver;
15522: }
15523: }
15524: if ($otherserver ne '') {
15525: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
15526: }
15527: }
15528: }
15529: return ($switchserver,$warning);
15530: }
15531:
15532: =pod
15533:
15534: =item * &check_release_result()
15535:
15536: Inputs:
15537:
15538: $switchwarning - Warning message if no suitable server found to host session.
15539:
15540: $switchserver - query string to append to /adm/switchserver containing lonHostID
15541: and current role.
15542:
15543: Returns: HTML to display with information about requirement to switch server.
15544: Either displaying warning with link to Roles/Courses screen or
15545: display link to switchserver.
15546:
1.1075.2.69 raeburn 15547: =cut
15548:
1.1075.2.88 raeburn 15549: sub check_release_result {
15550: my ($switchwarning,$switchserver) = @_;
15551: my $output = &start_page('Selected course unavailable on this server').
15552: '<p class="LC_warning">';
15553: if ($switchwarning) {
15554: $output .= $switchwarning.'<br /><a href="/adm/roles">';
15555: if (&show_course()) {
15556: $output .= &mt('Display courses');
15557: } else {
15558: $output .= &mt('Display roles');
15559: }
15560: $output .= '</a>';
15561: } elsif ($switchserver) {
15562: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
15563: '<br />'.
15564: '<a href="/adm/switchserver?'.$switchserver.'">'.
15565: &mt('Switch Server').
15566: '</a>';
15567: }
15568: $output .= '</p>'.&end_page();
15569: return $output;
15570: }
15571:
15572: =pod
15573:
15574: =item * &needs_coursereinit()
15575:
15576: Determine if course contents stored for user's session needs to be
15577: refreshed, because content has changed since "Big Hash" last tied.
15578:
15579: Check for change is made if time last checked is more than 10 minutes ago
15580: (by default).
15581:
15582: Inputs:
15583:
15584: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15585:
15586: $interval (optional) - Time which may elapse (in s) between last check for content
15587: change in current course. (default: 600 s).
15588:
15589: Returns: an array; first element is:
15590:
15591: =over 4
15592:
15593: 'switch' - if content updates mean user's session
15594: needs to be switched to a server running a newer LON-CAPA version
15595:
15596: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
15597: on current server hosting user's session
15598:
15599: '' - if no action required.
15600:
15601: =back
15602:
15603: If first item element is 'switch':
15604:
15605: second item is $switchwarning - Warning message if no suitable server found to host session.
15606:
15607: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
15608: and current role.
15609:
15610: otherwise: no other elements returned.
15611:
15612: =back
15613:
15614: =cut
15615:
15616: sub needs_coursereinit {
15617: my ($loncaparev,$interval) = @_;
15618: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
15619: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
15620: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
15621: my $now = time;
15622: if ($interval eq '') {
15623: $interval = 600;
15624: }
15625: if (($now-$env{'request.course.timechecked'})>$interval) {
15626: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
15627: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
15628: if ($lastchange > $env{'request.course.tied'}) {
15629: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15630: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
15631: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
15632: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
15633: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
15634: $curr_reqd_hash{'internal.releaserequired'}});
15635: my ($switchserver,$switchwarning) =
15636: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
15637: $curr_reqd_hash{'internal.releaserequired'});
15638: if ($switchwarning ne '' || $switchserver ne '') {
15639: return ('switch',$switchwarning,$switchserver);
15640: }
15641: }
15642: }
15643: return ('update');
15644: }
15645: }
15646: return ();
15647: }
1.1075.2.69 raeburn 15648:
1.1075.2.11 raeburn 15649: sub update_content_constraints {
15650: my ($cdom,$cnum,$chome,$cid) = @_;
15651: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15652: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15653: my %checkresponsetypes;
15654: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15655: my ($item,$name,$value) = split(/:/,$key);
15656: if ($item eq 'resourcetag') {
15657: if ($name eq 'responsetype') {
15658: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15659: }
15660: }
15661: }
15662: my $navmap = Apache::lonnavmaps::navmap->new();
15663: if (defined($navmap)) {
15664: my %allresponses;
15665: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15666: my %responses = $res->responseTypes();
15667: foreach my $key (keys(%responses)) {
15668: next unless(exists($checkresponsetypes{$key}));
15669: $allresponses{$key} += $responses{$key};
15670: }
15671: }
15672: foreach my $key (keys(%allresponses)) {
15673: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15674: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15675: ($reqdmajor,$reqdminor) = ($major,$minor);
15676: }
15677: }
15678: undef($navmap);
15679: }
15680: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15681: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15682: }
15683: return;
15684: }
15685:
1.1075.2.27 raeburn 15686: sub allmaps_incourse {
15687: my ($cdom,$cnum,$chome,$cid) = @_;
15688: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15689: $cid = $env{'request.course.id'};
15690: $cdom = $env{'course.'.$cid.'.domain'};
15691: $cnum = $env{'course.'.$cid.'.num'};
15692: $chome = $env{'course.'.$cid.'.home'};
15693: }
15694: my %allmaps = ();
15695: my $lastchange =
15696: &Apache::lonnet::get_coursechange($cdom,$cnum);
15697: if ($lastchange > $env{'request.course.tied'}) {
15698: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15699: unless ($ferr) {
15700: &update_content_constraints($cdom,$cnum,$chome,$cid);
15701: }
15702: }
15703: my $navmap = Apache::lonnavmaps::navmap->new();
15704: if (defined($navmap)) {
15705: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15706: $allmaps{$res->src()} = 1;
15707: }
15708: }
15709: return \%allmaps;
15710: }
15711:
1.1075.2.11 raeburn 15712: sub parse_supplemental_title {
15713: my ($title) = @_;
15714:
15715: my ($foldertitle,$renametitle);
15716: if ($title =~ /&&&/) {
15717: $title = &HTML::Entites::decode($title);
15718: }
15719: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15720: $renametitle=$4;
15721: my ($time,$uname,$udom) = ($1,$2,$3);
15722: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15723: my $name = &plainname($uname,$udom);
15724: $name = &HTML::Entities::encode($name,'"<>&\'');
15725: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15726: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15727: $name.': <br />'.$foldertitle;
15728: }
15729: if (wantarray) {
15730: return ($title,$foldertitle,$renametitle);
15731: }
15732: return $title;
15733: }
15734:
1.1075.2.43 raeburn 15735: sub recurse_supplemental {
15736: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15737: if ($suppmap) {
15738: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15739: if ($fatal) {
15740: $errors ++;
15741: } else {
15742: if ($#LONCAPA::map::resources > 0) {
15743: foreach my $res (@LONCAPA::map::resources) {
15744: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15745: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 15746: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15747: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 15748: } else {
15749: $numfiles ++;
15750: }
15751: }
15752: }
15753: }
15754: }
15755: }
15756: return ($numfiles,$errors);
15757: }
15758:
1.1075.2.18 raeburn 15759: sub symb_to_docspath {
15760: my ($symb) = @_;
15761: return unless ($symb);
15762: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15763: if ($resurl=~/\.(sequence|page)$/) {
15764: $mapurl=$resurl;
15765: } elsif ($resurl eq 'adm/navmaps') {
15766: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15767: }
15768: my $mapresobj;
15769: my $navmap = Apache::lonnavmaps::navmap->new();
15770: if (ref($navmap)) {
15771: $mapresobj = $navmap->getResourceByUrl($mapurl);
15772: }
15773: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15774: my $type=$2;
15775: my $path;
15776: if (ref($mapresobj)) {
15777: my $pcslist = $mapresobj->map_hierarchy();
15778: if ($pcslist ne '') {
15779: foreach my $pc (split(/,/,$pcslist)) {
15780: next if ($pc <= 1);
15781: my $res = $navmap->getByMapPc($pc);
15782: if (ref($res)) {
15783: my $thisurl = $res->src();
15784: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15785: my $thistitle = $res->title();
15786: $path .= '&'.
15787: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 15788: &escape($thistitle).
1.1075.2.18 raeburn 15789: ':'.$res->randompick().
15790: ':'.$res->randomout().
15791: ':'.$res->encrypted().
15792: ':'.$res->randomorder().
15793: ':'.$res->is_page();
15794: }
15795: }
15796: }
15797: $path =~ s/^\&//;
15798: my $maptitle = $mapresobj->title();
15799: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15800: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15801: }
15802: $path .= (($path ne '')? '&' : '').
15803: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15804: &escape($maptitle).
1.1075.2.18 raeburn 15805: ':'.$mapresobj->randompick().
15806: ':'.$mapresobj->randomout().
15807: ':'.$mapresobj->encrypted().
15808: ':'.$mapresobj->randomorder().
15809: ':'.$mapresobj->is_page();
15810: } else {
15811: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15812: my $ispage = (($type eq 'page')? 1 : '');
15813: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15814: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15815: }
15816: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15817: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 15818: }
15819: unless ($mapurl eq 'default') {
15820: $path = 'default&'.
1.1075.2.46 raeburn 15821: &escape('Main Content').
1.1075.2.18 raeburn 15822: ':::::&'.$path;
15823: }
15824: return $path;
15825: }
15826:
1.1075.2.14 raeburn 15827: sub captcha_display {
15828: my ($context,$lonhost) = @_;
15829: my ($output,$error);
15830: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
15831: if ($captcha eq 'original') {
15832: $output = &create_captcha();
15833: unless ($output) {
15834: $error = 'captcha';
15835: }
15836: } elsif ($captcha eq 'recaptcha') {
15837: $output = &create_recaptcha($pubkey);
15838: unless ($output) {
15839: $error = 'recaptcha';
15840: }
15841: }
1.1075.2.66 raeburn 15842: return ($output,$error,$captcha);
1.1075.2.14 raeburn 15843: }
15844:
15845: sub captcha_response {
15846: my ($context,$lonhost) = @_;
15847: my ($captcha_chk,$captcha_error);
15848: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
15849: if ($captcha eq 'original') {
15850: ($captcha_chk,$captcha_error) = &check_captcha();
15851: } elsif ($captcha eq 'recaptcha') {
15852: $captcha_chk = &check_recaptcha($privkey);
15853: } else {
15854: $captcha_chk = 1;
15855: }
15856: return ($captcha_chk,$captcha_error);
15857: }
15858:
15859: sub get_captcha_config {
15860: my ($context,$lonhost) = @_;
15861: my ($captcha,$pubkey,$privkey,$hashtocheck);
15862: my $hostname = &Apache::lonnet::hostname($lonhost);
15863: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
15864: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15865: if ($context eq 'usercreation') {
15866: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
15867: if (ref($domconfig{$context}) eq 'HASH') {
15868: $hashtocheck = $domconfig{$context}{'cancreate'};
15869: if (ref($hashtocheck) eq 'HASH') {
15870: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
15871: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
15872: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
15873: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
15874: }
15875: if ($privkey && $pubkey) {
15876: $captcha = 'recaptcha';
15877: } else {
15878: $captcha = 'original';
15879: }
15880: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
15881: $captcha = 'original';
15882: }
15883: }
15884: } else {
15885: $captcha = 'captcha';
15886: }
15887: } elsif ($context eq 'login') {
15888: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
15889: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
15890: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
15891: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
15892: if ($privkey && $pubkey) {
15893: $captcha = 'recaptcha';
15894: } else {
15895: $captcha = 'original';
15896: }
15897: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
15898: $captcha = 'original';
15899: }
15900: }
15901: return ($captcha,$pubkey,$privkey);
15902: }
15903:
15904: sub create_captcha {
15905: my %captcha_params = &captcha_settings();
15906: my ($output,$maxtries,$tries) = ('',10,0);
15907: while ($tries < $maxtries) {
15908: $tries ++;
15909: my $captcha = Authen::Captcha->new (
15910: output_folder => $captcha_params{'output_dir'},
15911: data_folder => $captcha_params{'db_dir'},
15912: );
15913: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
15914:
15915: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
15916: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
15917: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.66 raeburn 15918: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
15919: '<br />'.
15920: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 15921: last;
15922: }
15923: }
15924: return $output;
15925: }
15926:
15927: sub captcha_settings {
15928: my %captcha_params = (
15929: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
15930: www_output_dir => "/captchaspool",
15931: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
15932: numchars => '5',
15933: );
15934: return %captcha_params;
15935: }
15936:
15937: sub check_captcha {
15938: my ($captcha_chk,$captcha_error);
15939: my $code = $env{'form.code'};
15940: my $md5sum = $env{'form.crypt'};
15941: my %captcha_params = &captcha_settings();
15942: my $captcha = Authen::Captcha->new(
15943: output_folder => $captcha_params{'output_dir'},
15944: data_folder => $captcha_params{'db_dir'},
15945: );
1.1075.2.26 raeburn 15946: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 15947: my %captcha_hash = (
15948: 0 => 'Code not checked (file error)',
15949: -1 => 'Failed: code expired',
15950: -2 => 'Failed: invalid code (not in database)',
15951: -3 => 'Failed: invalid code (code does not match crypt)',
15952: );
15953: if ($captcha_chk != 1) {
15954: $captcha_error = $captcha_hash{$captcha_chk}
15955: }
15956: return ($captcha_chk,$captcha_error);
15957: }
15958:
15959: sub create_recaptcha {
15960: my ($pubkey) = @_;
1.1075.2.51 raeburn 15961: my $use_ssl;
15962: if ($ENV{'SERVER_PORT'} == 443) {
15963: $use_ssl = 1;
15964: }
1.1075.2.14 raeburn 15965: my $captcha = Captcha::reCAPTCHA->new;
15966: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51 raeburn 15967: $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.92 raeburn 15968: &mt('If the text is hard to read, [_1] will replace them.',
1.1075.2.39 raeburn 15969: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14 raeburn 15970: '<br /><br />';
15971: }
15972:
15973: sub check_recaptcha {
15974: my ($privkey) = @_;
15975: my $captcha_chk;
15976: my $captcha = Captcha::reCAPTCHA->new;
15977: my $captcha_result =
15978: $captcha->check_answer(
15979: $privkey,
15980: $ENV{'REMOTE_ADDR'},
15981: $env{'form.recaptcha_challenge_field'},
15982: $env{'form.recaptcha_response_field'},
15983: );
15984: if ($captcha_result->{is_valid}) {
15985: $captcha_chk = 1;
15986: }
15987: return $captcha_chk;
15988: }
15989:
1.1075.2.64 raeburn 15990: sub emailusername_info {
1.1075.2.67 raeburn 15991: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64 raeburn 15992: my %titles = &Apache::lonlocal::texthash (
15993: lastname => 'Last Name',
15994: firstname => 'First Name',
15995: institution => 'School/college/university',
15996: location => "School's city, state/province, country",
15997: web => "School's web address",
15998: officialemail => 'E-mail address at institution (if different)',
15999: );
16000: return (\@fields,\%titles);
16001: }
16002:
1.1075.2.56 raeburn 16003: sub cleanup_html {
16004: my ($incoming) = @_;
16005: my $outgoing;
16006: if ($incoming ne '') {
16007: $outgoing = $incoming;
16008: $outgoing =~ s/;/;/g;
16009: $outgoing =~ s/\#/#/g;
16010: $outgoing =~ s/\&/&/g;
16011: $outgoing =~ s/</</g;
16012: $outgoing =~ s/>/>/g;
16013: $outgoing =~ s/\(/(/g;
16014: $outgoing =~ s/\)/)/g;
16015: $outgoing =~ s/"/"/g;
16016: $outgoing =~ s/'/'/g;
16017: $outgoing =~ s/\$/$/g;
16018: $outgoing =~ s{/}{/}g;
16019: $outgoing =~ s/=/=/g;
16020: $outgoing =~ s/\\/\/g
16021: }
16022: return $outgoing;
16023: }
16024:
1.1075.2.74 raeburn 16025: # Checks for critical messages and returns a redirect url if one exists.
16026: # $interval indicates how often to check for messages.
16027: sub critical_redirect {
16028: my ($interval) = @_;
16029: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16030: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16031: $env{'user.name'});
16032: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
16033: my $redirecturl;
16034: if ($what[0]) {
16035: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16036: $redirecturl='/adm/email?critical=display';
16037: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16038: return (1, $url);
16039: }
16040: }
16041: }
16042: return ();
16043: }
16044:
1.1075.2.64 raeburn 16045: # Use:
16046: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16047: #
16048: ##################################################
16049: # password associated functions #
16050: ##################################################
16051: sub des_keys {
16052: # Make a new key for DES encryption.
16053: # Each key has two parts which are returned separately.
16054: # Please note: Each key must be passed through the &hex function
16055: # before it is output to the web browser. The hex versions cannot
16056: # be used to decrypt.
16057: my @hexstr=('0','1','2','3','4','5','6','7',
16058: '8','9','a','b','c','d','e','f');
16059: my $lkey='';
16060: for (0..7) {
16061: $lkey.=$hexstr[rand(15)];
16062: }
16063: my $ukey='';
16064: for (0..7) {
16065: $ukey.=$hexstr[rand(15)];
16066: }
16067: return ($lkey,$ukey);
16068: }
16069:
16070: sub des_decrypt {
16071: my ($key,$cyphertext) = @_;
16072: my $keybin=pack("H16",$key);
16073: my $cypher;
16074: if ($Crypt::DES::VERSION>=2.03) {
16075: $cypher=new Crypt::DES $keybin;
16076: } else {
16077: $cypher=new DES $keybin;
16078: }
16079: my $plaintext=
16080: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
16081: $plaintext.=
16082: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
16083: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
16084: return $plaintext;
16085: }
16086:
1.112 bowersj2 16087: 1;
16088: __END__;
1.41 ng 16089:
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