Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.101
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.101! raeburn 4: # $Id: loncommon.pm,v 1.1075.2.100 2016/08/05 20:31:07 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,
1.1075.2.95 raeburn 536: $credits_element,$instcode) = @_;
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;
1.1075.2.101! raeburn 586: url += '&cloner='+ownername+':'+ownerdom;
! 587: if (type == 'Course') {
! 588: url += '&crscode='+document.forms[formid].crscode.value;
! 589: }
1.1075.2.95 raeburn 590: }
591: if (formname == 'requestcrs') {
592: url += '&crsdom=$domainfilter&crscode=$instcode';
1.872 raeburn 593: }
1.293 raeburn 594: if (multflag !=null && multflag != '') {
595: url += '&multiple='+multflag;
596: }
1.909 raeburn 597: var title = '$wintitle';
1.91 www 598: var options = 'scrollbars=1,resizable=1,menubar=0';
599: options += ',width=700,height=600';
600: stdeditbrowser = open(url,title,options,'1');
601: stdeditbrowser.focus();
602: }
1.876 raeburn 603: $id_functions
604: ENDSTDBRW
1.1075.2.31 raeburn 605: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
606: $output .= &setsec_javascript($sec_element,$formname,$role_element,
607: $credits_element);
1.876 raeburn 608: }
609: $output .= '
610: // ]]>
611: </script>';
612: return $output;
613: }
614:
615: sub javascript_index_functions {
616: return <<"ENDJS";
617:
618: function getFormIdByName(formname) {
619: for (var i=0;i<document.forms.length;i++) {
620: if (document.forms[i].name == formname) {
621: return i;
622: }
623: }
624: return -1;
625: }
626:
627: function getIndexByName(formid,item) {
628: for (var i=0;i<document.forms[formid].elements.length;i++) {
629: if (document.forms[formid].elements[i].name == item) {
630: return i;
631: }
632: }
633: return -1;
634: }
1.468 raeburn 635:
1.876 raeburn 636: function getDomainFromSelectbox(formname,udom) {
637: var userdom;
638: var formid = getFormIdByName(formname);
639: if (formid > -1) {
640: var domid = getIndexByName(formid,udom);
641: if (domid > -1) {
642: if (document.forms[formid].elements[domid].type == 'select-one') {
643: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
644: }
645: if (document.forms[formid].elements[domid].type == 'hidden') {
646: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 647: }
648: }
649: }
1.876 raeburn 650: return userdom;
651: }
652:
653: ENDJS
1.468 raeburn 654:
1.876 raeburn 655: }
656:
1.1017 raeburn 657: sub javascript_array_indexof {
1.1018 raeburn 658: return <<ENDJS;
1.1017 raeburn 659: <script type="text/javascript" language="JavaScript">
660: // <![CDATA[
661:
662: if (!Array.prototype.indexOf) {
663: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
664: "use strict";
665: if (this === void 0 || this === null) {
666: throw new TypeError();
667: }
668: var t = Object(this);
669: var len = t.length >>> 0;
670: if (len === 0) {
671: return -1;
672: }
673: var n = 0;
674: if (arguments.length > 0) {
675: n = Number(arguments[1]);
676: if (n !== n) { // shortcut for verifying if it's NaN
677: n = 0;
678: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
679: n = (n > 0 || -1) * Math.floor(Math.abs(n));
680: }
681: }
682: if (n >= len) {
683: return -1;
684: }
685: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
686: for (; k < len; k++) {
687: if (k in t && t[k] === searchElement) {
688: return k;
689: }
690: }
691: return -1;
692: }
693: }
694:
695: // ]]>
696: </script>
697:
698: ENDJS
699:
700: }
701:
1.876 raeburn 702: sub userbrowser_javascript {
703: my $id_functions = &javascript_index_functions();
704: return <<"ENDUSERBRW";
705:
1.888 raeburn 706: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 707: var url = '/adm/pickuser?';
708: var userdom = getDomainFromSelectbox(formname,udom);
709: if (userdom != null) {
710: if (userdom != '') {
711: url += 'srchdom='+userdom+'&';
712: }
713: }
714: url += 'form=' + formname + '&unameelement='+uname+
715: '&udomelement='+udom+
716: '&ulastelement='+ulast+
717: '&ufirstelement='+ufirst+
718: '&uemailelement='+uemail+
1.881 raeburn 719: '&hideudomelement='+hideudom+
720: '&coursedom='+crsdom;
1.888 raeburn 721: if ((caller != null) && (caller != undefined)) {
722: url += '&caller='+caller;
723: }
1.876 raeburn 724: var title = 'User_Browser';
725: var options = 'scrollbars=1,resizable=1,menubar=0';
726: options += ',width=700,height=600';
727: var stdeditbrowser = open(url,title,options,'1');
728: stdeditbrowser.focus();
729: }
730:
1.888 raeburn 731: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 732: var formid = getFormIdByName(formname);
733: if (formid > -1) {
1.888 raeburn 734: var unameid = getIndexByName(formid,uname);
1.876 raeburn 735: var domid = getIndexByName(formid,udom);
736: var hidedomid = getIndexByName(formid,origdom);
737: if (hidedomid > -1) {
738: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 739: var unameval = document.forms[formid].elements[unameid].value;
740: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
741: if (domid > -1) {
742: var slct = document.forms[formid].elements[domid];
743: if (slct.type == 'select-one') {
744: var i;
745: for (i=0;i<slct.length;i++) {
746: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
747: }
748: }
749: if (slct.type == 'hidden') {
750: slct.value = fixeddom;
1.876 raeburn 751: }
752: }
1.468 raeburn 753: }
754: }
755: }
1.876 raeburn 756: return;
757: }
758:
759: $id_functions
760: ENDUSERBRW
1.468 raeburn 761: }
762:
763: sub setsec_javascript {
1.1075.2.31 raeburn 764: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 765: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
766: $communityrolestr);
767: if ($role_element ne '') {
768: my @allroles = ('st','ta','ep','in','ad');
769: foreach my $crstype ('Course','Community') {
770: if ($crstype eq 'Community') {
771: foreach my $role (@allroles) {
772: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
773: }
774: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
775: } else {
776: foreach my $role (@allroles) {
777: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
778: }
779: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
780: }
781: }
782: $rolestr = '"'.join('","',@allroles).'"';
783: $courserolestr = '"'.join('","',@courserolenames).'"';
784: $communityrolestr = '"'.join('","',@communityrolenames).'"';
785: }
1.468 raeburn 786: my $setsections = qq|
787: function setSect(sectionlist) {
1.629 raeburn 788: var sectionsArray = new Array();
789: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
790: sectionsArray = sectionlist.split(",");
791: }
1.468 raeburn 792: var numSections = sectionsArray.length;
793: document.$formname.$sec_element.length = 0;
794: if (numSections == 0) {
795: document.$formname.$sec_element.multiple=false;
796: document.$formname.$sec_element.size=1;
797: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
798: } else {
799: if (numSections == 1) {
800: document.$formname.$sec_element.multiple=false;
801: document.$formname.$sec_element.size=1;
802: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
803: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
804: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
805: } else {
806: for (var i=0; i<numSections; i++) {
807: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
808: }
809: document.$formname.$sec_element.multiple=true
810: if (numSections < 3) {
811: document.$formname.$sec_element.size=numSections;
812: } else {
813: document.$formname.$sec_element.size=3;
814: }
815: document.$formname.$sec_element.options[0].selected = false
816: }
817: }
1.91 www 818: }
1.905 raeburn 819:
820: function setRole(crstype) {
1.468 raeburn 821: |;
1.905 raeburn 822: if ($role_element eq '') {
823: $setsections .= ' return;
824: }
825: ';
826: } else {
827: $setsections .= qq|
828: var elementLength = document.$formname.$role_element.length;
829: var allroles = Array($rolestr);
830: var courserolenames = Array($courserolestr);
831: var communityrolenames = Array($communityrolestr);
832: if (elementLength != undefined) {
833: if (document.$formname.$role_element.options[5].value == 'cc') {
834: if (crstype == 'Course') {
835: return;
836: } else {
837: allroles[5] = 'co';
838: for (var i=0; i<6; i++) {
839: document.$formname.$role_element.options[i].value = allroles[i];
840: document.$formname.$role_element.options[i].text = communityrolenames[i];
841: }
842: }
843: } else {
844: if (crstype == 'Community') {
845: return;
846: } else {
847: allroles[5] = 'cc';
848: for (var i=0; i<6; i++) {
849: document.$formname.$role_element.options[i].value = allroles[i];
850: document.$formname.$role_element.options[i].text = courserolenames[i];
851: }
852: }
853: }
854: }
855: return;
856: }
857: |;
858: }
1.1075.2.31 raeburn 859: if ($credits_element) {
860: $setsections .= qq|
861: function setCredits(defaultcredits) {
862: document.$formname.$credits_element.value = defaultcredits;
863: return;
864: }
865: |;
866: }
1.468 raeburn 867: return $setsections;
868: }
869:
1.91 www 870: sub selectcourse_link {
1.909 raeburn 871: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
872: $typeelement) = @_;
873: my $type = $selecttype;
1.871 raeburn 874: my $linktext = &mt('Select Course');
875: if ($selecttype eq 'Community') {
1.909 raeburn 876: $linktext = &mt('Select Community');
1.906 raeburn 877: } elsif ($selecttype eq 'Course/Community') {
878: $linktext = &mt('Select Course/Community');
1.909 raeburn 879: $type = '';
1.1019 raeburn 880: } elsif ($selecttype eq 'Select') {
881: $linktext = &mt('Select');
882: $type = '';
1.871 raeburn 883: }
1.787 bisitz 884: return '<span class="LC_nobreak">'
885: ."<a href='"
886: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
887: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 888: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 889: ."'>".$linktext.'</a>'
1.787 bisitz 890: .'</span>';
1.74 www 891: }
1.42 matthew 892:
1.653 raeburn 893: sub selectauthor_link {
894: my ($form,$udom)=@_;
895: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
896: &mt('Select Author').'</a>';
897: }
898:
1.876 raeburn 899: sub selectuser_link {
1.881 raeburn 900: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 901: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 902: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 903: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 904: ');">'.$linktext.'</a>';
1.876 raeburn 905: }
906:
1.273 raeburn 907: sub check_uncheck_jscript {
908: my $jscript = <<"ENDSCRT";
909: function checkAll(field) {
910: if (field.length > 0) {
911: for (i = 0; i < field.length; i++) {
1.1075.2.14 raeburn 912: if (!field[i].disabled) {
913: field[i].checked = true;
914: }
1.273 raeburn 915: }
916: } else {
1.1075.2.14 raeburn 917: if (!field.disabled) {
918: field.checked = true;
919: }
1.273 raeburn 920: }
921: }
922:
923: function uncheckAll(field) {
924: if (field.length > 0) {
925: for (i = 0; i < field.length; i++) {
926: field[i].checked = false ;
1.543 albertel 927: }
928: } else {
1.273 raeburn 929: field.checked = false ;
930: }
931: }
932: ENDSCRT
933: return $jscript;
934: }
935:
1.656 www 936: sub select_timezone {
1.659 raeburn 937: my ($name,$selected,$onchange,$includeempty)=@_;
938: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
939: if ($includeempty) {
940: $output .= '<option value=""';
941: if (($selected eq '') || ($selected eq 'local')) {
942: $output .= ' selected="selected" ';
943: }
944: $output .= '> </option>';
945: }
1.657 raeburn 946: my @timezones = DateTime::TimeZone->all_names;
947: foreach my $tzone (@timezones) {
948: $output.= '<option value="'.$tzone.'"';
949: if ($tzone eq $selected) {
950: $output.=' selected="selected"';
951: }
952: $output.=">$tzone</option>\n";
1.656 www 953: }
954: $output.="</select>";
955: return $output;
956: }
1.273 raeburn 957:
1.687 raeburn 958: sub select_datelocale {
959: my ($name,$selected,$onchange,$includeempty)=@_;
960: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
961: if ($includeempty) {
962: $output .= '<option value=""';
963: if ($selected eq '') {
964: $output .= ' selected="selected" ';
965: }
966: $output .= '> </option>';
967: }
968: my (@possibles,%locale_names);
969: my @locales = DateTime::Locale::Catalog::Locales;
970: foreach my $locale (@locales) {
971: if (ref($locale) eq 'HASH') {
972: my $id = $locale->{'id'};
973: if ($id ne '') {
974: my $en_terr = $locale->{'en_territory'};
975: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 976: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 977: if (grep(/^en$/,@languages) || !@languages) {
978: if ($en_terr ne '') {
979: $locale_names{$id} = '('.$en_terr.')';
980: } elsif ($native_terr ne '') {
981: $locale_names{$id} = $native_terr;
982: }
983: } else {
984: if ($native_terr ne '') {
985: $locale_names{$id} = $native_terr.' ';
986: } elsif ($en_terr ne '') {
987: $locale_names{$id} = '('.$en_terr.')';
988: }
989: }
1.1075.2.94 raeburn 990: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.687 raeburn 991: push (@possibles,$id);
992: }
993: }
994: }
995: foreach my $item (sort(@possibles)) {
996: $output.= '<option value="'.$item.'"';
997: if ($item eq $selected) {
998: $output.=' selected="selected"';
999: }
1000: $output.=">$item";
1001: if ($locale_names{$item} ne '') {
1.1075.2.94 raeburn 1002: $output.=' '.$locale_names{$item};
1.687 raeburn 1003: }
1004: $output.="</option>\n";
1005: }
1006: $output.="</select>";
1007: return $output;
1008: }
1009:
1.792 raeburn 1010: sub select_language {
1011: my ($name,$selected,$includeempty) = @_;
1012: my %langchoices;
1013: if ($includeempty) {
1.1075.2.32 raeburn 1014: %langchoices = ('' => 'No language preference');
1.792 raeburn 1015: }
1016: foreach my $id (&languageids()) {
1017: my $code = &supportedlanguagecode($id);
1018: if ($code) {
1019: $langchoices{$code} = &plainlanguagedescription($id);
1020: }
1021: }
1.1075.2.32 raeburn 1022: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1023: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1024: }
1025:
1.42 matthew 1026: =pod
1.36 matthew 1027:
1.648 raeburn 1028: =item * &linked_select_forms(...)
1.36 matthew 1029:
1030: linked_select_forms returns a string containing a <script></script> block
1031: and html for two <select> menus. The select menus will be linked in that
1032: changing the value of the first menu will result in new values being placed
1033: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1034: order unless a defined order is provided.
1.36 matthew 1035:
1036: linked_select_forms takes the following ordered inputs:
1037:
1038: =over 4
1039:
1.112 bowersj2 1040: =item * $formname, the name of the <form> tag
1.36 matthew 1041:
1.112 bowersj2 1042: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1043:
1.112 bowersj2 1044: =item * $firstdefault, the default value for the first menu
1.36 matthew 1045:
1.112 bowersj2 1046: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1047:
1.112 bowersj2 1048: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1049:
1.112 bowersj2 1050: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1051:
1.609 raeburn 1052: =item * $menuorder, the order of values in the first menu
1053:
1.1075.2.31 raeburn 1054: =item * $onchangefirst, additional javascript call to execute for an onchange
1055: event for the first <select> tag
1056:
1057: =item * $onchangesecond, additional javascript call to execute for an onchange
1058: event for the second <select> tag
1059:
1.41 ng 1060: =back
1061:
1.36 matthew 1062: Below is an example of such a hash. Only the 'text', 'default', and
1063: 'select2' keys must appear as stated. keys(%menu) are the possible
1064: values for the first select menu. The text that coincides with the
1.41 ng 1065: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1066: and text for the second menu are given in the hash pointed to by
1067: $menu{$choice1}->{'select2'}.
1068:
1.112 bowersj2 1069: my %menu = ( A1 => { text =>"Choice A1" ,
1070: default => "B3",
1071: select2 => {
1072: B1 => "Choice B1",
1073: B2 => "Choice B2",
1074: B3 => "Choice B3",
1075: B4 => "Choice B4"
1.609 raeburn 1076: },
1077: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1078: },
1079: A2 => { text =>"Choice A2" ,
1080: default => "C2",
1081: select2 => {
1082: C1 => "Choice C1",
1083: C2 => "Choice C2",
1084: C3 => "Choice C3"
1.609 raeburn 1085: },
1086: order => ['C2','C1','C3'],
1.112 bowersj2 1087: },
1088: A3 => { text =>"Choice A3" ,
1089: default => "D6",
1090: select2 => {
1091: D1 => "Choice D1",
1092: D2 => "Choice D2",
1093: D3 => "Choice D3",
1094: D4 => "Choice D4",
1095: D5 => "Choice D5",
1096: D6 => "Choice D6",
1097: D7 => "Choice D7"
1.609 raeburn 1098: },
1099: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1100: }
1101: );
1.36 matthew 1102:
1103: =cut
1104:
1105: sub linked_select_forms {
1106: my ($formname,
1107: $middletext,
1108: $firstdefault,
1109: $firstselectname,
1110: $secondselectname,
1.609 raeburn 1111: $hashref,
1112: $menuorder,
1.1075.2.31 raeburn 1113: $onchangefirst,
1114: $onchangesecond
1.36 matthew 1115: ) = @_;
1116: my $second = "document.$formname.$secondselectname";
1117: my $first = "document.$formname.$firstselectname";
1118: # output the javascript to do the changing
1119: my $result = '';
1.776 bisitz 1120: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1121: $result.="// <![CDATA[\n";
1.36 matthew 1122: $result.="var select2data = new Object();\n";
1123: $" = '","';
1124: my $debug = '';
1125: foreach my $s1 (sort(keys(%$hashref))) {
1126: $result.="select2data.d_$s1 = new Object();\n";
1127: $result.="select2data.d_$s1.def = new String('".
1128: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1129: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1130: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1131: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1132: @s2values = @{$hashref->{$s1}->{'order'}};
1133: }
1.36 matthew 1134: $result.="\"@s2values\");\n";
1135: $result.="select2data.d_$s1.texts = new Array(";
1136: my @s2texts;
1137: foreach my $value (@s2values) {
1138: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1139: }
1140: $result.="\"@s2texts\");\n";
1141: }
1142: $"=' ';
1143: $result.= <<"END";
1144:
1145: function select1_changed() {
1146: // Determine new choice
1147: var newvalue = "d_" + $first.value;
1148: // update select2
1149: var values = select2data[newvalue].values;
1150: var texts = select2data[newvalue].texts;
1151: var select2def = select2data[newvalue].def;
1152: var i;
1153: // out with the old
1154: for (i = 0; i < $second.options.length; i++) {
1155: $second.options[i] = null;
1156: }
1157: // in with the nuclear
1158: for (i=0;i<values.length; i++) {
1159: $second.options[i] = new Option(values[i]);
1.143 matthew 1160: $second.options[i].value = values[i];
1.36 matthew 1161: $second.options[i].text = texts[i];
1162: if (values[i] == select2def) {
1163: $second.options[i].selected = true;
1164: }
1165: }
1166: }
1.824 bisitz 1167: // ]]>
1.36 matthew 1168: </script>
1169: END
1170: # output the initial values for the selection lists
1.1075.2.31 raeburn 1171: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1172: my @order = sort(keys(%{$hashref}));
1173: if (ref($menuorder) eq 'ARRAY') {
1174: @order = @{$menuorder};
1175: }
1176: foreach my $value (@order) {
1.36 matthew 1177: $result.=" <option value=\"$value\" ";
1.253 albertel 1178: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1179: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1180: }
1181: $result .= "</select>\n";
1182: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1183: $result .= $middletext;
1.1075.2.31 raeburn 1184: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1185: if ($onchangesecond) {
1186: $result .= ' onchange="'.$onchangesecond.'"';
1187: }
1188: $result .= ">\n";
1.36 matthew 1189: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1190:
1191: my @secondorder = sort(keys(%select2));
1192: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1193: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1194: }
1195: foreach my $value (@secondorder) {
1.36 matthew 1196: $result.=" <option value=\"$value\" ";
1.253 albertel 1197: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1198: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1199: }
1200: $result .= "</select>\n";
1201: # return $debug;
1202: return $result;
1203: } # end of sub linked_select_forms {
1204:
1.45 matthew 1205: =pod
1.44 bowersj2 1206:
1.973 raeburn 1207: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1208:
1.112 bowersj2 1209: Returns a string corresponding to an HTML link to the given help
1210: $topic, where $topic corresponds to the name of a .tex file in
1211: /home/httpd/html/adm/help/tex, with underscores replaced by
1212: spaces.
1213:
1214: $text will optionally be linked to the same topic, allowing you to
1215: link text in addition to the graphic. If you do not want to link
1216: text, but wish to specify one of the later parameters, pass an
1217: empty string.
1218:
1219: $stayOnPage is a value that will be interpreted as a boolean. If true,
1220: the link will not open a new window. If false, the link will open
1221: a new window using Javascript. (Default is false.)
1222:
1223: $width and $height are optional numerical parameters that will
1224: override the width and height of the popped up window, which may
1.973 raeburn 1225: be useful for certain help topics with big pictures included.
1226:
1227: $imgid is the id of the img tag used for the help icon. This may be
1228: used in a javascript call to switch the image src. See
1229: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1230:
1231: =cut
1232:
1233: sub help_open_topic {
1.973 raeburn 1234: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1235: $text = "" if (not defined $text);
1.44 bowersj2 1236: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1237: $width = 500 if (not defined $width);
1.44 bowersj2 1238: $height = 400 if (not defined $height);
1239: my $filename = $topic;
1240: $filename =~ s/ /_/g;
1241:
1.48 bowersj2 1242: my $template = "";
1243: my $link;
1.572 banghart 1244:
1.159 www 1245: $topic=~s/\W/\_/g;
1.44 bowersj2 1246:
1.572 banghart 1247: if (!$stayOnPage) {
1.1075.2.50 raeburn 1248: if ($env{'browser.mobile'}) {
1249: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1250: } else {
1251: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1252: }
1.1037 www 1253: } elsif ($stayOnPage eq 'popup') {
1254: $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 1255: } else {
1.48 bowersj2 1256: $link = "/adm/help/${filename}.hlp";
1257: }
1258:
1259: # Add the text
1.755 neumanie 1260: if ($text ne "") {
1.763 bisitz 1261: $template.='<span class="LC_help_open_topic">'
1262: .'<a target="_top" href="'.$link.'">'
1263: .$text.'</a>';
1.48 bowersj2 1264: }
1265:
1.763 bisitz 1266: # (Always) Add the graphic
1.179 matthew 1267: my $title = &mt('Online Help');
1.667 raeburn 1268: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1269: if ($imgid ne '') {
1270: $imgid = ' id="'.$imgid.'"';
1271: }
1.763 bisitz 1272: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1273: .'<img src="'.$helpicon.'" border="0"'
1274: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1275: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1276: .' /></a>';
1277: if ($text ne "") {
1278: $template.='</span>';
1279: }
1.44 bowersj2 1280: return $template;
1281:
1.106 bowersj2 1282: }
1283:
1284: # This is a quicky function for Latex cheatsheet editing, since it
1285: # appears in at least four places
1286: sub helpLatexCheatsheet {
1.1037 www 1287: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1288: my $out;
1.106 bowersj2 1289: my $addOther = '';
1.732 raeburn 1290: if ($topic) {
1.1037 www 1291: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1292: }
1293: $out = '<span>' # Start cheatsheet
1294: .$addOther
1295: .'<span>'
1.1037 www 1296: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1297: .'</span> <span>'
1.1037 www 1298: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1299: .'</span>';
1.732 raeburn 1300: unless ($not_author) {
1.763 bisitz 1301: $out .= ' <span>'
1.1037 www 1302: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1303: .'</span> <span>'
1.1075.2.78 raeburn 1304: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1305: .'</span>';
1.732 raeburn 1306: }
1.763 bisitz 1307: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1308: return $out;
1.172 www 1309: }
1310:
1.430 albertel 1311: sub general_help {
1312: my $helptopic='Student_Intro';
1313: if ($env{'request.role'}=~/^(ca|au)/) {
1314: $helptopic='Authoring_Intro';
1.907 raeburn 1315: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1316: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1317: } elsif ($env{'request.role'}=~/^dc/) {
1318: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1319: }
1320: return $helptopic;
1321: }
1322:
1323: sub update_help_link {
1324: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1325: my $origurl = $ENV{'REQUEST_URI'};
1326: $origurl=~s|^/~|/priv/|;
1327: my $timestamp = time;
1328: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1329: $$datum = &escape($$datum);
1330: }
1331:
1332: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1333: my $output .= <<"ENDOUTPUT";
1334: <script type="text/javascript">
1.824 bisitz 1335: // <![CDATA[
1.430 albertel 1336: banner_link = '$banner_link';
1.824 bisitz 1337: // ]]>
1.430 albertel 1338: </script>
1339: ENDOUTPUT
1340: return $output;
1341: }
1342:
1343: # now just updates the help link and generates a blue icon
1.193 raeburn 1344: sub help_open_menu {
1.430 albertel 1345: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1346: = @_;
1.949 droeschl 1347: $stayOnPage = 1;
1.430 albertel 1348: my $output;
1349: if ($component_help) {
1350: if (!$text) {
1351: $output=&help_open_topic($component_help,undef,$stayOnPage,
1352: $width,$height);
1353: } else {
1354: my $help_text;
1355: $help_text=&unescape($topic);
1356: $output='<table><tr><td>'.
1357: &help_open_topic($component_help,$help_text,$stayOnPage,
1358: $width,$height).'</td></tr></table>';
1359: }
1360: }
1361: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1362: return $output.$banner_link;
1363: }
1364:
1365: sub top_nav_help {
1366: my ($text) = @_;
1.436 albertel 1367: $text = &mt($text);
1.1075.2.60 raeburn 1368: my $stay_on_page;
1369: unless ($env{'environment.remote'} eq 'on') {
1370: $stay_on_page = 1;
1371: }
1.1075.2.61 raeburn 1372: my ($link,$banner_link);
1373: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1374: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1375: : "javascript:helpMenu('open')";
1376: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1377: }
1.201 raeburn 1378: my $title = &mt('Get help');
1.1075.2.61 raeburn 1379: if ($link) {
1380: return <<"END";
1.436 albertel 1381: $banner_link
1.1075.2.56 raeburn 1382: <a href="$link" title="$title">$text</a>
1.436 albertel 1383: END
1.1075.2.61 raeburn 1384: } else {
1385: return ' '.$text.' ';
1386: }
1.436 albertel 1387: }
1388:
1389: sub help_menu_js {
1.1075.2.52 raeburn 1390: my ($httphost) = @_;
1.949 droeschl 1391: my $stayOnPage = 1;
1.436 albertel 1392: my $width = 620;
1393: my $height = 600;
1.430 albertel 1394: my $helptopic=&general_help();
1.1075.2.52 raeburn 1395: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1396: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1397: my $start_page =
1398: &Apache::loncommon::start_page('Help Menu', undef,
1399: {'frameset' => 1,
1400: 'js_ready' => 1,
1.1075.2.52 raeburn 1401: 'use_absolute' => $httphost,
1.331 albertel 1402: 'add_entries' => {
1403: 'border' => '0',
1.579 raeburn 1404: 'rows' => "110,*",},});
1.331 albertel 1405: my $end_page =
1406: &Apache::loncommon::end_page({'frameset' => 1,
1407: 'js_ready' => 1,});
1408:
1.436 albertel 1409: my $template .= <<"ENDTEMPLATE";
1410: <script type="text/javascript">
1.877 bisitz 1411: // <![CDATA[
1.253 albertel 1412: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1413: var banner_link = '';
1.243 raeburn 1414: function helpMenu(target) {
1415: var caller = this;
1416: if (target == 'open') {
1417: var newWindow = null;
1418: try {
1.262 albertel 1419: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1420: }
1421: catch(error) {
1422: writeHelp(caller);
1423: return;
1424: }
1425: if (newWindow) {
1426: caller = newWindow;
1427: }
1.193 raeburn 1428: }
1.243 raeburn 1429: writeHelp(caller);
1430: return;
1431: }
1432: function writeHelp(caller) {
1.1075.2.61 raeburn 1433: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1434: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1435: caller.document.close();
1436: caller.focus();
1.193 raeburn 1437: }
1.877 bisitz 1438: // END LON-CAPA Internal -->
1.253 albertel 1439: // ]]>
1.436 albertel 1440: </script>
1.193 raeburn 1441: ENDTEMPLATE
1442: return $template;
1443: }
1444:
1.172 www 1445: sub help_open_bug {
1446: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1447: unless ($env{'user.adv'}) { return ''; }
1.172 www 1448: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1449: $text = "" if (not defined $text);
1450: $stayOnPage=1;
1.184 albertel 1451: $width = 600 if (not defined $width);
1452: $height = 600 if (not defined $height);
1.172 www 1453:
1454: $topic=~s/\W+/\+/g;
1455: my $link='';
1456: my $template='';
1.379 albertel 1457: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1458: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1459: if (!$stayOnPage)
1460: {
1461: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1462: }
1463: else
1464: {
1465: $link = $url;
1466: }
1467: # Add the text
1468: if ($text ne "")
1469: {
1470: $template .=
1471: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1472: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1473: }
1474:
1475: # Add the graphic
1.179 matthew 1476: my $title = &mt('Report a Bug');
1.215 albertel 1477: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1478: $template .= <<"ENDTEMPLATE";
1.436 albertel 1479: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1480: ENDTEMPLATE
1481: if ($text ne '') { $template.='</td></tr></table>' };
1482: return $template;
1483:
1484: }
1485:
1486: sub help_open_faq {
1487: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1488: unless ($env{'user.adv'}) { return ''; }
1.172 www 1489: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1490: $text = "" if (not defined $text);
1491: $stayOnPage=1;
1492: $width = 350 if (not defined $width);
1493: $height = 400 if (not defined $height);
1494:
1495: $topic=~s/\W+/\+/g;
1496: my $link='';
1497: my $template='';
1498: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1499: if (!$stayOnPage)
1500: {
1501: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1502: }
1503: else
1504: {
1505: $link = $url;
1506: }
1507:
1508: # Add the text
1509: if ($text ne "")
1510: {
1511: $template .=
1.173 www 1512: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1513: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1514: }
1515:
1516: # Add the graphic
1.179 matthew 1517: my $title = &mt('View the FAQ');
1.215 albertel 1518: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1519: $template .= <<"ENDTEMPLATE";
1.436 albertel 1520: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1521: ENDTEMPLATE
1522: if ($text ne '') { $template.='</td></tr></table>' };
1523: return $template;
1524:
1.44 bowersj2 1525: }
1.37 matthew 1526:
1.180 matthew 1527: ###############################################################
1528: ###############################################################
1529:
1.45 matthew 1530: =pod
1531:
1.648 raeburn 1532: =item * &change_content_javascript():
1.256 matthew 1533:
1534: This and the next function allow you to create small sections of an
1535: otherwise static HTML page that you can update on the fly with
1536: Javascript, even in Netscape 4.
1537:
1538: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1539: must be written to the HTML page once. It will prove the Javascript
1540: function "change(name, content)". Calling the change function with the
1541: name of the section
1542: you want to update, matching the name passed to C<changable_area>, and
1543: the new content you want to put in there, will put the content into
1544: that area.
1545:
1546: B<Note>: Netscape 4 only reserves enough space for the changable area
1547: to contain room for the original contents. You need to "make space"
1548: for whatever changes you wish to make, and be B<sure> to check your
1549: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1550: it's adequate for updating a one-line status display, but little more.
1551: This script will set the space to 100% width, so you only need to
1552: worry about height in Netscape 4.
1553:
1554: Modern browsers are much less limiting, and if you can commit to the
1555: user not using Netscape 4, this feature may be used freely with
1556: pretty much any HTML.
1557:
1558: =cut
1559:
1560: sub change_content_javascript {
1561: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1562: if ($env{'browser.type'} eq 'netscape' &&
1563: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1564: return (<<NETSCAPE4);
1565: function change(name, content) {
1566: doc = document.layers[name+"___escape"].layers[0].document;
1567: doc.open();
1568: doc.write(content);
1569: doc.close();
1570: }
1571: NETSCAPE4
1572: } else {
1573: # Otherwise, we need to use semi-standards-compliant code
1574: # (technically, "innerHTML" isn't standard but the equivalent
1575: # is really scary, and every useful browser supports it
1576: return (<<DOMBASED);
1577: function change(name, content) {
1578: element = document.getElementById(name);
1579: element.innerHTML = content;
1580: }
1581: DOMBASED
1582: }
1583: }
1584:
1585: =pod
1586:
1.648 raeburn 1587: =item * &changable_area($name,$origContent):
1.256 matthew 1588:
1589: This provides a "changable area" that can be modified on the fly via
1590: the Javascript code provided in C<change_content_javascript>. $name is
1591: the name you will use to reference the area later; do not repeat the
1592: same name on a given HTML page more then once. $origContent is what
1593: the area will originally contain, which can be left blank.
1594:
1595: =cut
1596:
1597: sub changable_area {
1598: my ($name, $origContent) = @_;
1599:
1.258 albertel 1600: if ($env{'browser.type'} eq 'netscape' &&
1601: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1602: # If this is netscape 4, we need to use the Layer tag
1603: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1604: } else {
1605: return "<span id='$name'>$origContent</span>";
1606: }
1607: }
1608:
1609: =pod
1610:
1.648 raeburn 1611: =item * &viewport_geometry_js
1.590 raeburn 1612:
1613: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1614:
1615: =cut
1616:
1617:
1618: sub viewport_geometry_js {
1619: return <<"GEOMETRY";
1620: var Geometry = {};
1621: function init_geometry() {
1622: if (Geometry.init) { return };
1623: Geometry.init=1;
1624: if (window.innerHeight) {
1625: Geometry.getViewportHeight = function() { return window.innerHeight; };
1626: Geometry.getViewportWidth = function() { return window.innerWidth; };
1627: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1628: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1629: }
1630: else if (document.documentElement && document.documentElement.clientHeight) {
1631: Geometry.getViewportHeight =
1632: function() { return document.documentElement.clientHeight; };
1633: Geometry.getViewportWidth =
1634: function() { return document.documentElement.clientWidth; };
1635:
1636: Geometry.getHorizontalScroll =
1637: function() { return document.documentElement.scrollLeft; };
1638: Geometry.getVerticalScroll =
1639: function() { return document.documentElement.scrollTop; };
1640: }
1641: else if (document.body.clientHeight) {
1642: Geometry.getViewportHeight =
1643: function() { return document.body.clientHeight; };
1644: Geometry.getViewportWidth =
1645: function() { return document.body.clientWidth; };
1646: Geometry.getHorizontalScroll =
1647: function() { return document.body.scrollLeft; };
1648: Geometry.getVerticalScroll =
1649: function() { return document.body.scrollTop; };
1650: }
1651: }
1652:
1653: GEOMETRY
1654: }
1655:
1656: =pod
1657:
1.648 raeburn 1658: =item * &viewport_size_js()
1.590 raeburn 1659:
1660: 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.
1661:
1662: =cut
1663:
1664: sub viewport_size_js {
1665: my $geometry = &viewport_geometry_js();
1666: return <<"DIMS";
1667:
1668: $geometry
1669:
1670: function getViewportDims(width,height) {
1671: init_geometry();
1672: width.value = Geometry.getViewportWidth();
1673: height.value = Geometry.getViewportHeight();
1674: return;
1675: }
1676:
1677: DIMS
1678: }
1679:
1680: =pod
1681:
1.648 raeburn 1682: =item * &resize_textarea_js()
1.565 albertel 1683:
1684: emits the needed javascript to resize a textarea to be as big as possible
1685:
1686: creates a function resize_textrea that takes two IDs first should be
1687: the id of the element to resize, second should be the id of a div that
1688: surrounds everything that comes after the textarea, this routine needs
1689: to be attached to the <body> for the onload and onresize events.
1690:
1.648 raeburn 1691: =back
1.565 albertel 1692:
1693: =cut
1694:
1695: sub resize_textarea_js {
1.590 raeburn 1696: my $geometry = &viewport_geometry_js();
1.565 albertel 1697: return <<"RESIZE";
1698: <script type="text/javascript">
1.824 bisitz 1699: // <![CDATA[
1.590 raeburn 1700: $geometry
1.565 albertel 1701:
1.588 albertel 1702: function getX(element) {
1703: var x = 0;
1704: while (element) {
1705: x += element.offsetLeft;
1706: element = element.offsetParent;
1707: }
1708: return x;
1709: }
1710: function getY(element) {
1711: var y = 0;
1712: while (element) {
1713: y += element.offsetTop;
1714: element = element.offsetParent;
1715: }
1716: return y;
1717: }
1718:
1719:
1.565 albertel 1720: function resize_textarea(textarea_id,bottom_id) {
1721: init_geometry();
1722: var textarea = document.getElementById(textarea_id);
1723: //alert(textarea);
1724:
1.588 albertel 1725: var textarea_top = getY(textarea);
1.565 albertel 1726: var textarea_height = textarea.offsetHeight;
1727: var bottom = document.getElementById(bottom_id);
1.588 albertel 1728: var bottom_top = getY(bottom);
1.565 albertel 1729: var bottom_height = bottom.offsetHeight;
1730: var window_height = Geometry.getViewportHeight();
1.588 albertel 1731: var fudge = 23;
1.565 albertel 1732: var new_height = window_height-fudge-textarea_top-bottom_height;
1733: if (new_height < 300) {
1734: new_height = 300;
1735: }
1736: textarea.style.height=new_height+'px';
1737: }
1.824 bisitz 1738: // ]]>
1.565 albertel 1739: </script>
1740: RESIZE
1741:
1742: }
1743:
1744: =pod
1745:
1.256 matthew 1746: =head1 Excel and CSV file utility routines
1747:
1748: =cut
1749:
1750: ###############################################################
1751: ###############################################################
1752:
1753: =pod
1754:
1.1075.2.56 raeburn 1755: =over 4
1756:
1.648 raeburn 1757: =item * &csv_translate($text)
1.37 matthew 1758:
1.185 www 1759: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1760: format.
1761:
1762: =cut
1763:
1.180 matthew 1764: ###############################################################
1765: ###############################################################
1.37 matthew 1766: sub csv_translate {
1767: my $text = shift;
1768: $text =~ s/\"/\"\"/g;
1.209 albertel 1769: $text =~ s/\n/ /g;
1.37 matthew 1770: return $text;
1771: }
1.180 matthew 1772:
1773: ###############################################################
1774: ###############################################################
1775:
1776: =pod
1777:
1.648 raeburn 1778: =item * &define_excel_formats()
1.180 matthew 1779:
1780: Define some commonly used Excel cell formats.
1781:
1782: Currently supported formats:
1783:
1784: =over 4
1785:
1786: =item header
1787:
1788: =item bold
1789:
1790: =item h1
1791:
1792: =item h2
1793:
1794: =item h3
1795:
1.256 matthew 1796: =item h4
1797:
1798: =item i
1799:
1.180 matthew 1800: =item date
1801:
1802: =back
1803:
1804: Inputs: $workbook
1805:
1806: Returns: $format, a hash reference.
1807:
1.1057 foxr 1808:
1.180 matthew 1809: =cut
1810:
1811: ###############################################################
1812: ###############################################################
1813: sub define_excel_formats {
1814: my ($workbook) = @_;
1815: my $format;
1816: $format->{'header'} = $workbook->add_format(bold => 1,
1817: bottom => 1,
1818: align => 'center');
1819: $format->{'bold'} = $workbook->add_format(bold=>1);
1820: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1821: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1822: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1823: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1824: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1825: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1826: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1827: return $format;
1828: }
1829:
1830: ###############################################################
1831: ###############################################################
1.113 bowersj2 1832:
1833: =pod
1834:
1.648 raeburn 1835: =item * &create_workbook()
1.255 matthew 1836:
1837: Create an Excel worksheet. If it fails, output message on the
1838: request object and return undefs.
1839:
1840: Inputs: Apache request object
1841:
1842: Returns (undef) on failure,
1843: Excel worksheet object, scalar with filename, and formats
1844: from &Apache::loncommon::define_excel_formats on success
1845:
1846: =cut
1847:
1848: ###############################################################
1849: ###############################################################
1850: sub create_workbook {
1851: my ($r) = @_;
1852: #
1853: # Create the excel spreadsheet
1854: my $filename = '/prtspool/'.
1.258 albertel 1855: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1856: time.'_'.rand(1000000000).'.xls';
1857: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1858: if (! defined($workbook)) {
1859: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1860: $r->print(
1861: '<p class="LC_error">'
1862: .&mt('Problems occurred in creating the new Excel file.')
1863: .' '.&mt('This error has been logged.')
1864: .' '.&mt('Please alert your LON-CAPA administrator.')
1865: .'</p>'
1866: );
1.255 matthew 1867: return (undef);
1868: }
1869: #
1.1014 foxr 1870: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1871: #
1872: my $format = &Apache::loncommon::define_excel_formats($workbook);
1873: return ($workbook,$filename,$format);
1874: }
1875:
1876: ###############################################################
1877: ###############################################################
1878:
1879: =pod
1880:
1.648 raeburn 1881: =item * &create_text_file()
1.113 bowersj2 1882:
1.542 raeburn 1883: Create a file to write to and eventually make available to the user.
1.256 matthew 1884: If file creation fails, outputs an error message on the request object and
1885: return undefs.
1.113 bowersj2 1886:
1.256 matthew 1887: Inputs: Apache request object, and file suffix
1.113 bowersj2 1888:
1.256 matthew 1889: Returns (undef) on failure,
1890: Filehandle and filename on success.
1.113 bowersj2 1891:
1892: =cut
1893:
1.256 matthew 1894: ###############################################################
1895: ###############################################################
1896: sub create_text_file {
1897: my ($r,$suffix) = @_;
1898: if (! defined($suffix)) { $suffix = 'txt'; };
1899: my $fh;
1900: my $filename = '/prtspool/'.
1.258 albertel 1901: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1902: time.'_'.rand(1000000000).'.'.$suffix;
1903: $fh = Apache::File->new('>/home/httpd'.$filename);
1904: if (! defined($fh)) {
1905: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1906: $r->print(
1907: '<p class="LC_error">'
1908: .&mt('Problems occurred in creating the output file.')
1909: .' '.&mt('This error has been logged.')
1910: .' '.&mt('Please alert your LON-CAPA administrator.')
1911: .'</p>'
1912: );
1.113 bowersj2 1913: }
1.256 matthew 1914: return ($fh,$filename)
1.113 bowersj2 1915: }
1916:
1917:
1.256 matthew 1918: =pod
1.113 bowersj2 1919:
1920: =back
1921:
1922: =cut
1.37 matthew 1923:
1924: ###############################################################
1.33 matthew 1925: ## Home server <option> list generating code ##
1926: ###############################################################
1.35 matthew 1927:
1.169 www 1928: # ------------------------------------------
1929:
1930: sub domain_select {
1931: my ($name,$value,$multiple)=@_;
1932: my %domains=map {
1.514 albertel 1933: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1934: } &Apache::lonnet::all_domains();
1.169 www 1935: if ($multiple) {
1936: $domains{''}=&mt('Any domain');
1.550 albertel 1937: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1938: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1939: } else {
1.550 albertel 1940: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1941: return &select_form($name,$value,\%domains);
1.169 www 1942: }
1943: }
1944:
1.282 albertel 1945: #-------------------------------------------
1946:
1947: =pod
1948:
1.519 raeburn 1949: =head1 Routines for form select boxes
1950:
1951: =over 4
1952:
1.648 raeburn 1953: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1954:
1955: Returns a string containing a <select> element int multiple mode
1956:
1957:
1958: Args:
1959: $name - name of the <select> element
1.506 raeburn 1960: $value - scalar or array ref of values that should already be selected
1.282 albertel 1961: $size - number of rows long the select element is
1.283 albertel 1962: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1963: (shown text should already have been &mt())
1.506 raeburn 1964: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1965:
1.282 albertel 1966: =cut
1967:
1968: #-------------------------------------------
1.169 www 1969: sub multiple_select_form {
1.284 albertel 1970: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1971: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1972: my $output='';
1.191 matthew 1973: if (! defined($size)) {
1974: $size = 4;
1.283 albertel 1975: if (scalar(keys(%$hash))<4) {
1976: $size = scalar(keys(%$hash));
1.191 matthew 1977: }
1978: }
1.734 bisitz 1979: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1980: my @order;
1.506 raeburn 1981: if (ref($order) eq 'ARRAY') {
1982: @order = @{$order};
1983: } else {
1984: @order = sort(keys(%$hash));
1.501 banghart 1985: }
1986: if (exists($$hash{'select_form_order'})) {
1987: @order = @{$$hash{'select_form_order'}};
1988: }
1989:
1.284 albertel 1990: foreach my $key (@order) {
1.356 albertel 1991: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1992: $output.='selected="selected" ' if ($selected{$key});
1993: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1994: }
1995: $output.="</select>\n";
1996: return $output;
1997: }
1998:
1.88 www 1999: #-------------------------------------------
2000:
2001: =pod
2002:
1.970 raeburn 2003: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 2004:
2005: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2006: allow a user to select options from a ref to a hash containing:
2007: option_name => displayed text. An optional $onchange can include
2008: a javascript onchange item, e.g., onchange="this.form.submit();"
2009:
1.88 www 2010: See lonrights.pm for an example invocation and use.
2011:
2012: =cut
2013:
2014: #-------------------------------------------
2015: sub select_form {
1.970 raeburn 2016: my ($def,$name,$hashref,$onchange) = @_;
2017: return unless (ref($hashref) eq 'HASH');
2018: if ($onchange) {
2019: $onchange = ' onchange="'.$onchange.'"';
2020: }
2021: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2022: my @keys;
1.970 raeburn 2023: if (exists($hashref->{'select_form_order'})) {
2024: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2025: } else {
1.970 raeburn 2026: @keys=sort(keys(%{$hashref}));
1.128 albertel 2027: }
1.356 albertel 2028: foreach my $key (@keys) {
2029: $selectform.=
2030: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2031: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2032: ">".$hashref->{$key}."</option>\n";
1.88 www 2033: }
2034: $selectform.="</select>";
2035: return $selectform;
2036: }
2037:
1.475 www 2038: # For display filters
2039:
2040: sub display_filter {
1.1074 raeburn 2041: my ($context) = @_;
1.475 www 2042: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2043: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2044: my $phraseinput = 'hidden';
2045: my $includeinput = 'hidden';
2046: my ($checked,$includetypestext);
2047: if ($env{'form.displayfilter'} eq 'containing') {
2048: $phraseinput = 'text';
2049: if ($context eq 'parmslog') {
2050: $includeinput = 'checkbox';
2051: if ($env{'form.includetypes'}) {
2052: $checked = ' checked="checked"';
2053: }
2054: $includetypestext = &mt('Include parameter types');
2055: }
2056: } else {
2057: $includetypestext = ' ';
2058: }
2059: my ($additional,$secondid,$thirdid);
2060: if ($context eq 'parmslog') {
2061: $additional =
2062: '<label><input type="'.$includeinput.'" name="includetypes"'.
2063: $checked.' name="includetypes" value="1" id="includetypes" />'.
2064: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2065: '</label>';
2066: $secondid = 'includetypes';
2067: $thirdid = 'includetypestext';
2068: }
2069: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2070: '$secondid','$thirdid')";
2071: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2072: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2073: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2074: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2075: &mt('Filter: [_1]',
1.477 www 2076: &select_form($env{'form.displayfilter'},
2077: 'displayfilter',
1.970 raeburn 2078: {'currentfolder' => 'Current folder/page',
1.477 www 2079: 'containing' => 'Containing phrase',
1.1074 raeburn 2080: 'none' => 'None'},$onchange)).' '.
2081: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2082: &HTML::Entities::encode($env{'form.containingphrase'}).
2083: '" />'.$additional;
2084: }
2085:
2086: sub display_filter_js {
2087: my $includetext = &mt('Include parameter types');
2088: return <<"ENDJS";
2089:
2090: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2091: var firstType = 'hidden';
2092: if (setter.options[setter.selectedIndex].value == 'containing') {
2093: firstType = 'text';
2094: }
2095: firstObject = document.getElementById(firstid);
2096: if (typeof(firstObject) == 'object') {
2097: if (firstObject.type != firstType) {
2098: changeInputType(firstObject,firstType);
2099: }
2100: }
2101: if (context == 'parmslog') {
2102: var secondType = 'hidden';
2103: if (firstType == 'text') {
2104: secondType = 'checkbox';
2105: }
2106: secondObject = document.getElementById(secondid);
2107: if (typeof(secondObject) == 'object') {
2108: if (secondObject.type != secondType) {
2109: changeInputType(secondObject,secondType);
2110: }
2111: }
2112: var textItem = document.getElementById(thirdid);
2113: var currtext = textItem.innerHTML;
2114: var newtext;
2115: if (firstType == 'text') {
2116: newtext = '$includetext';
2117: } else {
2118: newtext = ' ';
2119: }
2120: if (currtext != newtext) {
2121: textItem.innerHTML = newtext;
2122: }
2123: }
2124: return;
2125: }
2126:
2127: function changeInputType(oldObject,newType) {
2128: var newObject = document.createElement('input');
2129: newObject.type = newType;
2130: if (oldObject.size) {
2131: newObject.size = oldObject.size;
2132: }
2133: if (oldObject.value) {
2134: newObject.value = oldObject.value;
2135: }
2136: if (oldObject.name) {
2137: newObject.name = oldObject.name;
2138: }
2139: if (oldObject.id) {
2140: newObject.id = oldObject.id;
2141: }
2142: oldObject.parentNode.replaceChild(newObject,oldObject);
2143: return;
2144: }
2145:
2146: ENDJS
1.475 www 2147: }
2148:
1.167 www 2149: sub gradeleveldescription {
2150: my $gradelevel=shift;
2151: my %gradelevels=(0 => 'Not specified',
2152: 1 => 'Grade 1',
2153: 2 => 'Grade 2',
2154: 3 => 'Grade 3',
2155: 4 => 'Grade 4',
2156: 5 => 'Grade 5',
2157: 6 => 'Grade 6',
2158: 7 => 'Grade 7',
2159: 8 => 'Grade 8',
2160: 9 => 'Grade 9',
2161: 10 => 'Grade 10',
2162: 11 => 'Grade 11',
2163: 12 => 'Grade 12',
2164: 13 => 'Grade 13',
2165: 14 => '100 Level',
2166: 15 => '200 Level',
2167: 16 => '300 Level',
2168: 17 => '400 Level',
2169: 18 => 'Graduate Level');
2170: return &mt($gradelevels{$gradelevel});
2171: }
2172:
1.163 www 2173: sub select_level_form {
2174: my ($deflevel,$name)=@_;
2175: unless ($deflevel) { $deflevel=0; }
1.167 www 2176: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2177: for (my $i=0; $i<=18; $i++) {
2178: $selectform.="<option value=\"$i\" ".
1.253 albertel 2179: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2180: ">".&gradeleveldescription($i)."</option>\n";
2181: }
2182: $selectform.="</select>";
2183: return $selectform;
1.163 www 2184: }
1.167 www 2185:
1.35 matthew 2186: #-------------------------------------------
2187:
1.45 matthew 2188: =pod
2189:
1.1075.2.42 raeburn 2190: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2191:
2192: Returns a string containing a <select name='$name' size='1'> form to
2193: allow a user to select the domain to preform an operation in.
2194: See loncreateuser.pm for an example invocation and use.
2195:
1.90 www 2196: If the $includeempty flag is set, it also includes an empty choice ("no domain
2197: selected");
2198:
1.743 raeburn 2199: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2200:
1.910 raeburn 2201: 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.
2202:
1.1075.2.36 raeburn 2203: The optional $incdoms is a reference to an array of domains which will be the only available options.
2204:
2205: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2206:
1.35 matthew 2207: =cut
2208:
2209: #-------------------------------------------
1.34 matthew 2210: sub select_dom_form {
1.1075.2.36 raeburn 2211: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2212: if ($onchange) {
1.874 raeburn 2213: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2214: }
1.1075.2.36 raeburn 2215: my (@domains,%exclude);
1.910 raeburn 2216: if (ref($incdoms) eq 'ARRAY') {
2217: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2218: } else {
2219: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2220: }
1.90 www 2221: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2222: if (ref($excdoms) eq 'ARRAY') {
2223: map { $exclude{$_} = 1; } @{$excdoms};
2224: }
1.743 raeburn 2225: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2226: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2227: next if ($exclude{$dom});
1.356 albertel 2228: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2229: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2230: if ($showdomdesc) {
2231: if ($dom ne '') {
2232: my $domdesc = &Apache::lonnet::domain($dom,'description');
2233: if ($domdesc ne '') {
2234: $selectdomain .= ' ('.$domdesc.')';
2235: }
2236: }
2237: }
2238: $selectdomain .= "</option>\n";
1.34 matthew 2239: }
2240: $selectdomain.="</select>";
2241: return $selectdomain;
2242: }
2243:
1.35 matthew 2244: #-------------------------------------------
2245:
1.45 matthew 2246: =pod
2247:
1.648 raeburn 2248: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2249:
1.586 raeburn 2250: input: 4 arguments (two required, two optional) -
2251: $domain - domain of new user
2252: $name - name of form element
2253: $default - Value of 'default' causes a default item to be first
2254: option, and selected by default.
2255: $hide - Value of 'hide' causes hiding of the name of the server,
2256: if 1 server found, or default, if 0 found.
1.594 raeburn 2257: output: returns 2 items:
1.586 raeburn 2258: (a) form element which contains either:
2259: (i) <select name="$name">
2260: <option value="$hostid1">$hostid $servers{$hostid}</option>
2261: <option value="$hostid2">$hostid $servers{$hostid}</option>
2262: </select>
2263: form item if there are multiple library servers in $domain, or
2264: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2265: if there is only one library server in $domain.
2266:
2267: (b) number of library servers found.
2268:
2269: See loncreateuser.pm for example of use.
1.35 matthew 2270:
2271: =cut
2272:
2273: #-------------------------------------------
1.586 raeburn 2274: sub home_server_form_item {
2275: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2276: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2277: my $result;
2278: my $numlib = keys(%servers);
2279: if ($numlib > 1) {
2280: $result .= '<select name="'.$name.'" />'."\n";
2281: if ($default) {
1.804 bisitz 2282: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2283: '</option>'."\n";
2284: }
2285: foreach my $hostid (sort(keys(%servers))) {
2286: $result.= '<option value="'.$hostid.'">'.
2287: $hostid.' '.$servers{$hostid}."</option>\n";
2288: }
2289: $result .= '</select>'."\n";
2290: } elsif ($numlib == 1) {
2291: my $hostid;
2292: foreach my $item (keys(%servers)) {
2293: $hostid = $item;
2294: }
2295: $result .= '<input type="hidden" name="'.$name.'" value="'.
2296: $hostid.'" />';
2297: if (!$hide) {
2298: $result .= $hostid.' '.$servers{$hostid};
2299: }
2300: $result .= "\n";
2301: } elsif ($default) {
2302: $result .= '<input type="hidden" name="'.$name.
2303: '" value="default" />';
2304: if (!$hide) {
2305: $result .= &mt('default');
2306: }
2307: $result .= "\n";
1.33 matthew 2308: }
1.586 raeburn 2309: return ($result,$numlib);
1.33 matthew 2310: }
1.112 bowersj2 2311:
2312: =pod
2313:
1.534 albertel 2314: =back
2315:
1.112 bowersj2 2316: =cut
1.87 matthew 2317:
2318: ###############################################################
1.112 bowersj2 2319: ## Decoding User Agent ##
1.87 matthew 2320: ###############################################################
2321:
2322: =pod
2323:
1.112 bowersj2 2324: =head1 Decoding the User Agent
2325:
2326: =over 4
2327:
2328: =item * &decode_user_agent()
1.87 matthew 2329:
2330: Inputs: $r
2331:
2332: Outputs:
2333:
2334: =over 4
2335:
1.112 bowersj2 2336: =item * $httpbrowser
1.87 matthew 2337:
1.112 bowersj2 2338: =item * $clientbrowser
1.87 matthew 2339:
1.112 bowersj2 2340: =item * $clientversion
1.87 matthew 2341:
1.112 bowersj2 2342: =item * $clientmathml
1.87 matthew 2343:
1.112 bowersj2 2344: =item * $clientunicode
1.87 matthew 2345:
1.112 bowersj2 2346: =item * $clientos
1.87 matthew 2347:
1.1075.2.42 raeburn 2348: =item * $clientmobile
2349:
2350: =item * $clientinfo
2351:
1.1075.2.77 raeburn 2352: =item * $clientosversion
2353:
1.87 matthew 2354: =back
2355:
1.157 matthew 2356: =back
2357:
1.87 matthew 2358: =cut
2359:
2360: ###############################################################
2361: ###############################################################
2362: sub decode_user_agent {
1.247 albertel 2363: my ($r)=@_;
1.87 matthew 2364: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2365: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2366: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2367: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2368: my $clientbrowser='unknown';
2369: my $clientversion='0';
2370: my $clientmathml='';
2371: my $clientunicode='0';
1.1075.2.42 raeburn 2372: my $clientmobile=0;
1.1075.2.77 raeburn 2373: my $clientosversion='';
1.87 matthew 2374: for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76 raeburn 2375: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2376: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2377: $clientbrowser=$bname;
2378: $httpbrowser=~/$vreg/i;
2379: $clientversion=$1;
2380: $clientmathml=($clientversion>=$minv);
2381: $clientunicode=($clientversion>=$univ);
2382: }
2383: }
2384: my $clientos='unknown';
1.1075.2.42 raeburn 2385: my $clientinfo;
1.87 matthew 2386: if (($httpbrowser=~/linux/i) ||
2387: ($httpbrowser=~/unix/i) ||
2388: ($httpbrowser=~/ux/i) ||
2389: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2390: if (($httpbrowser=~/vax/i) ||
2391: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2392: if ($httpbrowser=~/next/i) { $clientos='next'; }
2393: if (($httpbrowser=~/mac/i) ||
2394: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77 raeburn 2395: if ($httpbrowser=~/win/i) {
2396: $clientos='win';
2397: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2398: $clientosversion = $1;
2399: }
2400: }
1.87 matthew 2401: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2402: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2403: $clientmobile=lc($1);
2404: }
2405: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2406: $clientinfo = 'firefox-'.$1;
2407: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2408: $clientinfo = 'chromeframe-'.$1;
2409: }
1.87 matthew 2410: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77 raeburn 2411: $clientunicode,$clientos,$clientmobile,$clientinfo,
2412: $clientosversion);
1.87 matthew 2413: }
2414:
1.32 matthew 2415: ###############################################################
2416: ## Authentication changing form generation subroutines ##
2417: ###############################################################
2418: ##
2419: ## All of the authform_xxxxxxx subroutines take their inputs in a
2420: ## hash, and have reasonable default values.
2421: ##
2422: ## formname = the name given in the <form> tag.
1.35 matthew 2423: #-------------------------------------------
2424:
1.45 matthew 2425: =pod
2426:
1.112 bowersj2 2427: =head1 Authentication Routines
2428:
2429: =over 4
2430:
1.648 raeburn 2431: =item * &authform_xxxxxx()
1.35 matthew 2432:
2433: The authform_xxxxxx subroutines provide javascript and html forms which
2434: handle some of the conveniences required for authentication forms.
2435: This is not an optimal method, but it works.
2436:
2437: =over 4
2438:
1.112 bowersj2 2439: =item * authform_header
1.35 matthew 2440:
1.112 bowersj2 2441: =item * authform_authorwarning
1.35 matthew 2442:
1.112 bowersj2 2443: =item * authform_nochange
1.35 matthew 2444:
1.112 bowersj2 2445: =item * authform_kerberos
1.35 matthew 2446:
1.112 bowersj2 2447: =item * authform_internal
1.35 matthew 2448:
1.112 bowersj2 2449: =item * authform_filesystem
1.35 matthew 2450:
2451: =back
2452:
1.648 raeburn 2453: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2454:
1.35 matthew 2455: =cut
2456:
2457: #-------------------------------------------
1.32 matthew 2458: sub authform_header{
2459: my %in = (
2460: formname => 'cu',
1.80 albertel 2461: kerb_def_dom => '',
1.32 matthew 2462: @_,
2463: );
2464: $in{'formname'} = 'document.' . $in{'formname'};
2465: my $result='';
1.80 albertel 2466:
2467: #---------------------------------------------- Code for upper case translation
2468: my $Javascript_toUpperCase;
2469: unless ($in{kerb_def_dom}) {
2470: $Javascript_toUpperCase =<<"END";
2471: switch (choice) {
2472: case 'krb': currentform.elements[choicearg].value =
2473: currentform.elements[choicearg].value.toUpperCase();
2474: break;
2475: default:
2476: }
2477: END
2478: } else {
2479: $Javascript_toUpperCase = "";
2480: }
2481:
1.165 raeburn 2482: my $radioval = "'nochange'";
1.591 raeburn 2483: if (defined($in{'curr_authtype'})) {
2484: if ($in{'curr_authtype'} ne '') {
2485: $radioval = "'".$in{'curr_authtype'}."arg'";
2486: }
1.174 matthew 2487: }
1.165 raeburn 2488: my $argfield = 'null';
1.591 raeburn 2489: if (defined($in{'mode'})) {
1.165 raeburn 2490: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2491: if (defined($in{'curr_autharg'})) {
2492: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2493: $argfield = "'$in{'curr_autharg'}'";
2494: }
2495: }
2496: }
2497: }
2498:
1.32 matthew 2499: $result.=<<"END";
2500: var current = new Object();
1.165 raeburn 2501: current.radiovalue = $radioval;
2502: current.argfield = $argfield;
1.32 matthew 2503:
2504: function changed_radio(choice,currentform) {
2505: var choicearg = choice + 'arg';
2506: // If a radio button in changed, we need to change the argfield
2507: if (current.radiovalue != choice) {
2508: current.radiovalue = choice;
2509: if (current.argfield != null) {
2510: currentform.elements[current.argfield].value = '';
2511: }
2512: if (choice == 'nochange') {
2513: current.argfield = null;
2514: } else {
2515: current.argfield = choicearg;
2516: switch(choice) {
2517: case 'krb':
2518: currentform.elements[current.argfield].value =
2519: "$in{'kerb_def_dom'}";
2520: break;
2521: default:
2522: break;
2523: }
2524: }
2525: }
2526: return;
2527: }
1.22 www 2528:
1.32 matthew 2529: function changed_text(choice,currentform) {
2530: var choicearg = choice + 'arg';
2531: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2532: $Javascript_toUpperCase
1.32 matthew 2533: // clear old field
2534: if ((current.argfield != choicearg) && (current.argfield != null)) {
2535: currentform.elements[current.argfield].value = '';
2536: }
2537: current.argfield = choicearg;
2538: }
2539: set_auth_radio_buttons(choice,currentform);
2540: return;
1.20 www 2541: }
1.32 matthew 2542:
2543: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2544: var numauthchoices = currentform.login.length;
2545: if (typeof numauthchoices == "undefined") {
2546: return;
2547: }
1.32 matthew 2548: var i=0;
1.986 raeburn 2549: while (i < numauthchoices) {
1.32 matthew 2550: if (currentform.login[i].value == newvalue) { break; }
2551: i++;
2552: }
1.986 raeburn 2553: if (i == numauthchoices) {
1.32 matthew 2554: return;
2555: }
2556: current.radiovalue = newvalue;
2557: currentform.login[i].checked = true;
2558: return;
2559: }
2560: END
2561: return $result;
2562: }
2563:
1.1075.2.20 raeburn 2564: sub authform_authorwarning {
1.32 matthew 2565: my $result='';
1.144 matthew 2566: $result='<i>'.
2567: &mt('As a general rule, only authors or co-authors should be '.
2568: 'filesystem authenticated '.
2569: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2570: return $result;
2571: }
2572:
1.1075.2.20 raeburn 2573: sub authform_nochange {
1.32 matthew 2574: my %in = (
2575: formname => 'document.cu',
2576: kerb_def_dom => 'MSU.EDU',
2577: @_,
2578: );
1.1075.2.20 raeburn 2579: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2580: my $result;
1.1075.2.20 raeburn 2581: if (!$authnum) {
2582: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2583: } else {
2584: $result = '<label>'.&mt('[_1] Do not change login data',
2585: '<input type="radio" name="login" value="nochange" '.
2586: 'checked="checked" onclick="'.
1.281 albertel 2587: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2588: '</label>';
1.586 raeburn 2589: }
1.32 matthew 2590: return $result;
2591: }
2592:
1.591 raeburn 2593: sub authform_kerberos {
1.32 matthew 2594: my %in = (
2595: formname => 'document.cu',
2596: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2597: kerb_def_auth => 'krb4',
1.32 matthew 2598: @_,
2599: );
1.586 raeburn 2600: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2601: $autharg,$jscall);
1.1075.2.20 raeburn 2602: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2603: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2604: $check5 = ' checked="checked"';
1.80 albertel 2605: } else {
1.772 bisitz 2606: $check4 = ' checked="checked"';
1.80 albertel 2607: }
1.165 raeburn 2608: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2609: if (defined($in{'curr_authtype'})) {
2610: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2611: $krbcheck = ' checked="checked"';
1.623 raeburn 2612: if (defined($in{'mode'})) {
2613: if ($in{'mode'} eq 'modifyuser') {
2614: $krbcheck = '';
2615: }
2616: }
1.591 raeburn 2617: if (defined($in{'curr_kerb_ver'})) {
2618: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2619: $check5 = ' checked="checked"';
1.591 raeburn 2620: $check4 = '';
2621: } else {
1.772 bisitz 2622: $check4 = ' checked="checked"';
1.591 raeburn 2623: $check5 = '';
2624: }
1.586 raeburn 2625: }
1.591 raeburn 2626: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2627: $krbarg = $in{'curr_autharg'};
2628: }
1.586 raeburn 2629: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2630: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2631: $result =
2632: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2633: $in{'curr_autharg'},$krbver);
2634: } else {
2635: $result =
2636: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2637: }
2638: return $result;
2639: }
2640: }
2641: } else {
2642: if ($authnum == 1) {
1.784 bisitz 2643: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2644: }
2645: }
1.586 raeburn 2646: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2647: return;
1.587 raeburn 2648: } elsif ($authtype eq '') {
1.591 raeburn 2649: if (defined($in{'mode'})) {
1.587 raeburn 2650: if ($in{'mode'} eq 'modifycourse') {
2651: if ($authnum == 1) {
1.1075.2.20 raeburn 2652: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2653: }
2654: }
2655: }
1.586 raeburn 2656: }
2657: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2658: if ($authtype eq '') {
2659: $authtype = '<input type="radio" name="login" value="krb" '.
2660: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2661: $krbcheck.' />';
2662: }
2663: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2664: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2665: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2666: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2667: $in{'curr_authtype'} eq 'krb4')) {
2668: $result .= &mt
1.144 matthew 2669: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2670: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2671: '<label>'.$authtype,
1.281 albertel 2672: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2673: 'value="'.$krbarg.'" '.
1.144 matthew 2674: 'onchange="'.$jscall.'" />',
1.281 albertel 2675: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2676: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2677: '</label>');
1.586 raeburn 2678: } elsif ($can_assign{'krb4'}) {
2679: $result .= &mt
2680: ('[_1] Kerberos authenticated with domain [_2] '.
2681: '[_3] Version 4 [_4]',
2682: '<label>'.$authtype,
2683: '</label><input type="text" size="10" name="krbarg" '.
2684: 'value="'.$krbarg.'" '.
2685: 'onchange="'.$jscall.'" />',
2686: '<label><input type="hidden" name="krbver" value="4" />',
2687: '</label>');
2688: } elsif ($can_assign{'krb5'}) {
2689: $result .= &mt
2690: ('[_1] Kerberos authenticated with domain [_2] '.
2691: '[_3] Version 5 [_4]',
2692: '<label>'.$authtype,
2693: '</label><input type="text" size="10" name="krbarg" '.
2694: 'value="'.$krbarg.'" '.
2695: 'onchange="'.$jscall.'" />',
2696: '<label><input type="hidden" name="krbver" value="5" />',
2697: '</label>');
2698: }
1.32 matthew 2699: return $result;
2700: }
2701:
1.1075.2.20 raeburn 2702: sub authform_internal {
1.586 raeburn 2703: my %in = (
1.32 matthew 2704: formname => 'document.cu',
2705: kerb_def_dom => 'MSU.EDU',
2706: @_,
2707: );
1.586 raeburn 2708: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2709: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2710: if (defined($in{'curr_authtype'})) {
2711: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2712: if ($can_assign{'int'}) {
1.772 bisitz 2713: $intcheck = 'checked="checked" ';
1.623 raeburn 2714: if (defined($in{'mode'})) {
2715: if ($in{'mode'} eq 'modifyuser') {
2716: $intcheck = '';
2717: }
2718: }
1.591 raeburn 2719: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2720: $intarg = $in{'curr_autharg'};
2721: }
2722: } else {
2723: $result = &mt('Currently internally authenticated.');
2724: return $result;
1.165 raeburn 2725: }
2726: }
1.586 raeburn 2727: } else {
2728: if ($authnum == 1) {
1.784 bisitz 2729: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2730: }
2731: }
2732: if (!$can_assign{'int'}) {
2733: return;
1.587 raeburn 2734: } elsif ($authtype eq '') {
1.591 raeburn 2735: if (defined($in{'mode'})) {
1.587 raeburn 2736: if ($in{'mode'} eq 'modifycourse') {
2737: if ($authnum == 1) {
1.1075.2.20 raeburn 2738: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2739: }
2740: }
2741: }
1.165 raeburn 2742: }
1.586 raeburn 2743: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2744: if ($authtype eq '') {
2745: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2746: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2747: }
1.605 bisitz 2748: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2749: $intarg.'" onchange="'.$jscall.'" />';
2750: $result = &mt
1.144 matthew 2751: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2752: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2753: $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 2754: return $result;
2755: }
2756:
1.1075.2.20 raeburn 2757: sub authform_local {
1.32 matthew 2758: my %in = (
2759: formname => 'document.cu',
2760: kerb_def_dom => 'MSU.EDU',
2761: @_,
2762: );
1.586 raeburn 2763: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2764: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2765: if (defined($in{'curr_authtype'})) {
2766: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2767: if ($can_assign{'loc'}) {
1.772 bisitz 2768: $loccheck = 'checked="checked" ';
1.623 raeburn 2769: if (defined($in{'mode'})) {
2770: if ($in{'mode'} eq 'modifyuser') {
2771: $loccheck = '';
2772: }
2773: }
1.591 raeburn 2774: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2775: $locarg = $in{'curr_autharg'};
2776: }
2777: } else {
2778: $result = &mt('Currently using local (institutional) authentication.');
2779: return $result;
1.165 raeburn 2780: }
2781: }
1.586 raeburn 2782: } else {
2783: if ($authnum == 1) {
1.784 bisitz 2784: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2785: }
2786: }
2787: if (!$can_assign{'loc'}) {
2788: return;
1.587 raeburn 2789: } elsif ($authtype eq '') {
1.591 raeburn 2790: if (defined($in{'mode'})) {
1.587 raeburn 2791: if ($in{'mode'} eq 'modifycourse') {
2792: if ($authnum == 1) {
1.1075.2.20 raeburn 2793: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 2794: }
2795: }
2796: }
1.165 raeburn 2797: }
1.586 raeburn 2798: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2799: if ($authtype eq '') {
2800: $authtype = '<input type="radio" name="login" value="loc" '.
2801: $loccheck.' onchange="'.$jscall.'" onclick="'.
2802: $jscall.'" />';
2803: }
2804: $autharg = '<input type="text" size="10" name="locarg" value="'.
2805: $locarg.'" onchange="'.$jscall.'" />';
2806: $result = &mt('[_1] Local Authentication with argument [_2]',
2807: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2808: return $result;
2809: }
2810:
1.1075.2.20 raeburn 2811: sub authform_filesystem {
1.32 matthew 2812: my %in = (
2813: formname => 'document.cu',
2814: kerb_def_dom => 'MSU.EDU',
2815: @_,
2816: );
1.586 raeburn 2817: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2818: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2819: if (defined($in{'curr_authtype'})) {
2820: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2821: if ($can_assign{'fsys'}) {
1.772 bisitz 2822: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2823: if (defined($in{'mode'})) {
2824: if ($in{'mode'} eq 'modifyuser') {
2825: $fsyscheck = '';
2826: }
2827: }
1.586 raeburn 2828: } else {
2829: $result = &mt('Currently Filesystem Authenticated.');
2830: return $result;
2831: }
2832: }
2833: } else {
2834: if ($authnum == 1) {
1.784 bisitz 2835: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2836: }
2837: }
2838: if (!$can_assign{'fsys'}) {
2839: return;
1.587 raeburn 2840: } elsif ($authtype eq '') {
1.591 raeburn 2841: if (defined($in{'mode'})) {
1.587 raeburn 2842: if ($in{'mode'} eq 'modifycourse') {
2843: if ($authnum == 1) {
1.1075.2.20 raeburn 2844: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 2845: }
2846: }
2847: }
1.586 raeburn 2848: }
2849: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2850: if ($authtype eq '') {
2851: $authtype = '<input type="radio" name="login" value="fsys" '.
2852: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2853: $jscall.'" />';
2854: }
2855: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2856: ' onchange="'.$jscall.'" />';
2857: $result = &mt
1.144 matthew 2858: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2859: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2860: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2861: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2862: 'onchange="'.$jscall.'" />');
1.32 matthew 2863: return $result;
2864: }
2865:
1.586 raeburn 2866: sub get_assignable_auth {
2867: my ($dom) = @_;
2868: if ($dom eq '') {
2869: $dom = $env{'request.role.domain'};
2870: }
2871: my %can_assign = (
2872: krb4 => 1,
2873: krb5 => 1,
2874: int => 1,
2875: loc => 1,
2876: );
2877: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2878: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2879: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2880: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2881: my $context;
2882: if ($env{'request.role'} =~ /^au/) {
2883: $context = 'author';
2884: } elsif ($env{'request.role'} =~ /^dc/) {
2885: $context = 'domain';
2886: } elsif ($env{'request.course.id'}) {
2887: $context = 'course';
2888: }
2889: if ($context) {
2890: if (ref($authhash->{$context}) eq 'HASH') {
2891: %can_assign = %{$authhash->{$context}};
2892: }
2893: }
2894: }
2895: }
2896: my $authnum = 0;
2897: foreach my $key (keys(%can_assign)) {
2898: if ($can_assign{$key}) {
2899: $authnum ++;
2900: }
2901: }
2902: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2903: $authnum --;
2904: }
2905: return ($authnum,%can_assign);
2906: }
2907:
1.80 albertel 2908: ###############################################################
2909: ## Get Kerberos Defaults for Domain ##
2910: ###############################################################
2911: ##
2912: ## Returns default kerberos version and an associated argument
2913: ## as listed in file domain.tab. If not listed, provides
2914: ## appropriate default domain and kerberos version.
2915: ##
2916: #-------------------------------------------
2917:
2918: =pod
2919:
1.648 raeburn 2920: =item * &get_kerberos_defaults()
1.80 albertel 2921:
2922: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2923: version and domain. If not found, it defaults to version 4 and the
2924: domain of the server.
1.80 albertel 2925:
1.648 raeburn 2926: =over 4
2927:
1.80 albertel 2928: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2929:
1.648 raeburn 2930: =back
2931:
2932: =back
2933:
1.80 albertel 2934: =cut
2935:
2936: #-------------------------------------------
2937: sub get_kerberos_defaults {
2938: my $domain=shift;
1.641 raeburn 2939: my ($krbdef,$krbdefdom);
2940: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2941: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2942: $krbdef = $domdefaults{'auth_def'};
2943: $krbdefdom = $domdefaults{'auth_arg_def'};
2944: } else {
1.80 albertel 2945: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2946: my $krbdefdom=$1;
2947: $krbdefdom=~tr/a-z/A-Z/;
2948: $krbdef = "krb4";
2949: }
2950: return ($krbdef,$krbdefdom);
2951: }
1.112 bowersj2 2952:
1.32 matthew 2953:
1.46 matthew 2954: ###############################################################
2955: ## Thesaurus Functions ##
2956: ###############################################################
1.20 www 2957:
1.46 matthew 2958: =pod
1.20 www 2959:
1.112 bowersj2 2960: =head1 Thesaurus Functions
2961:
2962: =over 4
2963:
1.648 raeburn 2964: =item * &initialize_keywords()
1.46 matthew 2965:
2966: Initializes the package variable %Keywords if it is empty. Uses the
2967: package variable $thesaurus_db_file.
2968:
2969: =cut
2970:
2971: ###################################################
2972:
2973: sub initialize_keywords {
2974: return 1 if (scalar keys(%Keywords));
2975: # If we are here, %Keywords is empty, so fill it up
2976: # Make sure the file we need exists...
2977: if (! -e $thesaurus_db_file) {
2978: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2979: " failed because it does not exist");
2980: return 0;
2981: }
2982: # Set up the hash as a database
2983: my %thesaurus_db;
2984: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2985: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2986: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2987: $thesaurus_db_file);
2988: return 0;
2989: }
2990: # Get the average number of appearances of a word.
2991: my $avecount = $thesaurus_db{'average.count'};
2992: # Put keywords (those that appear > average) into %Keywords
2993: while (my ($word,$data)=each (%thesaurus_db)) {
2994: my ($count,undef) = split /:/,$data;
2995: $Keywords{$word}++ if ($count > $avecount);
2996: }
2997: untie %thesaurus_db;
2998: # Remove special values from %Keywords.
1.356 albertel 2999: foreach my $value ('total.count','average.count') {
3000: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3001: }
1.46 matthew 3002: return 1;
3003: }
3004:
3005: ###################################################
3006:
3007: =pod
3008:
1.648 raeburn 3009: =item * &keyword($word)
1.46 matthew 3010:
3011: Returns true if $word is a keyword. A keyword is a word that appears more
3012: than the average number of times in the thesaurus database. Calls
3013: &initialize_keywords
3014:
3015: =cut
3016:
3017: ###################################################
1.20 www 3018:
3019: sub keyword {
1.46 matthew 3020: return if (!&initialize_keywords());
3021: my $word=lc(shift());
3022: $word=~s/\W//g;
3023: return exists($Keywords{$word});
1.20 www 3024: }
1.46 matthew 3025:
3026: ###############################################################
3027:
3028: =pod
1.20 www 3029:
1.648 raeburn 3030: =item * &get_related_words()
1.46 matthew 3031:
1.160 matthew 3032: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3033: an array of words. If the keyword is not in the thesaurus, an empty array
3034: will be returned. The order of the words returned is determined by the
3035: database which holds them.
3036:
3037: Uses global $thesaurus_db_file.
3038:
1.1057 foxr 3039:
1.46 matthew 3040: =cut
3041:
3042: ###############################################################
3043: sub get_related_words {
3044: my $keyword = shift;
3045: my %thesaurus_db;
3046: if (! -e $thesaurus_db_file) {
3047: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3048: "failed because the file does not exist");
3049: return ();
3050: }
3051: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3052: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3053: return ();
3054: }
3055: my @Words=();
1.429 www 3056: my $count=0;
1.46 matthew 3057: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3058: # The first element is the number of times
3059: # the word appears. We do not need it now.
1.429 www 3060: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3061: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3062: my $threshold=$mostfrequentcount/10;
3063: foreach my $possibleword (@RelatedWords) {
3064: my ($word,$wordcount)=split(/\,/,$possibleword);
3065: if ($wordcount>$threshold) {
3066: push(@Words,$word);
3067: $count++;
3068: if ($count>10) { last; }
3069: }
1.20 www 3070: }
3071: }
1.46 matthew 3072: untie %thesaurus_db;
3073: return @Words;
1.14 harris41 3074: }
1.46 matthew 3075:
1.112 bowersj2 3076: =pod
3077:
3078: =back
3079:
3080: =cut
1.61 www 3081:
3082: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3083: =pod
3084:
1.112 bowersj2 3085: =head1 User Name Functions
3086:
3087: =over 4
3088:
1.648 raeburn 3089: =item * &plainname($uname,$udom,$first)
1.81 albertel 3090:
1.112 bowersj2 3091: Takes a users logon name and returns it as a string in
1.226 albertel 3092: "first middle last generation" form
3093: if $first is set to 'lastname' then it returns it as
3094: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3095:
3096: =cut
1.61 www 3097:
1.295 www 3098:
1.81 albertel 3099: ###############################################################
1.61 www 3100: sub plainname {
1.226 albertel 3101: my ($uname,$udom,$first)=@_;
1.537 albertel 3102: return if (!defined($uname) || !defined($udom));
1.295 www 3103: my %names=&getnames($uname,$udom);
1.226 albertel 3104: my $name=&Apache::lonnet::format_name($names{'firstname'},
3105: $names{'middlename'},
3106: $names{'lastname'},
3107: $names{'generation'},$first);
3108: $name=~s/^\s+//;
1.62 www 3109: $name=~s/\s+$//;
3110: $name=~s/\s+/ /g;
1.353 albertel 3111: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3112: return $name;
1.61 www 3113: }
1.66 www 3114:
3115: # -------------------------------------------------------------------- Nickname
1.81 albertel 3116: =pod
3117:
1.648 raeburn 3118: =item * &nickname($uname,$udom)
1.81 albertel 3119:
3120: Gets a users name and returns it as a string as
3121:
3122: ""nickname""
1.66 www 3123:
1.81 albertel 3124: if the user has a nickname or
3125:
3126: "first middle last generation"
3127:
3128: if the user does not
3129:
3130: =cut
1.66 www 3131:
3132: sub nickname {
3133: my ($uname,$udom)=@_;
1.537 albertel 3134: return if (!defined($uname) || !defined($udom));
1.295 www 3135: my %names=&getnames($uname,$udom);
1.68 albertel 3136: my $name=$names{'nickname'};
1.66 www 3137: if ($name) {
3138: $name='"'.$name.'"';
3139: } else {
3140: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3141: $names{'lastname'}.' '.$names{'generation'};
3142: $name=~s/\s+$//;
3143: $name=~s/\s+/ /g;
3144: }
3145: return $name;
3146: }
3147:
1.295 www 3148: sub getnames {
3149: my ($uname,$udom)=@_;
1.537 albertel 3150: return if (!defined($uname) || !defined($udom));
1.433 albertel 3151: if ($udom eq 'public' && $uname eq 'public') {
3152: return ('lastname' => &mt('Public'));
3153: }
1.295 www 3154: my $id=$uname.':'.$udom;
3155: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3156: if ($cached) {
3157: return %{$names};
3158: } else {
3159: my %loadnames=&Apache::lonnet::get('environment',
3160: ['firstname','middlename','lastname','generation','nickname'],
3161: $udom,$uname);
3162: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3163: return %loadnames;
3164: }
3165: }
1.61 www 3166:
1.542 raeburn 3167: # -------------------------------------------------------------------- getemails
1.648 raeburn 3168:
1.542 raeburn 3169: =pod
3170:
1.648 raeburn 3171: =item * &getemails($uname,$udom)
1.542 raeburn 3172:
3173: Gets a user's email information and returns it as a hash with keys:
3174: notification, critnotification, permanentemail
3175:
3176: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3177: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3178:
1.648 raeburn 3179:
1.542 raeburn 3180: =cut
3181:
1.648 raeburn 3182:
1.466 albertel 3183: sub getemails {
3184: my ($uname,$udom)=@_;
3185: if ($udom eq 'public' && $uname eq 'public') {
3186: return;
3187: }
1.467 www 3188: if (!$udom) { $udom=$env{'user.domain'}; }
3189: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3190: my $id=$uname.':'.$udom;
3191: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3192: if ($cached) {
3193: return %{$names};
3194: } else {
3195: my %loadnames=&Apache::lonnet::get('environment',
3196: ['notification','critnotification',
3197: 'permanentemail'],
3198: $udom,$uname);
3199: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3200: return %loadnames;
3201: }
3202: }
3203:
1.551 albertel 3204: sub flush_email_cache {
3205: my ($uname,$udom)=@_;
3206: if (!$udom) { $udom =$env{'user.domain'}; }
3207: if (!$uname) { $uname=$env{'user.name'}; }
3208: return if ($udom eq 'public' && $uname eq 'public');
3209: my $id=$uname.':'.$udom;
3210: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3211: }
3212:
1.728 raeburn 3213: # -------------------------------------------------------------------- getlangs
3214:
3215: =pod
3216:
3217: =item * &getlangs($uname,$udom)
3218:
3219: Gets a user's language preference and returns it as a hash with key:
3220: language.
3221:
3222: =cut
3223:
3224:
3225: sub getlangs {
3226: my ($uname,$udom) = @_;
3227: if (!$udom) { $udom =$env{'user.domain'}; }
3228: if (!$uname) { $uname=$env{'user.name'}; }
3229: my $id=$uname.':'.$udom;
3230: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3231: if ($cached) {
3232: return %{$langs};
3233: } else {
3234: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3235: $udom,$uname);
3236: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3237: return %loadlangs;
3238: }
3239: }
3240:
3241: sub flush_langs_cache {
3242: my ($uname,$udom)=@_;
3243: if (!$udom) { $udom =$env{'user.domain'}; }
3244: if (!$uname) { $uname=$env{'user.name'}; }
3245: return if ($udom eq 'public' && $uname eq 'public');
3246: my $id=$uname.':'.$udom;
3247: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3248: }
3249:
1.61 www 3250: # ------------------------------------------------------------------ Screenname
1.81 albertel 3251:
3252: =pod
3253:
1.648 raeburn 3254: =item * &screenname($uname,$udom)
1.81 albertel 3255:
3256: Gets a users screenname and returns it as a string
3257:
3258: =cut
1.61 www 3259:
3260: sub screenname {
3261: my ($uname,$udom)=@_;
1.258 albertel 3262: if ($uname eq $env{'user.name'} &&
3263: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3264: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3265: return $names{'screenname'};
1.62 www 3266: }
3267:
1.212 albertel 3268:
1.802 bisitz 3269: # ------------------------------------------------------------- Confirm Wrapper
3270: =pod
3271:
1.1075.2.42 raeburn 3272: =item * &confirmwrapper($message)
1.802 bisitz 3273:
3274: Wrap messages about completion of operation in box
3275:
3276: =cut
3277:
3278: sub confirmwrapper {
3279: my ($message)=@_;
3280: if ($message) {
3281: return "\n".'<div class="LC_confirm_box">'."\n"
3282: .$message."\n"
3283: .'</div>'."\n";
3284: } else {
3285: return $message;
3286: }
3287: }
3288:
1.62 www 3289: # ------------------------------------------------------------- Message Wrapper
3290:
3291: sub messagewrapper {
1.369 www 3292: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3293: return
1.441 albertel 3294: '<a href="/adm/email?compose=individual&'.
3295: 'recname='.$username.'&recdom='.$domain.
3296: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3297: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3298: }
1.802 bisitz 3299:
1.74 www 3300: # --------------------------------------------------------------- Notes Wrapper
3301:
3302: sub noteswrapper {
3303: my ($link,$un,$do)=@_;
3304: return
1.896 amueller 3305: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3306: }
1.802 bisitz 3307:
1.62 www 3308: # ------------------------------------------------------------- Aboutme Wrapper
3309:
3310: sub aboutmewrapper {
1.1070 raeburn 3311: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3312: if (!defined($username) && !defined($domain)) {
3313: return;
3314: }
1.1075.2.15 raeburn 3315: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3316: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3317: }
3318:
3319: # ------------------------------------------------------------ Syllabus Wrapper
3320:
3321: sub syllabuswrapper {
1.707 bisitz 3322: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3323: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3324: }
1.14 harris41 3325:
1.802 bisitz 3326: # -----------------------------------------------------------------------------
3327:
1.208 matthew 3328: sub track_student_link {
1.887 raeburn 3329: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3330: my $link ="/adm/trackstudent?";
1.208 matthew 3331: my $title = 'View recent activity';
3332: if (defined($sname) && $sname !~ /^\s*$/ &&
3333: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3334: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3335: $title .= ' of this student';
1.268 albertel 3336: }
1.208 matthew 3337: if (defined($target) && $target !~ /^\s*$/) {
3338: $target = qq{target="$target"};
3339: } else {
3340: $target = '';
3341: }
1.268 albertel 3342: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3343: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3344: $title = &mt($title);
3345: $linktext = &mt($linktext);
1.448 albertel 3346: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3347: &help_open_topic('View_recent_activity');
1.208 matthew 3348: }
3349:
1.781 raeburn 3350: sub slot_reservations_link {
3351: my ($linktext,$sname,$sdom,$target) = @_;
3352: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3353: my $title = 'View slot reservation history';
3354: if (defined($sname) && $sname !~ /^\s*$/ &&
3355: defined($sdom) && $sdom !~ /^\s*$/) {
3356: $link .= "&uname=$sname&udom=$sdom";
3357: $title .= ' of this student';
3358: }
3359: if (defined($target) && $target !~ /^\s*$/) {
3360: $target = qq{target="$target"};
3361: } else {
3362: $target = '';
3363: }
3364: $title = &mt($title);
3365: $linktext = &mt($linktext);
3366: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3367: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3368:
3369: }
3370:
1.508 www 3371: # ===================================================== Display a student photo
3372:
3373:
1.509 albertel 3374: sub student_image_tag {
1.508 www 3375: my ($domain,$user)=@_;
3376: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3377: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3378: return '<img src="'.$imgsrc.'" align="right" />';
3379: } else {
3380: return '';
3381: }
3382: }
3383:
1.112 bowersj2 3384: =pod
3385:
3386: =back
3387:
3388: =head1 Access .tab File Data
3389:
3390: =over 4
3391:
1.648 raeburn 3392: =item * &languageids()
1.112 bowersj2 3393:
3394: returns list of all language ids
3395:
3396: =cut
3397:
1.14 harris41 3398: sub languageids {
1.16 harris41 3399: return sort(keys(%language));
1.14 harris41 3400: }
3401:
1.112 bowersj2 3402: =pod
3403:
1.648 raeburn 3404: =item * &languagedescription()
1.112 bowersj2 3405:
3406: returns description of a specified language id
3407:
3408: =cut
3409:
1.14 harris41 3410: sub languagedescription {
1.125 www 3411: my $code=shift;
3412: return ($supported_language{$code}?'* ':'').
3413: $language{$code}.
1.126 www 3414: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3415: }
3416:
1.1048 foxr 3417: =pod
3418:
3419: =item * &plainlanguagedescription
3420:
3421: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3422: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3423:
3424: =cut
3425:
1.145 www 3426: sub plainlanguagedescription {
3427: my $code=shift;
3428: return $language{$code};
3429: }
3430:
1.1048 foxr 3431: =pod
3432:
3433: =item * &supportedlanguagecode
3434:
3435: Returns the supported language code (e.g. sptutf maps to pt) given a language
3436: code.
3437:
3438: =cut
3439:
1.145 www 3440: sub supportedlanguagecode {
3441: my $code=shift;
3442: return $supported_language{$code};
1.97 www 3443: }
3444:
1.112 bowersj2 3445: =pod
3446:
1.1048 foxr 3447: =item * &latexlanguage()
3448:
3449: Given a language key code returns the correspondnig language to use
3450: to select the correct hyphenation on LaTeX printouts. This is undef if there
3451: is no supported hyphenation for the language code.
3452:
3453: =cut
3454:
3455: sub latexlanguage {
3456: my $code = shift;
3457: return $latex_language{$code};
3458: }
3459:
3460: =pod
3461:
3462: =item * &latexhyphenation()
3463:
3464: Same as above but what's supplied is the language as it might be stored
3465: in the metadata.
3466:
3467: =cut
3468:
3469: sub latexhyphenation {
3470: my $key = shift;
3471: return $latex_language_bykey{$key};
3472: }
3473:
3474: =pod
3475:
1.648 raeburn 3476: =item * ©rightids()
1.112 bowersj2 3477:
3478: returns list of all copyrights
3479:
3480: =cut
3481:
3482: sub copyrightids {
3483: return sort(keys(%cprtag));
3484: }
3485:
3486: =pod
3487:
1.648 raeburn 3488: =item * ©rightdescription()
1.112 bowersj2 3489:
3490: returns description of a specified copyright id
3491:
3492: =cut
3493:
3494: sub copyrightdescription {
1.166 www 3495: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3496: }
1.197 matthew 3497:
3498: =pod
3499:
1.648 raeburn 3500: =item * &source_copyrightids()
1.192 taceyjo1 3501:
3502: returns list of all source copyrights
3503:
3504: =cut
3505:
3506: sub source_copyrightids {
3507: return sort(keys(%scprtag));
3508: }
3509:
3510: =pod
3511:
1.648 raeburn 3512: =item * &source_copyrightdescription()
1.192 taceyjo1 3513:
3514: returns description of a specified source copyright id
3515:
3516: =cut
3517:
3518: sub source_copyrightdescription {
3519: return &mt($scprtag{shift(@_)});
3520: }
1.112 bowersj2 3521:
3522: =pod
3523:
1.648 raeburn 3524: =item * &filecategories()
1.112 bowersj2 3525:
3526: returns list of all file categories
3527:
3528: =cut
3529:
3530: sub filecategories {
3531: return sort(keys(%category_extensions));
3532: }
3533:
3534: =pod
3535:
1.648 raeburn 3536: =item * &filecategorytypes()
1.112 bowersj2 3537:
3538: returns list of file types belonging to a given file
3539: category
3540:
3541: =cut
3542:
3543: sub filecategorytypes {
1.356 albertel 3544: my ($cat) = @_;
3545: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3546: }
3547:
3548: =pod
3549:
1.648 raeburn 3550: =item * &fileembstyle()
1.112 bowersj2 3551:
3552: returns embedding style for a specified file type
3553:
3554: =cut
3555:
3556: sub fileembstyle {
3557: return $fe{lc(shift(@_))};
1.169 www 3558: }
3559:
1.351 www 3560: sub filemimetype {
3561: return $fm{lc(shift(@_))};
3562: }
3563:
1.169 www 3564:
3565: sub filecategoryselect {
3566: my ($name,$value)=@_;
1.189 matthew 3567: return &select_form($value,$name,
1.970 raeburn 3568: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3569: }
3570:
3571: =pod
3572:
1.648 raeburn 3573: =item * &filedescription()
1.112 bowersj2 3574:
3575: returns description for a specified file type
3576:
3577: =cut
3578:
3579: sub filedescription {
1.188 matthew 3580: my $file_description = $fd{lc(shift())};
3581: $file_description =~ s:([\[\]]):~$1:g;
3582: return &mt($file_description);
1.112 bowersj2 3583: }
3584:
3585: =pod
3586:
1.648 raeburn 3587: =item * &filedescriptionex()
1.112 bowersj2 3588:
3589: returns description for a specified file type with
3590: extra formatting
3591:
3592: =cut
3593:
3594: sub filedescriptionex {
3595: my $ex=shift;
1.188 matthew 3596: my $file_description = $fd{lc($ex)};
3597: $file_description =~ s:([\[\]]):~$1:g;
3598: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3599: }
3600:
3601: # End of .tab access
3602: =pod
3603:
3604: =back
3605:
3606: =cut
3607:
3608: # ------------------------------------------------------------------ File Types
3609: sub fileextensions {
3610: return sort(keys(%fe));
3611: }
3612:
1.97 www 3613: # ----------------------------------------------------------- Display Languages
3614: # returns a hash with all desired display languages
3615: #
3616:
3617: sub display_languages {
3618: my %languages=();
1.695 raeburn 3619: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3620: $languages{$lang}=1;
1.97 www 3621: }
3622: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3623: if ($env{'form.displaylanguage'}) {
1.356 albertel 3624: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3625: $languages{$lang}=1;
1.97 www 3626: }
3627: }
3628: return %languages;
1.14 harris41 3629: }
3630:
1.582 albertel 3631: sub languages {
3632: my ($possible_langs) = @_;
1.695 raeburn 3633: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3634: if (!ref($possible_langs)) {
3635: if( wantarray ) {
3636: return @preferred_langs;
3637: } else {
3638: return $preferred_langs[0];
3639: }
3640: }
3641: my %possibilities = map { $_ => 1 } (@$possible_langs);
3642: my @preferred_possibilities;
3643: foreach my $preferred_lang (@preferred_langs) {
3644: if (exists($possibilities{$preferred_lang})) {
3645: push(@preferred_possibilities, $preferred_lang);
3646: }
3647: }
3648: if( wantarray ) {
3649: return @preferred_possibilities;
3650: }
3651: return $preferred_possibilities[0];
3652: }
3653:
1.742 raeburn 3654: sub user_lang {
3655: my ($touname,$toudom,$fromcid) = @_;
3656: my @userlangs;
3657: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3658: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3659: $env{'course.'.$fromcid.'.languages'}));
3660: } else {
3661: my %langhash = &getlangs($touname,$toudom);
3662: if ($langhash{'languages'} ne '') {
3663: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3664: } else {
3665: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3666: if ($domdefs{'lang_def'} ne '') {
3667: @userlangs = ($domdefs{'lang_def'});
3668: }
3669: }
3670: }
3671: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3672: my $user_lh = Apache::localize->get_handle(@languages);
3673: return $user_lh;
3674: }
3675:
3676:
1.112 bowersj2 3677: ###############################################################
3678: ## Student Answer Attempts ##
3679: ###############################################################
3680:
3681: =pod
3682:
3683: =head1 Alternate Problem Views
3684:
3685: =over 4
3686:
1.648 raeburn 3687: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86 raeburn 3688: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 3689:
3690: Return string with previous attempt on problem. Arguments:
3691:
3692: =over 4
3693:
3694: =item * $symb: Problem, including path
3695:
3696: =item * $username: username of the desired student
3697:
3698: =item * $domain: domain of the desired student
1.14 harris41 3699:
1.112 bowersj2 3700: =item * $course: Course ID
1.14 harris41 3701:
1.112 bowersj2 3702: =item * $getattempt: Leave blank for all attempts, otherwise put
3703: something
1.14 harris41 3704:
1.112 bowersj2 3705: =item * $regexp: if string matches this regexp, the string will be
3706: sent to $gradesub
1.14 harris41 3707:
1.112 bowersj2 3708: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3709:
1.1075.2.86 raeburn 3710: =item * $usec: section of the desired student
3711:
3712: =item * $identifier: counter for student (multiple students one problem) or
3713: problem (one student; whole sequence).
3714:
1.112 bowersj2 3715: =back
1.14 harris41 3716:
1.112 bowersj2 3717: The output string is a table containing all desired attempts, if any.
1.16 harris41 3718:
1.112 bowersj2 3719: =cut
1.1 albertel 3720:
3721: sub get_previous_attempt {
1.1075.2.86 raeburn 3722: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 3723: my $prevattempts='';
1.43 ng 3724: no strict 'refs';
1.1 albertel 3725: if ($symb) {
1.3 albertel 3726: my (%returnhash)=
3727: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3728: if ($returnhash{'version'}) {
3729: my %lasthash=();
3730: my $version;
3731: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91 raeburn 3732: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
3733: if ($key =~ /\.rawrndseed$/) {
3734: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
3735: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
3736: } else {
3737: $lasthash{$key}=$returnhash{$version.':'.$key};
3738: }
1.19 harris41 3739: }
1.1 albertel 3740: }
1.596 albertel 3741: $prevattempts=&start_data_table().&start_data_table_header_row();
3742: $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86 raeburn 3743: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 3744: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3745: foreach my $key (sort(keys(%lasthash))) {
3746: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3747: if ($#parts > 0) {
1.31 albertel 3748: my $data=$parts[-1];
1.989 raeburn 3749: next if ($data eq 'foilorder');
1.31 albertel 3750: pop(@parts);
1.1010 www 3751: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3752: if ($data eq 'type') {
3753: unless ($showsurv) {
3754: my $id = join(',',@parts);
3755: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3756: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3757: $lasthidden{$ign.'.'.$id} = 1;
3758: }
1.945 raeburn 3759: }
1.1075.2.86 raeburn 3760: if ($identifier ne '') {
3761: my $id = join(',',@parts);
3762: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
3763: $domain,$username,$usec,undef,$course) =~ /^no/) {
3764: $hidestatus{$ign.'.'.$id} = 1;
3765: }
3766: }
3767: } elsif ($data eq 'regrader') {
3768: if (($identifier ne '') && (@parts)) {
3769: my $id = join(',',@parts);
3770: $regraded{$ign.'.'.$id} = 1;
3771: }
1.1010 www 3772: }
1.31 albertel 3773: } else {
1.41 ng 3774: if ($#parts == 0) {
3775: $prevattempts.='<th>'.$parts[0].'</th>';
3776: } else {
3777: $prevattempts.='<th>'.$ign.'</th>';
3778: }
1.31 albertel 3779: }
1.16 harris41 3780: }
1.596 albertel 3781: $prevattempts.=&end_data_table_header_row();
1.40 ng 3782: if ($getattempt eq '') {
1.1075.2.86 raeburn 3783: my (%solved,%resets,%probstatus);
3784: if (($identifier ne '') && (keys(%regraded) > 0)) {
3785: for ($version=1;$version<=$returnhash{'version'};$version++) {
3786: foreach my $id (keys(%regraded)) {
3787: if (($returnhash{$version.':'.$id.'.regrader'}) &&
3788: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
3789: ($returnhash{$version.':'.$id.'.award'} eq '')) {
3790: push(@{$resets{$id}},$version);
3791: }
3792: }
3793: }
3794: }
1.40 ng 3795: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86 raeburn 3796: my (@hidden,@unsolved);
1.945 raeburn 3797: if (%typeparts) {
3798: foreach my $id (keys(%typeparts)) {
1.1075.2.86 raeburn 3799: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
3800: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 3801: push(@hidden,$id);
1.1075.2.86 raeburn 3802: } elsif ($identifier ne '') {
3803: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
3804: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
3805: ($hidestatus{$id})) {
3806: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
3807: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
3808: push(@{$solved{$id}},$version);
3809: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
3810: (ref($solved{$id}) eq 'ARRAY')) {
3811: my $skip;
3812: if (ref($resets{$id}) eq 'ARRAY') {
3813: foreach my $reset (@{$resets{$id}}) {
3814: if ($reset > $solved{$id}[-1]) {
3815: $skip=1;
3816: last;
3817: }
3818: }
3819: }
3820: unless ($skip) {
3821: my ($ign,$partslist) = split(/\./,$id,2);
3822: push(@unsolved,$partslist);
3823: }
3824: }
3825: }
1.945 raeburn 3826: }
3827: }
3828: }
3829: $prevattempts.=&start_data_table_row().
1.1075.2.86 raeburn 3830: '<td>'.&mt('Transaction [_1]',$version);
3831: if (@unsolved) {
3832: $prevattempts .= '<span class="LC_nobreak"><label>'.
3833: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
3834: &mt('Hide').'</label></span>';
3835: }
3836: $prevattempts .= '</td>';
1.945 raeburn 3837: if (@hidden) {
3838: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3839: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3840: my $hide;
3841: foreach my $id (@hidden) {
3842: if ($key =~ /^\Q$id\E/) {
3843: $hide = 1;
3844: last;
3845: }
3846: }
3847: if ($hide) {
3848: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3849: if (($data eq 'award') || ($data eq 'awarddetail')) {
3850: my $value = &format_previous_attempt_value($key,
3851: $returnhash{$version.':'.$key});
3852: $prevattempts.='<td>'.$value.' </td>';
3853: } else {
3854: $prevattempts.='<td> </td>';
3855: }
3856: } else {
3857: if ($key =~ /\./) {
1.1075.2.91 raeburn 3858: my $value = $returnhash{$version.':'.$key};
3859: if ($key =~ /\.rndseed$/) {
3860: my ($id) = ($key =~ /^(.+)\.rndseed$/);
3861: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
3862: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
3863: }
3864: }
3865: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
3866: ' </td>';
1.945 raeburn 3867: } else {
3868: $prevattempts.='<td> </td>';
3869: }
3870: }
3871: }
3872: } else {
3873: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3874: next if ($key =~ /\.foilorder$/);
1.1075.2.91 raeburn 3875: my $value = $returnhash{$version.':'.$key};
3876: if ($key =~ /\.rndseed$/) {
3877: my ($id) = ($key =~ /^(.+)\.rndseed$/);
3878: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
3879: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
3880: }
3881: }
3882: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
3883: ' </td>';
1.945 raeburn 3884: }
3885: }
3886: $prevattempts.=&end_data_table_row();
1.40 ng 3887: }
1.1 albertel 3888: }
1.945 raeburn 3889: my @currhidden = keys(%lasthidden);
1.596 albertel 3890: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3891: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3892: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3893: if (%typeparts) {
3894: my $hidden;
3895: foreach my $id (@currhidden) {
3896: if ($key =~ /^\Q$id\E/) {
3897: $hidden = 1;
3898: last;
3899: }
3900: }
3901: if ($hidden) {
3902: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3903: if (($data eq 'award') || ($data eq 'awarddetail')) {
3904: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3905: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3906: $value = &$gradesub($value);
3907: }
3908: $prevattempts.='<td>'.$value.' </td>';
3909: } else {
3910: $prevattempts.='<td> </td>';
3911: }
3912: } else {
3913: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3914: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3915: $value = &$gradesub($value);
3916: }
3917: $prevattempts.='<td>'.$value.' </td>';
3918: }
3919: } else {
3920: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3921: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3922: $value = &$gradesub($value);
3923: }
3924: $prevattempts.='<td>'.$value.' </td>';
3925: }
1.16 harris41 3926: }
1.596 albertel 3927: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3928: } else {
1.596 albertel 3929: $prevattempts=
3930: &start_data_table().&start_data_table_row().
3931: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3932: &end_data_table_row().&end_data_table();
1.1 albertel 3933: }
3934: } else {
1.596 albertel 3935: $prevattempts=
3936: &start_data_table().&start_data_table_row().
3937: '<td>'.&mt('No data.').'</td>'.
3938: &end_data_table_row().&end_data_table();
1.1 albertel 3939: }
1.10 albertel 3940: }
3941:
1.581 albertel 3942: sub format_previous_attempt_value {
3943: my ($key,$value) = @_;
1.1011 www 3944: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 3945: $value = &Apache::lonlocal::locallocaltime($value);
3946: } elsif (ref($value) eq 'ARRAY') {
3947: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 3948: } elsif ($key =~ /answerstring$/) {
3949: my %answers = &Apache::lonnet::str2hash($value);
3950: my @anskeys = sort(keys(%answers));
3951: if (@anskeys == 1) {
3952: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3953: if ($answer =~ m{\0}) {
3954: $answer =~ s{\0}{,}g;
1.988 raeburn 3955: }
3956: my $tag_internal_answer_name = 'INTERNAL';
3957: if ($anskeys[0] eq $tag_internal_answer_name) {
3958: $value = $answer;
3959: } else {
3960: $value = $anskeys[0].'='.$answer;
3961: }
3962: } else {
3963: foreach my $ans (@anskeys) {
3964: my $answer = $answers{$ans};
1.1001 raeburn 3965: if ($answer =~ m{\0}) {
3966: $answer =~ s{\0}{,}g;
1.988 raeburn 3967: }
3968: $value .= $ans.'='.$answer.'<br />';;
3969: }
3970: }
1.581 albertel 3971: } else {
3972: $value = &unescape($value);
3973: }
3974: return $value;
3975: }
3976:
3977:
1.107 albertel 3978: sub relative_to_absolute {
3979: my ($url,$output)=@_;
3980: my $parser=HTML::TokeParser->new(\$output);
3981: my $token;
3982: my $thisdir=$url;
3983: my @rlinks=();
3984: while ($token=$parser->get_token) {
3985: if ($token->[0] eq 'S') {
3986: if ($token->[1] eq 'a') {
3987: if ($token->[2]->{'href'}) {
3988: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3989: }
3990: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3991: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3992: } elsif ($token->[1] eq 'base') {
3993: $thisdir=$token->[2]->{'href'};
3994: }
3995: }
3996: }
3997: $thisdir=~s-/[^/]*$--;
1.356 albertel 3998: foreach my $link (@rlinks) {
1.726 raeburn 3999: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4000: ($link=~/^\//) ||
4001: ($link=~/^javascript:/i) ||
4002: ($link=~/^mailto:/i) ||
4003: ($link=~/^\#/)) {
4004: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4005: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4006: }
4007: }
4008: # -------------------------------------------------- Deal with Applet codebases
4009: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4010: return $output;
4011: }
4012:
1.112 bowersj2 4013: =pod
4014:
1.648 raeburn 4015: =item * &get_student_view()
1.112 bowersj2 4016:
4017: show a snapshot of what student was looking at
4018:
4019: =cut
4020:
1.10 albertel 4021: sub get_student_view {
1.186 albertel 4022: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4023: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4024: my (%form);
1.10 albertel 4025: my @elements=('symb','courseid','domain','username');
4026: foreach my $element (@elements) {
1.186 albertel 4027: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4028: }
1.186 albertel 4029: if (defined($moreenv)) {
4030: %form=(%form,%{$moreenv});
4031: }
1.236 albertel 4032: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4033: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4034: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4035: $userview=~s/\<body[^\>]*\>//gi;
4036: $userview=~s/\<\/body\>//gi;
4037: $userview=~s/\<html\>//gi;
4038: $userview=~s/\<\/html\>//gi;
4039: $userview=~s/\<head\>//gi;
4040: $userview=~s/\<\/head\>//gi;
4041: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4042: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4043: if (wantarray) {
4044: return ($userview,$response);
4045: } else {
4046: return $userview;
4047: }
4048: }
4049:
4050: sub get_student_view_with_retries {
4051: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4052:
4053: my $ok = 0; # True if we got a good response.
4054: my $content;
4055: my $response;
4056:
4057: # Try to get the student_view done. within the retries count:
4058:
4059: do {
4060: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4061: $ok = $response->is_success;
4062: if (!$ok) {
4063: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4064: }
4065: $retries--;
4066: } while (!$ok && ($retries > 0));
4067:
4068: if (!$ok) {
4069: $content = ''; # On error return an empty content.
4070: }
1.651 www 4071: if (wantarray) {
4072: return ($content, $response);
4073: } else {
4074: return $content;
4075: }
1.11 albertel 4076: }
4077:
1.112 bowersj2 4078: =pod
4079:
1.648 raeburn 4080: =item * &get_student_answers()
1.112 bowersj2 4081:
4082: show a snapshot of how student was answering problem
4083:
4084: =cut
4085:
1.11 albertel 4086: sub get_student_answers {
1.100 sakharuk 4087: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4088: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4089: my (%moreenv);
1.11 albertel 4090: my @elements=('symb','courseid','domain','username');
4091: foreach my $element (@elements) {
1.186 albertel 4092: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4093: }
1.186 albertel 4094: $moreenv{'grade_target'}='answer';
4095: %moreenv=(%form,%moreenv);
1.497 raeburn 4096: $feedurl = &Apache::lonnet::clutter($feedurl);
4097: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4098: return $userview;
1.1 albertel 4099: }
1.116 albertel 4100:
4101: =pod
4102:
4103: =item * &submlink()
4104:
1.242 albertel 4105: Inputs: $text $uname $udom $symb $target
1.116 albertel 4106:
4107: Returns: A link to grades.pm such as to see the SUBM view of a student
4108:
4109: =cut
4110:
4111: ###############################################
4112: sub submlink {
1.242 albertel 4113: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4114: if (!($uname && $udom)) {
4115: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4116: &Apache::lonnet::whichuser($symb);
1.116 albertel 4117: if (!$symb) { $symb=$cursymb; }
4118: }
1.254 matthew 4119: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4120: $symb=&escape($symb);
1.960 bisitz 4121: if ($target) { $target=" target=\"$target\""; }
4122: return
4123: '<a href="/adm/grades?command=submission'.
4124: '&symb='.$symb.
4125: '&student='.$uname.
4126: '&userdom='.$udom.'"'.
4127: $target.'>'.$text.'</a>';
1.242 albertel 4128: }
4129: ##############################################
4130:
4131: =pod
4132:
4133: =item * &pgrdlink()
4134:
4135: Inputs: $text $uname $udom $symb $target
4136:
4137: Returns: A link to grades.pm such as to see the PGRD view of a student
4138:
4139: =cut
4140:
4141: ###############################################
4142: sub pgrdlink {
4143: my $link=&submlink(@_);
4144: $link=~s/(&command=submission)/$1&showgrading=yes/;
4145: return $link;
4146: }
4147: ##############################################
4148:
4149: =pod
4150:
4151: =item * &pprmlink()
4152:
4153: Inputs: $text $uname $udom $symb $target
4154:
4155: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4156: student and a specific resource
1.242 albertel 4157:
4158: =cut
4159:
4160: ###############################################
4161: sub pprmlink {
4162: my ($text,$uname,$udom,$symb,$target)=@_;
4163: if (!($uname && $udom)) {
4164: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4165: &Apache::lonnet::whichuser($symb);
1.242 albertel 4166: if (!$symb) { $symb=$cursymb; }
4167: }
1.254 matthew 4168: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4169: $symb=&escape($symb);
1.242 albertel 4170: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4171: return '<a href="/adm/parmset?command=set&'.
4172: 'symb='.$symb.'&uname='.$uname.
4173: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4174: }
4175: ##############################################
1.37 matthew 4176:
1.112 bowersj2 4177: =pod
4178:
4179: =back
4180:
4181: =cut
4182:
1.37 matthew 4183: ###############################################
1.51 www 4184:
4185:
4186: sub timehash {
1.687 raeburn 4187: my ($thistime) = @_;
4188: my $timezone = &Apache::lonlocal::gettimezone();
4189: my $dt = DateTime->from_epoch(epoch => $thistime)
4190: ->set_time_zone($timezone);
4191: my $wday = $dt->day_of_week();
4192: if ($wday == 7) { $wday = 0; }
4193: return ( 'second' => $dt->second(),
4194: 'minute' => $dt->minute(),
4195: 'hour' => $dt->hour(),
4196: 'day' => $dt->day_of_month(),
4197: 'month' => $dt->month(),
4198: 'year' => $dt->year(),
4199: 'weekday' => $wday,
4200: 'dayyear' => $dt->day_of_year(),
4201: 'dlsav' => $dt->is_dst() );
1.51 www 4202: }
4203:
1.370 www 4204: sub utc_string {
4205: my ($date)=@_;
1.371 www 4206: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4207: }
4208:
1.51 www 4209: sub maketime {
4210: my %th=@_;
1.687 raeburn 4211: my ($epoch_time,$timezone,$dt);
4212: $timezone = &Apache::lonlocal::gettimezone();
4213: eval {
4214: $dt = DateTime->new( year => $th{'year'},
4215: month => $th{'month'},
4216: day => $th{'day'},
4217: hour => $th{'hour'},
4218: minute => $th{'minute'},
4219: second => $th{'second'},
4220: time_zone => $timezone,
4221: );
4222: };
4223: if (!$@) {
4224: $epoch_time = $dt->epoch;
4225: if ($epoch_time) {
4226: return $epoch_time;
4227: }
4228: }
1.51 www 4229: return POSIX::mktime(
4230: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4231: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4232: }
4233:
4234: #########################################
1.51 www 4235:
4236: sub findallcourses {
1.482 raeburn 4237: my ($roles,$uname,$udom) = @_;
1.355 albertel 4238: my %roles;
4239: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4240: my %courses;
1.51 www 4241: my $now=time;
1.482 raeburn 4242: if (!defined($uname)) {
4243: $uname = $env{'user.name'};
4244: }
4245: if (!defined($udom)) {
4246: $udom = $env{'user.domain'};
4247: }
4248: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4249: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4250: if (!%roles) {
4251: %roles = (
4252: cc => 1,
1.907 raeburn 4253: co => 1,
1.482 raeburn 4254: in => 1,
4255: ep => 1,
4256: ta => 1,
4257: cr => 1,
4258: st => 1,
4259: );
4260: }
4261: foreach my $entry (keys(%roleshash)) {
4262: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4263: if ($trole =~ /^cr/) {
4264: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4265: } else {
4266: next if (!exists($roles{$trole}));
4267: }
4268: if ($tend) {
4269: next if ($tend < $now);
4270: }
4271: if ($tstart) {
4272: next if ($tstart > $now);
4273: }
1.1058 raeburn 4274: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4275: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4276: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4277: if ($secpart eq '') {
4278: ($cnum,$role) = split(/_/,$cnumpart);
4279: $sec = 'none';
1.1058 raeburn 4280: $value .= $cnum.'/';
1.482 raeburn 4281: } else {
4282: $cnum = $cnumpart;
4283: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4284: $value .= $cnum.'/'.$sec;
4285: }
4286: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4287: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4288: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4289: }
4290: } else {
4291: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4292: }
1.482 raeburn 4293: }
4294: } else {
4295: foreach my $key (keys(%env)) {
1.483 albertel 4296: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4297: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4298: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4299: next if ($role eq 'ca' || $role eq 'aa');
4300: next if (%roles && !exists($roles{$role}));
4301: my ($starttime,$endtime)=split(/\./,$env{$key});
4302: my $active=1;
4303: if ($starttime) {
4304: if ($now<$starttime) { $active=0; }
4305: }
4306: if ($endtime) {
4307: if ($now>$endtime) { $active=0; }
4308: }
4309: if ($active) {
1.1058 raeburn 4310: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4311: if ($sec eq '') {
4312: $sec = 'none';
1.1058 raeburn 4313: } else {
4314: $value .= $sec;
4315: }
4316: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4317: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4318: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4319: }
4320: } else {
4321: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4322: }
1.474 raeburn 4323: }
4324: }
1.51 www 4325: }
4326: }
1.474 raeburn 4327: return %courses;
1.51 www 4328: }
1.37 matthew 4329:
1.54 www 4330: ###############################################
1.474 raeburn 4331:
4332: sub blockcheck {
1.1075.2.73 raeburn 4333: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4334:
1.1075.2.73 raeburn 4335: if (defined($udom) && defined($uname)) {
4336: # If uname and udom are for a course, check for blocks in the course.
4337: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4338: my ($startblock,$endblock,$triggerblock) =
4339: &get_blocks($setters,$activity,$udom,$uname,$url);
4340: return ($startblock,$endblock,$triggerblock);
4341: }
4342: } else {
1.490 raeburn 4343: $udom = $env{'user.domain'};
4344: $uname = $env{'user.name'};
4345: }
4346:
1.502 raeburn 4347: my $startblock = 0;
4348: my $endblock = 0;
1.1062 raeburn 4349: my $triggerblock = '';
1.482 raeburn 4350: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4351:
1.490 raeburn 4352: # If uname is for a user, and activity is course-specific, i.e.,
4353: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4354:
1.490 raeburn 4355: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73 raeburn 4356: $activity eq 'groups' || $activity eq 'printout') &&
4357: ($env{'request.course.id'})) {
1.490 raeburn 4358: foreach my $key (keys(%live_courses)) {
4359: if ($key ne $env{'request.course.id'}) {
4360: delete($live_courses{$key});
4361: }
4362: }
4363: }
4364:
4365: my $otheruser = 0;
4366: my %own_courses;
4367: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4368: # Resource belongs to user other than current user.
4369: $otheruser = 1;
4370: # Gather courses for current user
4371: %own_courses =
4372: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4373: }
4374:
4375: # Gather active course roles - course coordinator, instructor,
4376: # exam proctor, ta, student, or custom role.
1.474 raeburn 4377:
4378: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4379: my ($cdom,$cnum);
4380: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4381: $cdom = $env{'course.'.$course.'.domain'};
4382: $cnum = $env{'course.'.$course.'.num'};
4383: } else {
1.490 raeburn 4384: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4385: }
4386: my $no_ownblock = 0;
4387: my $no_userblock = 0;
1.533 raeburn 4388: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4389: # Check if current user has 'evb' priv for this
4390: if (defined($own_courses{$course})) {
4391: foreach my $sec (keys(%{$own_courses{$course}})) {
4392: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4393: if ($sec ne 'none') {
4394: $checkrole .= '/'.$sec;
4395: }
4396: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4397: $no_ownblock = 1;
4398: last;
4399: }
4400: }
4401: }
4402: # if they have 'evb' priv and are currently not playing student
4403: next if (($no_ownblock) &&
4404: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4405: }
1.474 raeburn 4406: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4407: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4408: if ($sec ne 'none') {
1.482 raeburn 4409: $checkrole .= '/'.$sec;
1.474 raeburn 4410: }
1.490 raeburn 4411: if ($otheruser) {
4412: # Resource belongs to user other than current user.
4413: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4414: my (%allroles,%userroles);
4415: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4416: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4417: my ($trole,$tdom,$tnum,$tsec);
4418: if ($entry =~ /^cr/) {
4419: ($trole,$tdom,$tnum,$tsec) =
4420: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4421: } else {
4422: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4423: }
4424: my ($spec,$area,$trest);
4425: $area = '/'.$tdom.'/'.$tnum;
4426: $trest = $tnum;
4427: if ($tsec ne '') {
4428: $area .= '/'.$tsec;
4429: $trest .= '/'.$tsec;
4430: }
4431: $spec = $trole.'.'.$area;
4432: if ($trole =~ /^cr/) {
4433: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4434: $tdom,$spec,$trest,$area);
4435: } else {
4436: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4437: $tdom,$spec,$trest,$area);
4438: }
4439: }
4440: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4441: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4442: if ($1) {
4443: $no_userblock = 1;
4444: last;
4445: }
1.486 raeburn 4446: }
4447: }
1.490 raeburn 4448: } else {
4449: # Resource belongs to current user
4450: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4451: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4452: $no_ownblock = 1;
4453: last;
4454: }
1.474 raeburn 4455: }
4456: }
4457: # if they have the evb priv and are currently not playing student
1.482 raeburn 4458: next if (($no_ownblock) &&
1.491 albertel 4459: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4460: next if ($no_userblock);
1.474 raeburn 4461:
1.866 kalberla 4462: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4463: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4464:
1.1062 raeburn 4465: my ($start,$end,$trigger) =
4466: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4467: if (($start != 0) &&
4468: (($startblock == 0) || ($startblock > $start))) {
4469: $startblock = $start;
1.1062 raeburn 4470: if ($trigger ne '') {
4471: $triggerblock = $trigger;
4472: }
1.502 raeburn 4473: }
4474: if (($end != 0) &&
4475: (($endblock == 0) || ($endblock < $end))) {
4476: $endblock = $end;
1.1062 raeburn 4477: if ($trigger ne '') {
4478: $triggerblock = $trigger;
4479: }
1.502 raeburn 4480: }
1.490 raeburn 4481: }
1.1062 raeburn 4482: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4483: }
4484:
4485: sub get_blocks {
1.1062 raeburn 4486: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4487: my $startblock = 0;
4488: my $endblock = 0;
1.1062 raeburn 4489: my $triggerblock = '';
1.490 raeburn 4490: my $course = $cdom.'_'.$cnum;
4491: $setters->{$course} = {};
4492: $setters->{$course}{'staff'} = [];
4493: $setters->{$course}{'times'} = [];
1.1062 raeburn 4494: $setters->{$course}{'triggers'} = [];
4495: my (@blockers,%triggered);
4496: my $now = time;
4497: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4498: if ($activity eq 'docs') {
4499: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4500: foreach my $block (@blockers) {
4501: if ($block =~ /^firstaccess____(.+)$/) {
4502: my $item = $1;
4503: my $type = 'map';
4504: my $timersymb = $item;
4505: if ($item eq 'course') {
4506: $type = 'course';
4507: } elsif ($item =~ /___\d+___/) {
4508: $type = 'resource';
4509: } else {
4510: $timersymb = &Apache::lonnet::symbread($item);
4511: }
4512: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4513: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4514: $triggered{$block} = {
4515: start => $start,
4516: end => $end,
4517: type => $type,
4518: };
4519: }
4520: }
4521: } else {
4522: foreach my $block (keys(%commblocks)) {
4523: if ($block =~ m/^(\d+)____(\d+)$/) {
4524: my ($start,$end) = ($1,$2);
4525: if ($start <= time && $end >= time) {
4526: if (ref($commblocks{$block}) eq 'HASH') {
4527: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4528: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4529: unless(grep(/^\Q$block\E$/,@blockers)) {
4530: push(@blockers,$block);
4531: }
4532: }
4533: }
4534: }
4535: }
4536: } elsif ($block =~ /^firstaccess____(.+)$/) {
4537: my $item = $1;
4538: my $timersymb = $item;
4539: my $type = 'map';
4540: if ($item eq 'course') {
4541: $type = 'course';
4542: } elsif ($item =~ /___\d+___/) {
4543: $type = 'resource';
4544: } else {
4545: $timersymb = &Apache::lonnet::symbread($item);
4546: }
4547: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4548: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4549: if ($start && $end) {
4550: if (($start <= time) && ($end >= time)) {
4551: unless (grep(/^\Q$block\E$/,@blockers)) {
4552: push(@blockers,$block);
4553: $triggered{$block} = {
4554: start => $start,
4555: end => $end,
4556: type => $type,
4557: };
4558: }
4559: }
1.490 raeburn 4560: }
1.1062 raeburn 4561: }
4562: }
4563: }
4564: foreach my $blocker (@blockers) {
4565: my ($staff_name,$staff_dom,$title,$blocks) =
4566: &parse_block_record($commblocks{$blocker});
4567: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4568: my ($start,$end,$triggertype);
4569: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4570: ($start,$end) = ($1,$2);
4571: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4572: $start = $triggered{$blocker}{'start'};
4573: $end = $triggered{$blocker}{'end'};
4574: $triggertype = $triggered{$blocker}{'type'};
4575: }
4576: if ($start) {
4577: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4578: if ($triggertype) {
4579: push(@{$$setters{$course}{'triggers'}},$triggertype);
4580: } else {
4581: push(@{$$setters{$course}{'triggers'}},0);
4582: }
4583: if ( ($startblock == 0) || ($startblock > $start) ) {
4584: $startblock = $start;
4585: if ($triggertype) {
4586: $triggerblock = $blocker;
1.474 raeburn 4587: }
4588: }
1.1062 raeburn 4589: if ( ($endblock == 0) || ($endblock < $end) ) {
4590: $endblock = $end;
4591: if ($triggertype) {
4592: $triggerblock = $blocker;
4593: }
4594: }
1.474 raeburn 4595: }
4596: }
1.1062 raeburn 4597: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4598: }
4599:
4600: sub parse_block_record {
4601: my ($record) = @_;
4602: my ($setuname,$setudom,$title,$blocks);
4603: if (ref($record) eq 'HASH') {
4604: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4605: $title = &unescape($record->{'event'});
4606: $blocks = $record->{'blocks'};
4607: } else {
4608: my @data = split(/:/,$record,3);
4609: if (scalar(@data) eq 2) {
4610: $title = $data[1];
4611: ($setuname,$setudom) = split(/@/,$data[0]);
4612: } else {
4613: ($setuname,$setudom,$title) = @data;
4614: }
4615: $blocks = { 'com' => 'on' };
4616: }
4617: return ($setuname,$setudom,$title,$blocks);
4618: }
4619:
1.854 kalberla 4620: sub blocking_status {
1.1075.2.73 raeburn 4621: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4622: my %setters;
1.890 droeschl 4623:
1.1061 raeburn 4624: # check for active blocking
1.1062 raeburn 4625: my ($startblock,$endblock,$triggerblock) =
1.1075.2.73 raeburn 4626: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4627: my $blocked = 0;
4628: if ($startblock && $endblock) {
4629: $blocked = 1;
4630: }
1.890 droeschl 4631:
1.1061 raeburn 4632: # caller just wants to know whether a block is active
4633: if (!wantarray) { return $blocked; }
4634:
4635: # build a link to a popup window containing the details
4636: my $querystring = "?activity=$activity";
4637: # $uname and $udom decide whose portfolio the user is trying to look at
1.1075.2.97 raeburn 4638: if (($activity eq 'port') || ($activity eq 'passwd')) {
4639: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
4640: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 4641: } elsif ($activity eq 'docs') {
4642: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4643: }
1.1061 raeburn 4644:
4645: my $output .= <<'END_MYBLOCK';
4646: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4647: var options = "width=" + w + ",height=" + h + ",";
4648: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4649: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4650: var newWin = window.open(url, wdwName, options);
4651: newWin.focus();
4652: }
1.890 droeschl 4653: END_MYBLOCK
1.854 kalberla 4654:
1.1061 raeburn 4655: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4656:
1.1061 raeburn 4657: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4658: my $text = &mt('Communication Blocked');
1.1075.2.93 raeburn 4659: my $class = 'LC_comblock';
1.1062 raeburn 4660: if ($activity eq 'docs') {
4661: $text = &mt('Content Access Blocked');
1.1075.2.93 raeburn 4662: $class = '';
1.1063 raeburn 4663: } elsif ($activity eq 'printout') {
4664: $text = &mt('Printing Blocked');
1.1075.2.97 raeburn 4665: } elsif ($activity eq 'passwd') {
4666: $text = &mt('Password Changing Blocked');
1.1062 raeburn 4667: }
1.1061 raeburn 4668: $output .= <<"END_BLOCK";
1.1075.2.93 raeburn 4669: <div class='$class'>
1.869 kalberla 4670: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4671: title='$text'>
4672: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4673: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4674: title='$text'>$text</a>
1.867 kalberla 4675: </div>
4676:
4677: END_BLOCK
1.474 raeburn 4678:
1.1061 raeburn 4679: return ($blocked, $output);
1.854 kalberla 4680: }
1.490 raeburn 4681:
1.60 matthew 4682: ###############################################
4683:
1.682 raeburn 4684: sub check_ip_acc {
4685: my ($acc)=@_;
4686: &Apache::lonxml::debug("acc is $acc");
4687: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4688: return 1;
4689: }
4690: my $allowed=0;
4691: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4692:
4693: my $name;
4694: foreach my $pattern (split(',',$acc)) {
4695: $pattern =~ s/^\s*//;
4696: $pattern =~ s/\s*$//;
4697: if ($pattern =~ /\*$/) {
4698: #35.8.*
4699: $pattern=~s/\*//;
4700: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4701: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4702: #35.8.3.[34-56]
4703: my $low=$2;
4704: my $high=$3;
4705: $pattern=$1;
4706: if ($ip =~ /^\Q$pattern\E/) {
4707: my $last=(split(/\./,$ip))[3];
4708: if ($last <=$high && $last >=$low) { $allowed=1; }
4709: }
4710: } elsif ($pattern =~ /^\*/) {
4711: #*.msu.edu
4712: $pattern=~s/\*//;
4713: if (!defined($name)) {
4714: use Socket;
4715: my $netaddr=inet_aton($ip);
4716: ($name)=gethostbyaddr($netaddr,AF_INET);
4717: }
4718: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4719: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4720: #127.0.0.1
4721: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4722: } else {
4723: #some.name.com
4724: if (!defined($name)) {
4725: use Socket;
4726: my $netaddr=inet_aton($ip);
4727: ($name)=gethostbyaddr($netaddr,AF_INET);
4728: }
4729: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4730: }
4731: if ($allowed) { last; }
4732: }
4733: return $allowed;
4734: }
4735:
4736: ###############################################
4737:
1.60 matthew 4738: =pod
4739:
1.112 bowersj2 4740: =head1 Domain Template Functions
4741:
4742: =over 4
4743:
4744: =item * &determinedomain()
1.60 matthew 4745:
4746: Inputs: $domain (usually will be undef)
4747:
1.63 www 4748: Returns: Determines which domain should be used for designs
1.60 matthew 4749:
4750: =cut
1.54 www 4751:
1.60 matthew 4752: ###############################################
1.63 www 4753: sub determinedomain {
4754: my $domain=shift;
1.531 albertel 4755: if (! $domain) {
1.60 matthew 4756: # Determine domain if we have not been given one
1.893 raeburn 4757: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4758: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4759: if ($env{'request.role.domain'}) {
4760: $domain=$env{'request.role.domain'};
1.60 matthew 4761: }
4762: }
1.63 www 4763: return $domain;
4764: }
4765: ###############################################
1.517 raeburn 4766:
1.518 albertel 4767: sub devalidate_domconfig_cache {
4768: my ($udom)=@_;
4769: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4770: }
4771:
4772: # ---------------------- Get domain configuration for a domain
4773: sub get_domainconf {
4774: my ($udom) = @_;
4775: my $cachetime=1800;
4776: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4777: if (defined($cached)) { return %{$result}; }
4778:
4779: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4780: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4781: my (%designhash,%legacy);
1.518 albertel 4782: if (keys(%domconfig) > 0) {
4783: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4784: if (keys(%{$domconfig{'login'}})) {
4785: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4786: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87 raeburn 4787: if (($key eq 'loginvia') || ($key eq 'headtag')) {
4788: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4789: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
4790: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
4791: if ($key eq 'loginvia') {
4792: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4793: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4794: $designhash{$udom.'.login.loginvia'} = $server;
4795: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4796: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4797: } else {
4798: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
4799: }
1.948 raeburn 4800: }
1.1075.2.87 raeburn 4801: } elsif ($key eq 'headtag') {
4802: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
4803: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 4804: }
1.946 raeburn 4805: }
1.1075.2.87 raeburn 4806: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
4807: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
4808: }
1.946 raeburn 4809: }
4810: }
4811: }
4812: } else {
4813: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4814: $designhash{$udom.'.login.'.$key.'_'.$img} =
4815: $domconfig{'login'}{$key}{$img};
4816: }
1.699 raeburn 4817: }
4818: } else {
4819: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4820: }
1.632 raeburn 4821: }
4822: } else {
4823: $legacy{'login'} = 1;
1.518 albertel 4824: }
1.632 raeburn 4825: } else {
4826: $legacy{'login'} = 1;
1.518 albertel 4827: }
4828: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4829: if (keys(%{$domconfig{'rolecolors'}})) {
4830: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4831: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4832: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4833: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4834: }
1.518 albertel 4835: }
4836: }
1.632 raeburn 4837: } else {
4838: $legacy{'rolecolors'} = 1;
1.518 albertel 4839: }
1.632 raeburn 4840: } else {
4841: $legacy{'rolecolors'} = 1;
1.518 albertel 4842: }
1.948 raeburn 4843: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4844: if ($domconfig{'autoenroll'}{'co-owners'}) {
4845: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4846: }
4847: }
1.632 raeburn 4848: if (keys(%legacy) > 0) {
4849: my %legacyhash = &get_legacy_domconf($udom);
4850: foreach my $item (keys(%legacyhash)) {
4851: if ($item =~ /^\Q$udom\E\.login/) {
4852: if ($legacy{'login'}) {
4853: $designhash{$item} = $legacyhash{$item};
4854: }
4855: } else {
4856: if ($legacy{'rolecolors'}) {
4857: $designhash{$item} = $legacyhash{$item};
4858: }
1.518 albertel 4859: }
4860: }
4861: }
1.632 raeburn 4862: } else {
4863: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4864: }
4865: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4866: $cachetime);
4867: return %designhash;
4868: }
4869:
1.632 raeburn 4870: sub get_legacy_domconf {
4871: my ($udom) = @_;
4872: my %legacyhash;
4873: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4874: my $designfile = $designdir.'/'.$udom.'.tab';
4875: if (-e $designfile) {
4876: if ( open (my $fh,"<$designfile") ) {
4877: while (my $line = <$fh>) {
4878: next if ($line =~ /^\#/);
4879: chomp($line);
4880: my ($key,$val)=(split(/\=/,$line));
4881: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4882: }
4883: close($fh);
4884: }
4885: }
1.1026 raeburn 4886: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4887: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4888: }
4889: return %legacyhash;
4890: }
4891:
1.63 www 4892: =pod
4893:
1.112 bowersj2 4894: =item * &domainlogo()
1.63 www 4895:
4896: Inputs: $domain (usually will be undef)
4897:
4898: Returns: A link to a domain logo, if the domain logo exists.
4899: If the domain logo does not exist, a description of the domain.
4900:
4901: =cut
1.112 bowersj2 4902:
1.63 www 4903: ###############################################
4904: sub domainlogo {
1.517 raeburn 4905: my $domain = &determinedomain(shift);
1.518 albertel 4906: my %designhash = &get_domainconf($domain);
1.517 raeburn 4907: # See if there is a logo
4908: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4909: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4910: if ($imgsrc =~ m{^/(adm|res)/}) {
4911: if ($imgsrc =~ m{^/res/}) {
4912: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4913: &Apache::lonnet::repcopy($local_name);
4914: }
4915: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4916: }
4917: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4918: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4919: return &Apache::lonnet::domain($domain,'description');
1.59 www 4920: } else {
1.60 matthew 4921: return '';
1.59 www 4922: }
4923: }
1.63 www 4924: ##############################################
4925:
4926: =pod
4927:
1.112 bowersj2 4928: =item * &designparm()
1.63 www 4929:
4930: Inputs: $which parameter; $domain (usually will be undef)
4931:
4932: Returns: value of designparamter $which
4933:
4934: =cut
1.112 bowersj2 4935:
1.397 albertel 4936:
1.400 albertel 4937: ##############################################
1.397 albertel 4938: sub designparm {
4939: my ($which,$domain)=@_;
4940: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4941: return $env{'environment.color.'.$which};
1.96 www 4942: }
1.63 www 4943: $domain=&determinedomain($domain);
1.1016 raeburn 4944: my %domdesign;
4945: unless ($domain eq 'public') {
4946: %domdesign = &get_domainconf($domain);
4947: }
1.520 raeburn 4948: my $output;
1.517 raeburn 4949: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4950: $output = $domdesign{$domain.'.'.$which};
1.63 www 4951: } else {
1.520 raeburn 4952: $output = $defaultdesign{$which};
4953: }
4954: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4955: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4956: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4957: if ($output =~ m{^/res/}) {
4958: my $local_name = &Apache::lonnet::filelocation('',$output);
4959: &Apache::lonnet::repcopy($local_name);
4960: }
1.520 raeburn 4961: $output = &lonhttpdurl($output);
4962: }
1.63 www 4963: }
1.520 raeburn 4964: return $output;
1.63 www 4965: }
1.59 www 4966:
1.822 bisitz 4967: ##############################################
4968: =pod
4969:
1.832 bisitz 4970: =item * &authorspace()
4971:
1.1028 raeburn 4972: Inputs: $url (usually will be undef).
1.832 bisitz 4973:
1.1075.2.40 raeburn 4974: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 4975: directory being viewed (or for which action is being taken).
4976: If $url is provided, and begins /priv/<domain>/<uname>
4977: the path will be that portion of the $context argument.
4978: Otherwise the path will be for the author space of the current
4979: user when the current role is author, or for that of the
4980: co-author/assistant co-author space when the current role
4981: is co-author or assistant co-author.
1.832 bisitz 4982:
4983: =cut
4984:
4985: sub authorspace {
1.1028 raeburn 4986: my ($url) = @_;
4987: if ($url ne '') {
4988: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4989: return $1;
4990: }
4991: }
1.832 bisitz 4992: my $caname = '';
1.1024 www 4993: my $cadom = '';
1.1028 raeburn 4994: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4995: ($cadom,$caname) =
1.832 bisitz 4996: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4997: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4998: $caname = $env{'user.name'};
1.1024 www 4999: $cadom = $env{'user.domain'};
1.832 bisitz 5000: }
1.1028 raeburn 5001: if (($caname ne '') && ($cadom ne '')) {
5002: return "/priv/$cadom/$caname/";
5003: }
5004: return;
1.832 bisitz 5005: }
5006:
5007: ##############################################
5008: =pod
5009:
1.822 bisitz 5010: =item * &head_subbox()
5011:
5012: Inputs: $content (contains HTML code with page functions, etc.)
5013:
5014: Returns: HTML div with $content
5015: To be included in page header
5016:
5017: =cut
5018:
5019: sub head_subbox {
5020: my ($content)=@_;
5021: my $output =
1.993 raeburn 5022: '<div class="LC_head_subbox">'
1.822 bisitz 5023: .$content
5024: .'</div>'
5025: }
5026:
5027: ##############################################
5028: =pod
5029:
5030: =item * &CSTR_pageheader()
5031:
1.1026 raeburn 5032: Input: (optional) filename from which breadcrumb trail is built.
5033: In most cases no input as needed, as $env{'request.filename'}
5034: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5035:
5036: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 5037: To be included on Authoring Space pages
1.822 bisitz 5038:
5039: =cut
5040:
5041: sub CSTR_pageheader {
1.1026 raeburn 5042: my ($trailfile) = @_;
5043: if ($trailfile eq '') {
5044: $trailfile = $env{'request.filename'};
5045: }
5046:
5047: # this is for resources; directories have customtitle, and crumbs
5048: # and select recent are created in lonpubdir.pm
5049:
5050: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5051: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 5052: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5053: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5054: $formaction =~ s{/+}{/}g;
1.822 bisitz 5055:
5056: my $parentpath = '';
5057: my $lastitem = '';
5058: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5059: $parentpath = $1;
5060: $lastitem = $2;
5061: } else {
5062: $lastitem = $thisdisfn;
5063: }
1.921 bisitz 5064:
5065: my $output =
1.822 bisitz 5066: '<div>'
5067: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40 raeburn 5068: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5069: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5070: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5071: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5072:
5073: if ($lastitem) {
5074: $output .=
5075: '<span class="LC_filename">'
5076: .$lastitem
5077: .'</span>';
5078: }
5079: $output .=
5080: '<br />'
1.822 bisitz 5081: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5082: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5083: .'</form>'
5084: .&Apache::lonmenu::constspaceform()
5085: .'</div>';
1.921 bisitz 5086:
5087: return $output;
1.822 bisitz 5088: }
5089:
1.60 matthew 5090: ###############################################
5091: ###############################################
5092:
5093: =pod
5094:
1.112 bowersj2 5095: =back
5096:
1.549 albertel 5097: =head1 HTML Helpers
1.112 bowersj2 5098:
5099: =over 4
5100:
5101: =item * &bodytag()
1.60 matthew 5102:
5103: Returns a uniform header for LON-CAPA web pages.
5104:
5105: Inputs:
5106:
1.112 bowersj2 5107: =over 4
5108:
5109: =item * $title, A title to be displayed on the page.
5110:
5111: =item * $function, the current role (can be undef).
5112:
5113: =item * $addentries, extra parameters for the <body> tag.
5114:
5115: =item * $bodyonly, if defined, only return the <body> tag.
5116:
5117: =item * $domain, if defined, force a given domain.
5118:
5119: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5120: text interface only)
1.60 matthew 5121:
1.814 bisitz 5122: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5123: navigational links
1.317 albertel 5124:
1.338 albertel 5125: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5126:
1.1075.2.12 raeburn 5127: =item * $no_inline_link, if true and in remote mode, don't show the
5128: 'Switch To Inline Menu' link
5129:
1.460 albertel 5130: =item * $args, optional argument valid values are
5131: no_auto_mt_title -> prevents &mt()ing the title arg
5132:
1.1075.2.15 raeburn 5133: =item * $advtoolsref, optional argument, ref to an array containing
5134: inlineremote items to be added in "Functions" menu below
5135: breadcrumbs.
5136:
1.112 bowersj2 5137: =back
5138:
1.60 matthew 5139: Returns: A uniform header for LON-CAPA web pages.
5140: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5141: If $bodyonly is undef or zero, an html string containing a <body> tag and
5142: other decorations will be returned.
5143:
5144: =cut
5145:
1.54 www 5146: sub bodytag {
1.831 bisitz 5147: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15 raeburn 5148: $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339 albertel 5149:
1.954 raeburn 5150: my $public;
5151: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5152: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5153: $public = 1;
5154: }
1.460 albertel 5155: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 5156: my $httphost = $args->{'use_absolute'};
1.339 albertel 5157:
1.183 matthew 5158: $function = &get_users_function() if (!$function);
1.339 albertel 5159: my $img = &designparm($function.'.img',$domain);
5160: my $font = &designparm($function.'.font',$domain);
5161: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5162:
1.803 bisitz 5163: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5164: 'bgcolor' => $pgbg,
1.339 albertel 5165: 'text' => $font,
5166: 'alink' => &designparm($function.'.alink',$domain),
5167: 'vlink' => &designparm($function.'.vlink',$domain),
5168: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5169: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5170:
1.63 www 5171: # role and realm
1.1075.2.68 raeburn 5172: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5173: if ($realm) {
5174: $realm = '/'.$realm;
5175: }
1.378 raeburn 5176: if ($role eq 'ca') {
1.479 albertel 5177: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5178: $realm = &plainname($rname,$rdom);
1.378 raeburn 5179: }
1.55 www 5180: # realm
1.258 albertel 5181: if ($env{'request.course.id'}) {
1.378 raeburn 5182: if ($env{'request.role'} !~ /^cr/) {
5183: $role = &Apache::lonnet::plaintext($role,&course_type());
5184: }
1.898 raeburn 5185: if ($env{'request.course.sec'}) {
5186: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5187: }
1.359 albertel 5188: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5189: } else {
5190: $role = &Apache::lonnet::plaintext($role);
1.54 www 5191: }
1.433 albertel 5192:
1.359 albertel 5193: if (!$realm) { $realm=' '; }
1.330 albertel 5194:
1.438 albertel 5195: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5196:
1.101 www 5197: # construct main body tag
1.359 albertel 5198: my $bodytag = "<body $extra_body_attr>".
1.1075.2.100 raeburn 5199: &Apache::lontexconvert::init_math_support();
1.252 albertel 5200:
1.1075.2.38 raeburn 5201: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5202:
5203: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5204: return $bodytag;
1.1075.2.38 raeburn 5205: }
1.359 albertel 5206:
1.954 raeburn 5207: if ($public) {
1.433 albertel 5208: undef($role);
5209: }
1.359 albertel 5210:
1.762 bisitz 5211: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5212: #
5213: # Extra info if you are the DC
5214: my $dc_info = '';
5215: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5216: $env{'course.'.$env{'request.course.id'}.
5217: '.domain'}.'/'})) {
5218: my $cid = $env{'request.course.id'};
1.917 raeburn 5219: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5220: $dc_info =~ s/\s+$//;
1.359 albertel 5221: }
5222:
1.898 raeburn 5223: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903 droeschl 5224:
1.1075.2.13 raeburn 5225: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5226:
1.1075.2.38 raeburn 5227:
5228:
1.1075.2.21 raeburn 5229: my $funclist;
5230: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52 raeburn 5231: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21 raeburn 5232: Apache::lonmenu::serverform();
5233: my $forbodytag;
5234: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5235: $forcereg,$args->{'group'},
5236: $args->{'bread_crumbs'},
5237: $advtoolsref,'',\$forbodytag);
5238: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5239: $funclist = $forbodytag;
5240: }
5241: } else {
1.903 droeschl 5242:
5243: # if ($env{'request.state'} eq 'construct') {
5244: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5245: # }
5246:
1.1075.2.38 raeburn 5247: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5248: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5249:
1.1075.2.38 raeburn 5250: my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2 raeburn 5251:
1.916 droeschl 5252: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22 raeburn 5253: if ($dc_info) {
5254: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1 raeburn 5255: }
1.1075.2.38 raeburn 5256: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22 raeburn 5257: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5258: return $bodytag;
5259: }
1.894 droeschl 5260:
1.927 raeburn 5261: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38 raeburn 5262: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5263: }
1.916 droeschl 5264:
1.1075.2.38 raeburn 5265: $bodytag .= $right;
1.852 droeschl 5266:
1.917 raeburn 5267: if ($dc_info) {
5268: $dc_info = &dc_courseid_toggle($dc_info);
5269: }
5270: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5271:
1.1075.2.61 raeburn 5272: #if directed to not display the secondary menu, don't.
5273: if ($args->{'no_secondary_menu'}) {
5274: return $bodytag;
5275: }
1.903 droeschl 5276: #don't show menus for public users
1.954 raeburn 5277: if (!$public){
1.1075.2.52 raeburn 5278: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5279: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5280: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5281: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5282: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5283: $args->{'bread_crumbs'});
5284: } elsif ($forcereg) {
1.1075.2.22 raeburn 5285: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5286: $args->{'group'});
1.1075.2.15 raeburn 5287: } else {
1.1075.2.21 raeburn 5288: my $forbodytag;
5289: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5290: $forcereg,$args->{'group'},
5291: $args->{'bread_crumbs'},
5292: $advtoolsref,'',\$forbodytag);
5293: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5294: $bodytag .= $forbodytag;
5295: }
1.920 raeburn 5296: }
1.903 droeschl 5297: }else{
5298: # this is to seperate menu from content when there's no secondary
5299: # menu. Especially needed for public accessible ressources.
5300: $bodytag .= '<hr style="clear:both" />';
5301: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5302: }
1.903 droeschl 5303:
1.235 raeburn 5304: return $bodytag;
1.1075.2.12 raeburn 5305: }
5306:
5307: #
5308: # Top frame rendering, Remote is up
5309: #
5310:
5311: my $imgsrc = $img;
5312: if ($img =~ /^\/adm/) {
5313: $imgsrc = &lonhttpdurl($img);
5314: }
5315: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
5316:
1.1075.2.60 raeburn 5317: my $help=($no_inline_link?''
5318: :&Apache::loncommon::top_nav_help('Help'));
5319:
1.1075.2.12 raeburn 5320: # Explicit link to get inline menu
5321: my $menu= ($no_inline_link?''
5322: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
5323:
5324: if ($dc_info) {
5325: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5326: }
5327:
1.1075.2.38 raeburn 5328: my $name = &plainname($env{'user.name'},$env{'user.domain'});
5329: unless ($public) {
5330: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5331: undef,'LC_menubuttons_link');
5332: }
5333:
1.1075.2.12 raeburn 5334: unless ($env{'form.inhibitmenu'}) {
5335: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38 raeburn 5336: <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60 raeburn 5337: <li>$help</li>
1.1075.2.12 raeburn 5338: <li>$menu</li>
5339: </ol><div id="LC_realm"> $realm $dc_info</div>|;
5340: }
1.1075.2.13 raeburn 5341: if ($env{'request.state'} eq 'construct') {
5342: if (!$public){
5343: if ($env{'request.state'} eq 'construct') {
5344: $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5345: &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13 raeburn 5346: &Apache::lonhtmlcommon::scripttag('','end').
5347: &Apache::lonmenu::innerregister($forcereg,
5348: $args->{'bread_crumbs'});
5349: }
5350: }
5351: }
1.1075.2.21 raeburn 5352: return $bodytag."\n".$funclist;
1.182 matthew 5353: }
5354:
1.917 raeburn 5355: sub dc_courseid_toggle {
5356: my ($dc_info) = @_;
1.980 raeburn 5357: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5358: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5359: &mt('(More ...)').'</a></span>'.
5360: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5361: }
5362:
1.330 albertel 5363: sub make_attr_string {
5364: my ($register,$attr_ref) = @_;
5365:
5366: if ($attr_ref && !ref($attr_ref)) {
5367: die("addentries Must be a hash ref ".
5368: join(':',caller(1))." ".
5369: join(':',caller(0))." ");
5370: }
5371:
5372: if ($register) {
1.339 albertel 5373: my ($on_load,$on_unload);
5374: foreach my $key (keys(%{$attr_ref})) {
5375: if (lc($key) eq 'onload') {
5376: $on_load.=$attr_ref->{$key}.';';
5377: delete($attr_ref->{$key});
5378:
5379: } elsif (lc($key) eq 'onunload') {
5380: $on_unload.=$attr_ref->{$key}.';';
5381: delete($attr_ref->{$key});
5382: }
5383: }
1.1075.2.12 raeburn 5384: if ($env{'environment.remote'} eq 'on') {
5385: $attr_ref->{'onload'} =
5386: &Apache::lonmenu::loadevents(). $on_load;
5387: $attr_ref->{'onunload'}=
5388: &Apache::lonmenu::unloadevents().$on_unload;
5389: } else {
5390: $attr_ref->{'onload'} = $on_load;
5391: $attr_ref->{'onunload'}= $on_unload;
5392: }
1.330 albertel 5393: }
1.339 albertel 5394:
1.330 albertel 5395: my $attr_string;
1.1075.2.56 raeburn 5396: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5397: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5398: }
5399: return $attr_string;
5400: }
5401:
5402:
1.182 matthew 5403: ###############################################
1.251 albertel 5404: ###############################################
5405:
5406: =pod
5407:
5408: =item * &endbodytag()
5409:
5410: Returns a uniform footer for LON-CAPA web pages.
5411:
1.635 raeburn 5412: Inputs: 1 - optional reference to an args hash
5413: If in the hash, key for noredirectlink has a value which evaluates to true,
5414: a 'Continue' link is not displayed if the page contains an
5415: internal redirect in the <head></head> section,
5416: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5417:
5418: =cut
5419:
5420: sub endbodytag {
1.635 raeburn 5421: my ($args) = @_;
1.1075.2.6 raeburn 5422: my $endbodytag;
5423: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5424: $endbodytag='</body>';
5425: }
1.315 albertel 5426: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5427: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5428: $endbodytag=
5429: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5430: &mt('Continue').'</a>'.
5431: $endbodytag;
5432: }
1.315 albertel 5433: }
1.251 albertel 5434: return $endbodytag;
5435: }
5436:
1.352 albertel 5437: =pod
5438:
5439: =item * &standard_css()
5440:
5441: Returns a style sheet
5442:
5443: Inputs: (all optional)
5444: domain -> force to color decorate a page for a specific
5445: domain
5446: function -> force usage of a specific rolish color scheme
5447: bgcolor -> override the default page bgcolor
5448:
5449: =cut
5450:
1.343 albertel 5451: sub standard_css {
1.345 albertel 5452: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5453: $function = &get_users_function() if (!$function);
5454: my $img = &designparm($function.'.img', $domain);
5455: my $tabbg = &designparm($function.'.tabbg', $domain);
5456: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5457: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5458: #second colour for later usage
1.345 albertel 5459: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5460: my $pgbg_or_bgcolor =
5461: $bgcolor ||
1.352 albertel 5462: &designparm($function.'.pgbg', $domain);
1.382 albertel 5463: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5464: my $alink = &designparm($function.'.alink', $domain);
5465: my $vlink = &designparm($function.'.vlink', $domain);
5466: my $link = &designparm($function.'.link', $domain);
5467:
1.602 albertel 5468: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5469: my $mono = 'monospace';
1.850 bisitz 5470: my $data_table_head = $sidebg;
5471: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5472: my $data_table_dark = '#E0E0E0';
1.470 banghart 5473: my $data_table_darker = '#CCCCCC';
1.349 albertel 5474: my $data_table_highlight = '#FFFF00';
1.352 albertel 5475: my $mail_new = '#FFBB77';
5476: my $mail_new_hover = '#DD9955';
5477: my $mail_read = '#BBBB77';
5478: my $mail_read_hover = '#999944';
5479: my $mail_replied = '#AAAA88';
5480: my $mail_replied_hover = '#888855';
5481: my $mail_other = '#99BBBB';
5482: my $mail_other_hover = '#669999';
1.391 albertel 5483: my $table_header = '#DDDDDD';
1.489 raeburn 5484: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5485: my $lg_border_color = '#C8C8C8';
1.952 onken 5486: my $button_hover = '#BF2317';
1.392 albertel 5487:
1.608 albertel 5488: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5489: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5490: : '0 3px 0 4px';
1.448 albertel 5491:
1.523 albertel 5492:
1.343 albertel 5493: return <<END;
1.947 droeschl 5494:
5495: /* needed for iframe to allow 100% height in FF */
5496: body, html {
5497: margin: 0;
5498: padding: 0 0.5%;
5499: height: 99%; /* to avoid scrollbars */
5500: }
5501:
1.795 www 5502: body {
1.911 bisitz 5503: font-family: $sans;
5504: line-height:130%;
5505: font-size:0.83em;
5506: color:$font;
1.795 www 5507: }
5508:
1.959 onken 5509: a:focus,
5510: a:focus img {
1.795 www 5511: color: red;
5512: }
1.698 harmsja 5513:
1.911 bisitz 5514: form, .inline {
5515: display: inline;
1.795 www 5516: }
1.721 harmsja 5517:
1.795 www 5518: .LC_right {
1.911 bisitz 5519: text-align:right;
1.795 www 5520: }
5521:
5522: .LC_middle {
1.911 bisitz 5523: vertical-align:middle;
1.795 www 5524: }
1.721 harmsja 5525:
1.1075.2.38 raeburn 5526: .LC_floatleft {
5527: float: left;
5528: }
5529:
5530: .LC_floatright {
5531: float: right;
5532: }
5533:
1.911 bisitz 5534: .LC_400Box {
5535: width:400px;
5536: }
1.721 harmsja 5537:
1.947 droeschl 5538: .LC_iframecontainer {
5539: width: 98%;
5540: margin: 0;
5541: position: fixed;
5542: top: 8.5em;
5543: bottom: 0;
5544: }
5545:
5546: .LC_iframecontainer iframe{
5547: border: none;
5548: width: 100%;
5549: height: 100%;
5550: }
5551:
1.778 bisitz 5552: .LC_filename {
5553: font-family: $mono;
5554: white-space:pre;
1.921 bisitz 5555: font-size: 120%;
1.778 bisitz 5556: }
5557:
5558: .LC_fileicon {
5559: border: none;
5560: height: 1.3em;
5561: vertical-align: text-bottom;
5562: margin-right: 0.3em;
5563: text-decoration:none;
5564: }
5565:
1.1008 www 5566: .LC_setting {
5567: text-decoration:underline;
5568: }
5569:
1.350 albertel 5570: .LC_error {
5571: color: red;
5572: }
1.795 www 5573:
1.1075.2.15 raeburn 5574: .LC_warning {
5575: color: darkorange;
5576: }
5577:
1.457 albertel 5578: .LC_diff_removed {
1.733 bisitz 5579: color: red;
1.394 albertel 5580: }
1.532 albertel 5581:
5582: .LC_info,
1.457 albertel 5583: .LC_success,
5584: .LC_diff_added {
1.350 albertel 5585: color: green;
5586: }
1.795 www 5587:
1.802 bisitz 5588: div.LC_confirm_box {
5589: background-color: #FAFAFA;
5590: border: 1px solid $lg_border_color;
5591: margin-right: 0;
5592: padding: 5px;
5593: }
5594:
5595: div.LC_confirm_box .LC_error img,
5596: div.LC_confirm_box .LC_success img {
5597: vertical-align: middle;
5598: }
5599:
1.440 albertel 5600: .LC_icon {
1.771 droeschl 5601: border: none;
1.790 droeschl 5602: vertical-align: middle;
1.771 droeschl 5603: }
5604:
1.543 albertel 5605: .LC_docs_spacer {
5606: width: 25px;
5607: height: 1px;
1.771 droeschl 5608: border: none;
1.543 albertel 5609: }
1.346 albertel 5610:
1.532 albertel 5611: .LC_internal_info {
1.735 bisitz 5612: color: #999999;
1.532 albertel 5613: }
5614:
1.794 www 5615: .LC_discussion {
1.1050 www 5616: background: $data_table_dark;
1.911 bisitz 5617: border: 1px solid black;
5618: margin: 2px;
1.794 www 5619: }
5620:
5621: .LC_disc_action_left {
1.1050 www 5622: background: $sidebg;
1.911 bisitz 5623: text-align: left;
1.1050 www 5624: padding: 4px;
5625: margin: 2px;
1.794 www 5626: }
5627:
5628: .LC_disc_action_right {
1.1050 www 5629: background: $sidebg;
1.911 bisitz 5630: text-align: right;
1.1050 www 5631: padding: 4px;
5632: margin: 2px;
1.794 www 5633: }
5634:
5635: .LC_disc_new_item {
1.911 bisitz 5636: background: white;
5637: border: 2px solid red;
1.1050 www 5638: margin: 4px;
5639: padding: 4px;
1.794 www 5640: }
5641:
5642: .LC_disc_old_item {
1.911 bisitz 5643: background: white;
1.1050 www 5644: margin: 4px;
5645: padding: 4px;
1.794 www 5646: }
5647:
1.458 albertel 5648: table.LC_pastsubmission {
5649: border: 1px solid black;
5650: margin: 2px;
5651: }
5652:
1.924 bisitz 5653: table#LC_menubuttons {
1.345 albertel 5654: width: 100%;
5655: background: $pgbg;
1.392 albertel 5656: border: 2px;
1.402 albertel 5657: border-collapse: separate;
1.803 bisitz 5658: padding: 0;
1.345 albertel 5659: }
1.392 albertel 5660:
1.801 tempelho 5661: table#LC_title_bar a {
5662: color: $fontmenu;
5663: }
1.836 bisitz 5664:
1.807 droeschl 5665: table#LC_title_bar {
1.819 tempelho 5666: clear: both;
1.836 bisitz 5667: display: none;
1.807 droeschl 5668: }
5669:
1.795 www 5670: table#LC_title_bar,
1.933 droeschl 5671: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5672: table#LC_title_bar.LC_with_remote {
1.359 albertel 5673: width: 100%;
1.392 albertel 5674: border-color: $pgbg;
5675: border-style: solid;
5676: border-width: $border;
1.379 albertel 5677: background: $pgbg;
1.801 tempelho 5678: color: $fontmenu;
1.392 albertel 5679: border-collapse: collapse;
1.803 bisitz 5680: padding: 0;
1.819 tempelho 5681: margin: 0;
1.359 albertel 5682: }
1.795 www 5683:
1.933 droeschl 5684: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5685: margin: 0;
5686: padding: 0;
1.933 droeschl 5687: position: relative;
5688: list-style: none;
1.913 droeschl 5689: }
1.933 droeschl 5690: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5691: display: inline;
5692: }
1.933 droeschl 5693:
5694: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5695: padding: 0;
1.933 droeschl 5696: margin: 0;
5697: float: left;
1.913 droeschl 5698: }
1.933 droeschl 5699: .LC_breadcrumb_tools_tools {
5700: padding: 0;
5701: margin: 0;
1.913 droeschl 5702: float: right;
5703: }
5704:
1.359 albertel 5705: table#LC_title_bar td {
5706: background: $tabbg;
5707: }
1.795 www 5708:
1.911 bisitz 5709: table#LC_menubuttons img {
1.803 bisitz 5710: border: none;
1.346 albertel 5711: }
1.795 www 5712:
1.842 droeschl 5713: .LC_breadcrumbs_component {
1.911 bisitz 5714: float: right;
5715: margin: 0 1em;
1.357 albertel 5716: }
1.842 droeschl 5717: .LC_breadcrumbs_component img {
1.911 bisitz 5718: vertical-align: middle;
1.777 tempelho 5719: }
1.795 www 5720:
1.383 albertel 5721: td.LC_table_cell_checkbox {
5722: text-align: center;
5723: }
1.795 www 5724:
5725: .LC_fontsize_small {
1.911 bisitz 5726: font-size: 70%;
1.705 tempelho 5727: }
5728:
1.844 bisitz 5729: #LC_breadcrumbs {
1.911 bisitz 5730: clear:both;
5731: background: $sidebg;
5732: border-bottom: 1px solid $lg_border_color;
5733: line-height: 2.5em;
1.933 droeschl 5734: overflow: hidden;
1.911 bisitz 5735: margin: 0;
5736: padding: 0;
1.995 raeburn 5737: text-align: left;
1.819 tempelho 5738: }
1.862 bisitz 5739:
1.1075.2.16 raeburn 5740: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5741: clear:both;
5742: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5743: border: 1px solid $sidebg;
1.1075.2.16 raeburn 5744: margin: 0 0 10px 0;
1.966 bisitz 5745: padding: 3px;
1.995 raeburn 5746: text-align: left;
1.822 bisitz 5747: }
5748:
1.795 www 5749: .LC_fontsize_medium {
1.911 bisitz 5750: font-size: 85%;
1.705 tempelho 5751: }
5752:
1.795 www 5753: .LC_fontsize_large {
1.911 bisitz 5754: font-size: 120%;
1.705 tempelho 5755: }
5756:
1.346 albertel 5757: .LC_menubuttons_inline_text {
5758: color: $font;
1.698 harmsja 5759: font-size: 90%;
1.701 harmsja 5760: padding-left:3px;
1.346 albertel 5761: }
5762:
1.934 droeschl 5763: .LC_menubuttons_inline_text img{
5764: vertical-align: middle;
5765: }
5766:
1.1051 www 5767: li.LC_menubuttons_inline_text img {
1.951 onken 5768: cursor:pointer;
1.1002 droeschl 5769: text-decoration: none;
1.951 onken 5770: }
5771:
1.526 www 5772: .LC_menubuttons_link {
5773: text-decoration: none;
5774: }
1.795 www 5775:
1.522 albertel 5776: .LC_menubuttons_category {
1.521 www 5777: color: $font;
1.526 www 5778: background: $pgbg;
1.521 www 5779: font-size: larger;
5780: font-weight: bold;
5781: }
5782:
1.346 albertel 5783: td.LC_menubuttons_text {
1.911 bisitz 5784: color: $font;
1.346 albertel 5785: }
1.706 harmsja 5786:
1.346 albertel 5787: .LC_current_location {
5788: background: $tabbg;
5789: }
1.795 www 5790:
1.938 bisitz 5791: table.LC_data_table {
1.347 albertel 5792: border: 1px solid #000000;
1.402 albertel 5793: border-collapse: separate;
1.426 albertel 5794: border-spacing: 1px;
1.610 albertel 5795: background: $pgbg;
1.347 albertel 5796: }
1.795 www 5797:
1.422 albertel 5798: .LC_data_table_dense {
5799: font-size: small;
5800: }
1.795 www 5801:
1.507 raeburn 5802: table.LC_nested_outer {
5803: border: 1px solid #000000;
1.589 raeburn 5804: border-collapse: collapse;
1.803 bisitz 5805: border-spacing: 0;
1.507 raeburn 5806: width: 100%;
5807: }
1.795 www 5808:
1.879 raeburn 5809: table.LC_innerpickbox,
1.507 raeburn 5810: table.LC_nested {
1.803 bisitz 5811: border: none;
1.589 raeburn 5812: border-collapse: collapse;
1.803 bisitz 5813: border-spacing: 0;
1.507 raeburn 5814: width: 100%;
5815: }
1.795 www 5816:
1.911 bisitz 5817: table.LC_data_table tr th,
5818: table.LC_calendar tr th,
1.879 raeburn 5819: table.LC_prior_tries tr th,
5820: table.LC_innerpickbox tr th {
1.349 albertel 5821: font-weight: bold;
5822: background-color: $data_table_head;
1.801 tempelho 5823: color:$fontmenu;
1.701 harmsja 5824: font-size:90%;
1.347 albertel 5825: }
1.795 www 5826:
1.879 raeburn 5827: table.LC_innerpickbox tr th,
5828: table.LC_innerpickbox tr td {
5829: vertical-align: top;
5830: }
5831:
1.711 raeburn 5832: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5833: background-color: #CCCCCC;
1.711 raeburn 5834: font-weight: bold;
5835: text-align: left;
5836: }
1.795 www 5837:
1.912 bisitz 5838: table.LC_data_table tr.LC_odd_row > td {
5839: background-color: $data_table_light;
5840: padding: 2px;
5841: vertical-align: top;
5842: }
5843:
1.809 bisitz 5844: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5845: background-color: $data_table_light;
1.912 bisitz 5846: vertical-align: top;
5847: }
5848:
5849: table.LC_data_table tr.LC_even_row > td {
5850: background-color: $data_table_dark;
1.425 albertel 5851: padding: 2px;
1.900 bisitz 5852: vertical-align: top;
1.347 albertel 5853: }
1.795 www 5854:
1.809 bisitz 5855: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5856: background-color: $data_table_dark;
1.900 bisitz 5857: vertical-align: top;
1.347 albertel 5858: }
1.795 www 5859:
1.425 albertel 5860: table.LC_data_table tr.LC_data_table_highlight td {
5861: background-color: $data_table_darker;
5862: }
1.795 www 5863:
1.639 raeburn 5864: table.LC_data_table tr td.LC_leftcol_header {
5865: background-color: $data_table_head;
5866: font-weight: bold;
5867: }
1.795 www 5868:
1.451 albertel 5869: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5870: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5871: font-weight: bold;
5872: font-style: italic;
5873: text-align: center;
5874: padding: 8px;
1.347 albertel 5875: }
1.795 www 5876:
1.1075.2.30 raeburn 5877: table.LC_data_table tr.LC_empty_row td,
5878: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5879: background-color: $sidebg;
5880: }
5881:
5882: table.LC_nested tr.LC_empty_row td {
5883: background-color: #FFFFFF;
5884: }
5885:
1.890 droeschl 5886: table.LC_caption {
5887: }
5888:
1.507 raeburn 5889: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5890: padding: 4ex
5891: }
1.795 www 5892:
1.507 raeburn 5893: table.LC_nested_outer tr th {
5894: font-weight: bold;
1.801 tempelho 5895: color:$fontmenu;
1.507 raeburn 5896: background-color: $data_table_head;
1.701 harmsja 5897: font-size: small;
1.507 raeburn 5898: border-bottom: 1px solid #000000;
5899: }
1.795 www 5900:
1.507 raeburn 5901: table.LC_nested_outer tr td.LC_subheader {
5902: background-color: $data_table_head;
5903: font-weight: bold;
5904: font-size: small;
5905: border-bottom: 1px solid #000000;
5906: text-align: right;
1.451 albertel 5907: }
1.795 www 5908:
1.507 raeburn 5909: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5910: background-color: #CCCCCC;
1.451 albertel 5911: font-weight: bold;
5912: font-size: small;
1.507 raeburn 5913: text-align: center;
5914: }
1.795 www 5915:
1.589 raeburn 5916: table.LC_nested tr.LC_info_row td.LC_left_item,
5917: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5918: text-align: left;
1.451 albertel 5919: }
1.795 www 5920:
1.507 raeburn 5921: table.LC_nested td {
1.735 bisitz 5922: background-color: #FFFFFF;
1.451 albertel 5923: font-size: small;
1.507 raeburn 5924: }
1.795 www 5925:
1.507 raeburn 5926: table.LC_nested_outer tr th.LC_right_item,
5927: table.LC_nested tr.LC_info_row td.LC_right_item,
5928: table.LC_nested tr.LC_odd_row td.LC_right_item,
5929: table.LC_nested tr td.LC_right_item {
1.451 albertel 5930: text-align: right;
5931: }
5932:
1.507 raeburn 5933: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5934: background-color: #EEEEEE;
1.451 albertel 5935: }
5936:
1.473 raeburn 5937: table.LC_createuser {
5938: }
5939:
5940: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5941: font-size: small;
1.473 raeburn 5942: }
5943:
5944: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5945: background-color: #CCCCCC;
1.473 raeburn 5946: font-weight: bold;
5947: text-align: center;
5948: }
5949:
1.349 albertel 5950: table.LC_calendar {
5951: border: 1px solid #000000;
5952: border-collapse: collapse;
1.917 raeburn 5953: width: 98%;
1.349 albertel 5954: }
1.795 www 5955:
1.349 albertel 5956: table.LC_calendar_pickdate {
5957: font-size: xx-small;
5958: }
1.795 www 5959:
1.349 albertel 5960: table.LC_calendar tr td {
5961: border: 1px solid #000000;
5962: vertical-align: top;
1.917 raeburn 5963: width: 14%;
1.349 albertel 5964: }
1.795 www 5965:
1.349 albertel 5966: table.LC_calendar tr td.LC_calendar_day_empty {
5967: background-color: $data_table_dark;
5968: }
1.795 www 5969:
1.779 bisitz 5970: table.LC_calendar tr td.LC_calendar_day_current {
5971: background-color: $data_table_highlight;
1.777 tempelho 5972: }
1.795 www 5973:
1.938 bisitz 5974: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5975: background-color: $mail_new;
5976: }
1.795 www 5977:
1.938 bisitz 5978: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5979: background-color: $mail_new_hover;
5980: }
1.795 www 5981:
1.938 bisitz 5982: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5983: background-color: $mail_read;
5984: }
1.795 www 5985:
1.938 bisitz 5986: /*
5987: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5988: background-color: $mail_read_hover;
5989: }
1.938 bisitz 5990: */
1.795 www 5991:
1.938 bisitz 5992: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5993: background-color: $mail_replied;
5994: }
1.795 www 5995:
1.938 bisitz 5996: /*
5997: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5998: background-color: $mail_replied_hover;
5999: }
1.938 bisitz 6000: */
1.795 www 6001:
1.938 bisitz 6002: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6003: background-color: $mail_other;
6004: }
1.795 www 6005:
1.938 bisitz 6006: /*
6007: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6008: background-color: $mail_other_hover;
6009: }
1.938 bisitz 6010: */
1.494 raeburn 6011:
1.777 tempelho 6012: table.LC_data_table tr > td.LC_browser_file,
6013: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6014: background: #AAEE77;
1.389 albertel 6015: }
1.795 www 6016:
1.777 tempelho 6017: table.LC_data_table tr > td.LC_browser_file_locked,
6018: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6019: background: #FFAA99;
1.387 albertel 6020: }
1.795 www 6021:
1.777 tempelho 6022: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6023: background: #888888;
1.779 bisitz 6024: }
1.795 www 6025:
1.777 tempelho 6026: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6027: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6028: background: #F8F866;
1.777 tempelho 6029: }
1.795 www 6030:
1.696 bisitz 6031: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6032: background: #E0E8FF;
1.387 albertel 6033: }
1.696 bisitz 6034:
1.707 bisitz 6035: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6036: /* background: #77FF77; */
1.707 bisitz 6037: }
1.795 www 6038:
1.707 bisitz 6039: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6040: border-right: 8px solid #FFFF77;
1.707 bisitz 6041: }
1.795 www 6042:
1.707 bisitz 6043: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6044: border-right: 8px solid #FFAA77;
1.707 bisitz 6045: }
1.795 www 6046:
1.707 bisitz 6047: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6048: border-right: 8px solid #FF7777;
1.707 bisitz 6049: }
1.795 www 6050:
1.707 bisitz 6051: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6052: border-right: 8px solid #AAFF77;
1.707 bisitz 6053: }
1.795 www 6054:
1.707 bisitz 6055: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6056: border-right: 8px solid #11CC55;
1.707 bisitz 6057: }
6058:
1.388 albertel 6059: span.LC_current_location {
1.701 harmsja 6060: font-size:larger;
1.388 albertel 6061: background: $pgbg;
6062: }
1.387 albertel 6063:
1.1029 www 6064: span.LC_current_nav_location {
6065: font-weight:bold;
6066: background: $sidebg;
6067: }
6068:
1.395 albertel 6069: span.LC_parm_menu_item {
6070: font-size: larger;
6071: }
1.795 www 6072:
1.395 albertel 6073: span.LC_parm_scope_all {
6074: color: red;
6075: }
1.795 www 6076:
1.395 albertel 6077: span.LC_parm_scope_folder {
6078: color: green;
6079: }
1.795 www 6080:
1.395 albertel 6081: span.LC_parm_scope_resource {
6082: color: orange;
6083: }
1.795 www 6084:
1.395 albertel 6085: span.LC_parm_part {
6086: color: blue;
6087: }
1.795 www 6088:
1.911 bisitz 6089: span.LC_parm_folder,
6090: span.LC_parm_symb {
1.395 albertel 6091: font-size: x-small;
6092: font-family: $mono;
6093: color: #AAAAAA;
6094: }
6095:
1.977 bisitz 6096: ul.LC_parm_parmlist li {
6097: display: inline-block;
6098: padding: 0.3em 0.8em;
6099: vertical-align: top;
6100: width: 150px;
6101: border-top:1px solid $lg_border_color;
6102: }
6103:
1.795 www 6104: td.LC_parm_overview_level_menu,
6105: td.LC_parm_overview_map_menu,
6106: td.LC_parm_overview_parm_selectors,
6107: td.LC_parm_overview_restrictions {
1.396 albertel 6108: border: 1px solid black;
6109: border-collapse: collapse;
6110: }
1.795 www 6111:
1.396 albertel 6112: table.LC_parm_overview_restrictions td {
6113: border-width: 1px 4px 1px 4px;
6114: border-style: solid;
6115: border-color: $pgbg;
6116: text-align: center;
6117: }
1.795 www 6118:
1.396 albertel 6119: table.LC_parm_overview_restrictions th {
6120: background: $tabbg;
6121: border-width: 1px 4px 1px 4px;
6122: border-style: solid;
6123: border-color: $pgbg;
6124: }
1.795 www 6125:
1.398 albertel 6126: table#LC_helpmenu {
1.803 bisitz 6127: border: none;
1.398 albertel 6128: height: 55px;
1.803 bisitz 6129: border-spacing: 0;
1.398 albertel 6130: }
6131:
6132: table#LC_helpmenu fieldset legend {
6133: font-size: larger;
6134: }
1.795 www 6135:
1.397 albertel 6136: table#LC_helpmenu_links {
6137: width: 100%;
6138: border: 1px solid black;
6139: background: $pgbg;
1.803 bisitz 6140: padding: 0;
1.397 albertel 6141: border-spacing: 1px;
6142: }
1.795 www 6143:
1.397 albertel 6144: table#LC_helpmenu_links tr td {
6145: padding: 1px;
6146: background: $tabbg;
1.399 albertel 6147: text-align: center;
6148: font-weight: bold;
1.397 albertel 6149: }
1.396 albertel 6150:
1.795 www 6151: table#LC_helpmenu_links a:link,
6152: table#LC_helpmenu_links a:visited,
1.397 albertel 6153: table#LC_helpmenu_links a:active {
6154: text-decoration: none;
6155: color: $font;
6156: }
1.795 www 6157:
1.397 albertel 6158: table#LC_helpmenu_links a:hover {
6159: text-decoration: underline;
6160: color: $vlink;
6161: }
1.396 albertel 6162:
1.417 albertel 6163: .LC_chrt_popup_exists {
6164: border: 1px solid #339933;
6165: margin: -1px;
6166: }
1.795 www 6167:
1.417 albertel 6168: .LC_chrt_popup_up {
6169: border: 1px solid yellow;
6170: margin: -1px;
6171: }
1.795 www 6172:
1.417 albertel 6173: .LC_chrt_popup {
6174: border: 1px solid #8888FF;
6175: background: #CCCCFF;
6176: }
1.795 www 6177:
1.421 albertel 6178: table.LC_pick_box {
6179: border-collapse: separate;
6180: background: white;
6181: border: 1px solid black;
6182: border-spacing: 1px;
6183: }
1.795 www 6184:
1.421 albertel 6185: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6186: background: $sidebg;
1.421 albertel 6187: font-weight: bold;
1.900 bisitz 6188: text-align: left;
1.740 bisitz 6189: vertical-align: top;
1.421 albertel 6190: width: 184px;
6191: padding: 8px;
6192: }
1.795 www 6193:
1.579 raeburn 6194: table.LC_pick_box td.LC_pick_box_value {
6195: text-align: left;
6196: padding: 8px;
6197: }
1.795 www 6198:
1.579 raeburn 6199: table.LC_pick_box td.LC_pick_box_select {
6200: text-align: left;
6201: padding: 8px;
6202: }
1.795 www 6203:
1.424 albertel 6204: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6205: padding: 0;
1.421 albertel 6206: height: 1px;
6207: background: black;
6208: }
1.795 www 6209:
1.421 albertel 6210: table.LC_pick_box td.LC_pick_box_submit {
6211: text-align: right;
6212: }
1.795 www 6213:
1.579 raeburn 6214: table.LC_pick_box td.LC_evenrow_value {
6215: text-align: left;
6216: padding: 8px;
6217: background-color: $data_table_light;
6218: }
1.795 www 6219:
1.579 raeburn 6220: table.LC_pick_box td.LC_oddrow_value {
6221: text-align: left;
6222: padding: 8px;
6223: background-color: $data_table_light;
6224: }
1.795 www 6225:
1.579 raeburn 6226: span.LC_helpform_receipt_cat {
6227: font-weight: bold;
6228: }
1.795 www 6229:
1.424 albertel 6230: table.LC_group_priv_box {
6231: background: white;
6232: border: 1px solid black;
6233: border-spacing: 1px;
6234: }
1.795 www 6235:
1.424 albertel 6236: table.LC_group_priv_box td.LC_pick_box_title {
6237: background: $tabbg;
6238: font-weight: bold;
6239: text-align: right;
6240: width: 184px;
6241: }
1.795 www 6242:
1.424 albertel 6243: table.LC_group_priv_box td.LC_groups_fixed {
6244: background: $data_table_light;
6245: text-align: center;
6246: }
1.795 www 6247:
1.424 albertel 6248: table.LC_group_priv_box td.LC_groups_optional {
6249: background: $data_table_dark;
6250: text-align: center;
6251: }
1.795 www 6252:
1.424 albertel 6253: table.LC_group_priv_box td.LC_groups_functionality {
6254: background: $data_table_darker;
6255: text-align: center;
6256: font-weight: bold;
6257: }
1.795 www 6258:
1.424 albertel 6259: table.LC_group_priv td {
6260: text-align: left;
1.803 bisitz 6261: padding: 0;
1.424 albertel 6262: }
6263:
6264: .LC_navbuttons {
6265: margin: 2ex 0ex 2ex 0ex;
6266: }
1.795 www 6267:
1.423 albertel 6268: .LC_topic_bar {
6269: font-weight: bold;
6270: background: $tabbg;
1.918 wenzelju 6271: margin: 1em 0em 1em 2em;
1.805 bisitz 6272: padding: 3px;
1.918 wenzelju 6273: font-size: 1.2em;
1.423 albertel 6274: }
1.795 www 6275:
1.423 albertel 6276: .LC_topic_bar span {
1.918 wenzelju 6277: left: 0.5em;
6278: position: absolute;
1.423 albertel 6279: vertical-align: middle;
1.918 wenzelju 6280: font-size: 1.2em;
1.423 albertel 6281: }
1.795 www 6282:
1.423 albertel 6283: table.LC_course_group_status {
6284: margin: 20px;
6285: }
1.795 www 6286:
1.423 albertel 6287: table.LC_status_selector td {
6288: vertical-align: top;
6289: text-align: center;
1.424 albertel 6290: padding: 4px;
6291: }
1.795 www 6292:
1.599 albertel 6293: div.LC_feedback_link {
1.616 albertel 6294: clear: both;
1.829 kalberla 6295: background: $sidebg;
1.779 bisitz 6296: width: 100%;
1.829 kalberla 6297: padding-bottom: 10px;
6298: border: 1px $tabbg solid;
1.833 kalberla 6299: height: 22px;
6300: line-height: 22px;
6301: padding-top: 5px;
6302: }
6303:
6304: div.LC_feedback_link img {
6305: height: 22px;
1.867 kalberla 6306: vertical-align:middle;
1.829 kalberla 6307: }
6308:
1.911 bisitz 6309: div.LC_feedback_link a {
1.829 kalberla 6310: text-decoration: none;
1.489 raeburn 6311: }
1.795 www 6312:
1.867 kalberla 6313: div.LC_comblock {
1.911 bisitz 6314: display:inline;
1.867 kalberla 6315: color:$font;
6316: font-size:90%;
6317: }
6318:
6319: div.LC_feedback_link div.LC_comblock {
6320: padding-left:5px;
6321: }
6322:
6323: div.LC_feedback_link div.LC_comblock a {
6324: color:$font;
6325: }
6326:
1.489 raeburn 6327: span.LC_feedback_link {
1.858 bisitz 6328: /* background: $feedback_link_bg; */
1.599 albertel 6329: font-size: larger;
6330: }
1.795 www 6331:
1.599 albertel 6332: span.LC_message_link {
1.858 bisitz 6333: /* background: $feedback_link_bg; */
1.599 albertel 6334: font-size: larger;
6335: position: absolute;
6336: right: 1em;
1.489 raeburn 6337: }
1.421 albertel 6338:
1.515 albertel 6339: table.LC_prior_tries {
1.524 albertel 6340: border: 1px solid #000000;
6341: border-collapse: separate;
6342: border-spacing: 1px;
1.515 albertel 6343: }
1.523 albertel 6344:
1.515 albertel 6345: table.LC_prior_tries td {
1.524 albertel 6346: padding: 2px;
1.515 albertel 6347: }
1.523 albertel 6348:
6349: .LC_answer_correct {
1.795 www 6350: background: lightgreen;
6351: color: darkgreen;
6352: padding: 6px;
1.523 albertel 6353: }
1.795 www 6354:
1.523 albertel 6355: .LC_answer_charged_try {
1.797 www 6356: background: #FFAAAA;
1.795 www 6357: color: darkred;
6358: padding: 6px;
1.523 albertel 6359: }
1.795 www 6360:
1.779 bisitz 6361: .LC_answer_not_charged_try,
1.523 albertel 6362: .LC_answer_no_grade,
6363: .LC_answer_late {
1.795 www 6364: background: lightyellow;
1.523 albertel 6365: color: black;
1.795 www 6366: padding: 6px;
1.523 albertel 6367: }
1.795 www 6368:
1.523 albertel 6369: .LC_answer_previous {
1.795 www 6370: background: lightblue;
6371: color: darkblue;
6372: padding: 6px;
1.523 albertel 6373: }
1.795 www 6374:
1.779 bisitz 6375: .LC_answer_no_message {
1.777 tempelho 6376: background: #FFFFFF;
6377: color: black;
1.795 www 6378: padding: 6px;
1.779 bisitz 6379: }
1.795 www 6380:
1.779 bisitz 6381: .LC_answer_unknown {
6382: background: orange;
6383: color: black;
1.795 www 6384: padding: 6px;
1.777 tempelho 6385: }
1.795 www 6386:
1.529 albertel 6387: span.LC_prior_numerical,
6388: span.LC_prior_string,
6389: span.LC_prior_custom,
6390: span.LC_prior_reaction,
6391: span.LC_prior_math {
1.925 bisitz 6392: font-family: $mono;
1.523 albertel 6393: white-space: pre;
6394: }
6395:
1.525 albertel 6396: span.LC_prior_string {
1.925 bisitz 6397: font-family: $mono;
1.525 albertel 6398: white-space: pre;
6399: }
6400:
1.523 albertel 6401: table.LC_prior_option {
6402: width: 100%;
6403: border-collapse: collapse;
6404: }
1.795 www 6405:
1.911 bisitz 6406: table.LC_prior_rank,
1.795 www 6407: table.LC_prior_match {
1.528 albertel 6408: border-collapse: collapse;
6409: }
1.795 www 6410:
1.528 albertel 6411: table.LC_prior_option tr td,
6412: table.LC_prior_rank tr td,
6413: table.LC_prior_match tr td {
1.524 albertel 6414: border: 1px solid #000000;
1.515 albertel 6415: }
6416:
1.855 bisitz 6417: .LC_nobreak {
1.544 albertel 6418: white-space: nowrap;
1.519 raeburn 6419: }
6420:
1.576 raeburn 6421: span.LC_cusr_emph {
6422: font-style: italic;
6423: }
6424:
1.633 raeburn 6425: span.LC_cusr_subheading {
6426: font-weight: normal;
6427: font-size: 85%;
6428: }
6429:
1.861 bisitz 6430: div.LC_docs_entry_move {
1.859 bisitz 6431: border: 1px solid #BBBBBB;
1.545 albertel 6432: background: #DDDDDD;
1.861 bisitz 6433: width: 22px;
1.859 bisitz 6434: padding: 1px;
6435: margin: 0;
1.545 albertel 6436: }
6437:
1.861 bisitz 6438: table.LC_data_table tr > td.LC_docs_entry_commands,
6439: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6440: font-size: x-small;
6441: }
1.795 www 6442:
1.861 bisitz 6443: .LC_docs_entry_parameter {
6444: white-space: nowrap;
6445: }
6446:
1.544 albertel 6447: .LC_docs_copy {
1.545 albertel 6448: color: #000099;
1.544 albertel 6449: }
1.795 www 6450:
1.544 albertel 6451: .LC_docs_cut {
1.545 albertel 6452: color: #550044;
1.544 albertel 6453: }
1.795 www 6454:
1.544 albertel 6455: .LC_docs_rename {
1.545 albertel 6456: color: #009900;
1.544 albertel 6457: }
1.795 www 6458:
1.544 albertel 6459: .LC_docs_remove {
1.545 albertel 6460: color: #990000;
6461: }
6462:
1.547 albertel 6463: .LC_docs_reinit_warn,
6464: .LC_docs_ext_edit {
6465: font-size: x-small;
6466: }
6467:
1.545 albertel 6468: table.LC_docs_adddocs td,
6469: table.LC_docs_adddocs th {
6470: border: 1px solid #BBBBBB;
6471: padding: 4px;
6472: background: #DDDDDD;
1.543 albertel 6473: }
6474:
1.584 albertel 6475: table.LC_sty_begin {
6476: background: #BBFFBB;
6477: }
1.795 www 6478:
1.584 albertel 6479: table.LC_sty_end {
6480: background: #FFBBBB;
6481: }
6482:
1.589 raeburn 6483: table.LC_double_column {
1.803 bisitz 6484: border-width: 0;
1.589 raeburn 6485: border-collapse: collapse;
6486: width: 100%;
6487: padding: 2px;
6488: }
6489:
6490: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6491: top: 2px;
1.589 raeburn 6492: left: 2px;
6493: width: 47%;
6494: vertical-align: top;
6495: }
6496:
6497: table.LC_double_column tr td.LC_right_col {
6498: top: 2px;
1.779 bisitz 6499: right: 2px;
1.589 raeburn 6500: width: 47%;
6501: vertical-align: top;
6502: }
6503:
1.591 raeburn 6504: div.LC_left_float {
6505: float: left;
6506: padding-right: 5%;
1.597 albertel 6507: padding-bottom: 4px;
1.591 raeburn 6508: }
6509:
6510: div.LC_clear_float_header {
1.597 albertel 6511: padding-bottom: 2px;
1.591 raeburn 6512: }
6513:
6514: div.LC_clear_float_footer {
1.597 albertel 6515: padding-top: 10px;
1.591 raeburn 6516: clear: both;
6517: }
6518:
1.597 albertel 6519: div.LC_grade_show_user {
1.941 bisitz 6520: /* border-left: 5px solid $sidebg; */
6521: border-top: 5px solid #000000;
6522: margin: 50px 0 0 0;
1.936 bisitz 6523: padding: 15px 0 5px 10px;
1.597 albertel 6524: }
1.795 www 6525:
1.936 bisitz 6526: div.LC_grade_show_user_odd_row {
1.941 bisitz 6527: /* border-left: 5px solid #000000; */
6528: }
6529:
6530: div.LC_grade_show_user div.LC_Box {
6531: margin-right: 50px;
1.597 albertel 6532: }
6533:
6534: div.LC_grade_submissions,
6535: div.LC_grade_message_center,
1.936 bisitz 6536: div.LC_grade_info_links {
1.597 albertel 6537: margin: 5px;
6538: width: 99%;
6539: background: #FFFFFF;
6540: }
1.795 www 6541:
1.597 albertel 6542: div.LC_grade_submissions_header,
1.936 bisitz 6543: div.LC_grade_message_center_header {
1.705 tempelho 6544: font-weight: bold;
6545: font-size: large;
1.597 albertel 6546: }
1.795 www 6547:
1.597 albertel 6548: div.LC_grade_submissions_body,
1.936 bisitz 6549: div.LC_grade_message_center_body {
1.597 albertel 6550: border: 1px solid black;
6551: width: 99%;
6552: background: #FFFFFF;
6553: }
1.795 www 6554:
1.613 albertel 6555: table.LC_scantron_action {
6556: width: 100%;
6557: }
1.795 www 6558:
1.613 albertel 6559: table.LC_scantron_action tr th {
1.698 harmsja 6560: font-weight:bold;
6561: font-style:normal;
1.613 albertel 6562: }
1.795 www 6563:
1.779 bisitz 6564: .LC_edit_problem_header,
1.614 albertel 6565: div.LC_edit_problem_footer {
1.705 tempelho 6566: font-weight: normal;
6567: font-size: medium;
1.602 albertel 6568: margin: 2px;
1.1060 bisitz 6569: background-color: $sidebg;
1.600 albertel 6570: }
1.795 www 6571:
1.600 albertel 6572: div.LC_edit_problem_header,
1.602 albertel 6573: div.LC_edit_problem_header div,
1.614 albertel 6574: div.LC_edit_problem_footer,
6575: div.LC_edit_problem_footer div,
1.602 albertel 6576: div.LC_edit_problem_editxml_header,
6577: div.LC_edit_problem_editxml_header div {
1.600 albertel 6578: margin-top: 5px;
6579: }
1.795 www 6580:
1.600 albertel 6581: div.LC_edit_problem_header_title {
1.705 tempelho 6582: font-weight: bold;
6583: font-size: larger;
1.602 albertel 6584: background: $tabbg;
6585: padding: 3px;
1.1060 bisitz 6586: margin: 0 0 5px 0;
1.602 albertel 6587: }
1.795 www 6588:
1.602 albertel 6589: table.LC_edit_problem_header_title {
6590: width: 100%;
1.600 albertel 6591: background: $tabbg;
1.602 albertel 6592: }
6593:
6594: div.LC_edit_problem_discards {
6595: float: left;
6596: padding-bottom: 5px;
6597: }
1.795 www 6598:
1.602 albertel 6599: div.LC_edit_problem_saves {
6600: float: right;
6601: padding-bottom: 5px;
1.600 albertel 6602: }
1.795 www 6603:
1.1075.2.34 raeburn 6604: .LC_edit_opt {
6605: padding-left: 1em;
6606: white-space: nowrap;
6607: }
6608:
1.1075.2.57 raeburn 6609: .LC_edit_problem_latexhelper{
6610: text-align: right;
6611: }
6612:
6613: #LC_edit_problem_colorful div{
6614: margin-left: 40px;
6615: }
6616:
1.911 bisitz 6617: img.stift {
1.803 bisitz 6618: border-width: 0;
6619: vertical-align: middle;
1.677 riegler 6620: }
1.680 riegler 6621:
1.923 bisitz 6622: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6623: vertical-align: top;
1.777 tempelho 6624: }
1.795 www 6625:
1.716 raeburn 6626: div.LC_createcourse {
1.911 bisitz 6627: margin: 10px 10px 10px 10px;
1.716 raeburn 6628: }
6629:
1.917 raeburn 6630: .LC_dccid {
1.1075.2.38 raeburn 6631: float: right;
1.917 raeburn 6632: margin: 0.2em 0 0 0;
6633: padding: 0;
6634: font-size: 90%;
6635: display:none;
6636: }
6637:
1.897 wenzelju 6638: ol.LC_primary_menu a:hover,
1.721 harmsja 6639: ol#LC_MenuBreadcrumbs a:hover,
6640: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6641: ul#LC_secondary_menu a:hover,
1.721 harmsja 6642: .LC_FormSectionClearButton input:hover
1.795 www 6643: ul.LC_TabContent li:hover a {
1.952 onken 6644: color:$button_hover;
1.911 bisitz 6645: text-decoration:none;
1.693 droeschl 6646: }
6647:
1.779 bisitz 6648: h1 {
1.911 bisitz 6649: padding: 0;
6650: line-height:130%;
1.693 droeschl 6651: }
1.698 harmsja 6652:
1.911 bisitz 6653: h2,
6654: h3,
6655: h4,
6656: h5,
6657: h6 {
6658: margin: 5px 0 5px 0;
6659: padding: 0;
6660: line-height:130%;
1.693 droeschl 6661: }
1.795 www 6662:
6663: .LC_hcell {
1.911 bisitz 6664: padding:3px 15px 3px 15px;
6665: margin: 0;
6666: background-color:$tabbg;
6667: color:$fontmenu;
6668: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6669: }
1.795 www 6670:
1.840 bisitz 6671: .LC_Box > .LC_hcell {
1.911 bisitz 6672: margin: 0 -10px 10px -10px;
1.835 bisitz 6673: }
6674:
1.721 harmsja 6675: .LC_noBorder {
1.911 bisitz 6676: border: 0;
1.698 harmsja 6677: }
1.693 droeschl 6678:
1.721 harmsja 6679: .LC_FormSectionClearButton input {
1.911 bisitz 6680: background-color:transparent;
6681: border: none;
6682: cursor:pointer;
6683: text-decoration:underline;
1.693 droeschl 6684: }
1.763 bisitz 6685:
6686: .LC_help_open_topic {
1.911 bisitz 6687: color: #FFFFFF;
6688: background-color: #EEEEFF;
6689: margin: 1px;
6690: padding: 4px;
6691: border: 1px solid #000033;
6692: white-space: nowrap;
6693: /* vertical-align: middle; */
1.759 neumanie 6694: }
1.693 droeschl 6695:
1.911 bisitz 6696: dl,
6697: ul,
6698: div,
6699: fieldset {
6700: margin: 10px 10px 10px 0;
6701: /* overflow: hidden; */
1.693 droeschl 6702: }
1.795 www 6703:
1.1075.2.90 raeburn 6704: article.geogebraweb div {
6705: margin: 0;
6706: }
6707:
1.838 bisitz 6708: fieldset > legend {
1.911 bisitz 6709: font-weight: bold;
6710: padding: 0 5px 0 5px;
1.838 bisitz 6711: }
6712:
1.813 bisitz 6713: #LC_nav_bar {
1.911 bisitz 6714: float: left;
1.995 raeburn 6715: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6716: margin: 0 0 2px 0;
1.807 droeschl 6717: }
6718:
1.916 droeschl 6719: #LC_realm {
6720: margin: 0.2em 0 0 0;
6721: padding: 0;
6722: font-weight: bold;
6723: text-align: center;
1.995 raeburn 6724: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6725: }
6726:
1.911 bisitz 6727: #LC_nav_bar em {
6728: font-weight: bold;
6729: font-style: normal;
1.807 droeschl 6730: }
6731:
1.897 wenzelju 6732: ol.LC_primary_menu {
1.934 droeschl 6733: margin: 0;
1.1075.2.2 raeburn 6734: padding: 0;
1.995 raeburn 6735: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6736: }
6737:
1.852 droeschl 6738: ol#LC_PathBreadcrumbs {
1.911 bisitz 6739: margin: 0;
1.693 droeschl 6740: }
6741:
1.897 wenzelju 6742: ol.LC_primary_menu li {
1.1075.2.2 raeburn 6743: color: RGB(80, 80, 80);
6744: vertical-align: middle;
6745: text-align: left;
6746: list-style: none;
6747: float: left;
6748: }
6749:
6750: ol.LC_primary_menu li a {
6751: display: block;
6752: margin: 0;
6753: padding: 0 5px 0 10px;
6754: text-decoration: none;
6755: }
6756:
6757: ol.LC_primary_menu li ul {
6758: display: none;
6759: width: 10em;
6760: background-color: $data_table_light;
6761: }
6762:
6763: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6764: display: block;
6765: position: absolute;
6766: margin: 0;
6767: padding: 0;
1.1075.2.5 raeburn 6768: z-index: 2;
1.1075.2.2 raeburn 6769: }
6770:
6771: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6772: font-size: 90%;
1.911 bisitz 6773: vertical-align: top;
1.1075.2.2 raeburn 6774: float: none;
1.1075.2.5 raeburn 6775: border-left: 1px solid black;
6776: border-right: 1px solid black;
1.1075.2.2 raeburn 6777: }
6778:
6779: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5 raeburn 6780: background-color:$data_table_light;
1.1075.2.2 raeburn 6781: }
6782:
6783: ol.LC_primary_menu li li a:hover {
6784: color:$button_hover;
6785: background-color:$data_table_dark;
1.693 droeschl 6786: }
6787:
1.897 wenzelju 6788: ol.LC_primary_menu li img {
1.911 bisitz 6789: vertical-align: bottom;
1.934 droeschl 6790: height: 1.1em;
1.1075.2.3 raeburn 6791: margin: 0.2em 0 0 0;
1.693 droeschl 6792: }
6793:
1.897 wenzelju 6794: ol.LC_primary_menu a {
1.911 bisitz 6795: color: RGB(80, 80, 80);
6796: text-decoration: none;
1.693 droeschl 6797: }
1.795 www 6798:
1.949 droeschl 6799: ol.LC_primary_menu a.LC_new_message {
6800: font-weight:bold;
6801: color: darkred;
6802: }
6803:
1.975 raeburn 6804: ol.LC_docs_parameters {
6805: margin-left: 0;
6806: padding: 0;
6807: list-style: none;
6808: }
6809:
6810: ol.LC_docs_parameters li {
6811: margin: 0;
6812: padding-right: 20px;
6813: display: inline;
6814: }
6815:
1.976 raeburn 6816: ol.LC_docs_parameters li:before {
6817: content: "\\002022 \\0020";
6818: }
6819:
6820: li.LC_docs_parameters_title {
6821: font-weight: bold;
6822: }
6823:
6824: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6825: content: "";
6826: }
6827:
1.897 wenzelju 6828: ul#LC_secondary_menu {
1.1075.2.23 raeburn 6829: clear: right;
1.911 bisitz 6830: color: $fontmenu;
6831: background: $tabbg;
6832: list-style: none;
6833: padding: 0;
6834: margin: 0;
6835: width: 100%;
1.995 raeburn 6836: text-align: left;
1.1075.2.4 raeburn 6837: float: left;
1.808 droeschl 6838: }
6839:
1.897 wenzelju 6840: ul#LC_secondary_menu li {
1.911 bisitz 6841: font-weight: bold;
6842: line-height: 1.8em;
6843: border-right: 1px solid black;
6844: vertical-align: middle;
1.1075.2.4 raeburn 6845: float: left;
6846: }
6847:
6848: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6849: background-color: $data_table_light;
6850: }
6851:
6852: ul#LC_secondary_menu li a {
6853: padding: 0 0.8em;
6854: }
6855:
6856: ul#LC_secondary_menu li ul {
6857: display: none;
6858: }
6859:
6860: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6861: display: block;
6862: position: absolute;
6863: margin: 0;
6864: padding: 0;
6865: list-style:none;
6866: float: none;
6867: background-color: $data_table_light;
1.1075.2.5 raeburn 6868: z-index: 2;
1.1075.2.10 raeburn 6869: margin-left: -1px;
1.1075.2.4 raeburn 6870: }
6871:
6872: ul#LC_secondary_menu li ul li {
6873: font-size: 90%;
6874: vertical-align: top;
6875: border-left: 1px solid black;
6876: border-right: 1px solid black;
1.1075.2.33 raeburn 6877: background-color: $data_table_light;
1.1075.2.4 raeburn 6878: list-style:none;
6879: float: none;
6880: }
6881:
6882: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6883: background-color: $data_table_dark;
1.807 droeschl 6884: }
6885:
1.847 tempelho 6886: ul.LC_TabContent {
1.911 bisitz 6887: display:block;
6888: background: $sidebg;
6889: border-bottom: solid 1px $lg_border_color;
6890: list-style:none;
1.1020 raeburn 6891: margin: -1px -10px 0 -10px;
1.911 bisitz 6892: padding: 0;
1.693 droeschl 6893: }
6894:
1.795 www 6895: ul.LC_TabContent li,
6896: ul.LC_TabContentBigger li {
1.911 bisitz 6897: float:left;
1.741 harmsja 6898: }
1.795 www 6899:
1.897 wenzelju 6900: ul#LC_secondary_menu li a {
1.911 bisitz 6901: color: $fontmenu;
6902: text-decoration: none;
1.693 droeschl 6903: }
1.795 www 6904:
1.721 harmsja 6905: ul.LC_TabContent {
1.952 onken 6906: min-height:20px;
1.721 harmsja 6907: }
1.795 www 6908:
6909: ul.LC_TabContent li {
1.911 bisitz 6910: vertical-align:middle;
1.959 onken 6911: padding: 0 16px 0 10px;
1.911 bisitz 6912: background-color:$tabbg;
6913: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6914: border-left: solid 1px $font;
1.721 harmsja 6915: }
1.795 www 6916:
1.847 tempelho 6917: ul.LC_TabContent .right {
1.911 bisitz 6918: float:right;
1.847 tempelho 6919: }
6920:
1.911 bisitz 6921: ul.LC_TabContent li a,
6922: ul.LC_TabContent li {
6923: color:rgb(47,47,47);
6924: text-decoration:none;
6925: font-size:95%;
6926: font-weight:bold;
1.952 onken 6927: min-height:20px;
6928: }
6929:
1.959 onken 6930: ul.LC_TabContent li a:hover,
6931: ul.LC_TabContent li a:focus {
1.952 onken 6932: color: $button_hover;
1.959 onken 6933: background:none;
6934: outline:none;
1.952 onken 6935: }
6936:
6937: ul.LC_TabContent li:hover {
6938: color: $button_hover;
6939: cursor:pointer;
1.721 harmsja 6940: }
1.795 www 6941:
1.911 bisitz 6942: ul.LC_TabContent li.active {
1.952 onken 6943: color: $font;
1.911 bisitz 6944: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6945: border-bottom:solid 1px #FFFFFF;
6946: cursor: default;
1.744 ehlerst 6947: }
1.795 www 6948:
1.959 onken 6949: ul.LC_TabContent li.active a {
6950: color:$font;
6951: background:#FFFFFF;
6952: outline: none;
6953: }
1.1047 raeburn 6954:
6955: ul.LC_TabContent li.goback {
6956: float: left;
6957: border-left: none;
6958: }
6959:
1.870 tempelho 6960: #maincoursedoc {
1.911 bisitz 6961: clear:both;
1.870 tempelho 6962: }
6963:
6964: ul.LC_TabContentBigger {
1.911 bisitz 6965: display:block;
6966: list-style:none;
6967: padding: 0;
1.870 tempelho 6968: }
6969:
1.795 www 6970: ul.LC_TabContentBigger li {
1.911 bisitz 6971: vertical-align:bottom;
6972: height: 30px;
6973: font-size:110%;
6974: font-weight:bold;
6975: color: #737373;
1.841 tempelho 6976: }
6977:
1.957 onken 6978: ul.LC_TabContentBigger li.active {
6979: position: relative;
6980: top: 1px;
6981: }
6982:
1.870 tempelho 6983: ul.LC_TabContentBigger li a {
1.911 bisitz 6984: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6985: height: 30px;
6986: line-height: 30px;
6987: text-align: center;
6988: display: block;
6989: text-decoration: none;
1.958 onken 6990: outline: none;
1.741 harmsja 6991: }
1.795 www 6992:
1.870 tempelho 6993: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6994: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6995: color:$font;
1.744 ehlerst 6996: }
1.795 www 6997:
1.870 tempelho 6998: ul.LC_TabContentBigger li b {
1.911 bisitz 6999: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7000: display: block;
7001: float: left;
7002: padding: 0 30px;
1.957 onken 7003: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7004: }
7005:
1.956 onken 7006: ul.LC_TabContentBigger li:hover b {
7007: color:$button_hover;
7008: }
7009:
1.870 tempelho 7010: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7011: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7012: color:$font;
1.957 onken 7013: border: 0;
1.741 harmsja 7014: }
1.693 droeschl 7015:
1.870 tempelho 7016:
1.862 bisitz 7017: ul.LC_CourseBreadcrumbs {
7018: background: $sidebg;
1.1020 raeburn 7019: height: 2em;
1.862 bisitz 7020: padding-left: 10px;
1.1020 raeburn 7021: margin: 0;
1.862 bisitz 7022: list-style-position: inside;
7023: }
7024:
1.911 bisitz 7025: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7026: ol#LC_PathBreadcrumbs {
1.911 bisitz 7027: padding-left: 10px;
7028: margin: 0;
1.933 droeschl 7029: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7030: }
7031:
1.911 bisitz 7032: ol#LC_MenuBreadcrumbs li,
7033: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7034: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7035: display: inline;
1.933 droeschl 7036: white-space: normal;
1.693 droeschl 7037: }
7038:
1.823 bisitz 7039: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7040: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7041: text-decoration: none;
7042: font-size:90%;
1.693 droeschl 7043: }
1.795 www 7044:
1.969 droeschl 7045: ol#LC_MenuBreadcrumbs h1 {
7046: display: inline;
7047: font-size: 90%;
7048: line-height: 2.5em;
7049: margin: 0;
7050: padding: 0;
7051: }
7052:
1.795 www 7053: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7054: text-decoration:none;
7055: font-size:100%;
7056: font-weight:bold;
1.693 droeschl 7057: }
1.795 www 7058:
1.840 bisitz 7059: .LC_Box {
1.911 bisitz 7060: border: solid 1px $lg_border_color;
7061: padding: 0 10px 10px 10px;
1.746 neumanie 7062: }
1.795 www 7063:
1.1020 raeburn 7064: .LC_DocsBox {
7065: border: solid 1px $lg_border_color;
7066: padding: 0 0 10px 10px;
7067: }
7068:
1.795 www 7069: .LC_AboutMe_Image {
1.911 bisitz 7070: float:left;
7071: margin-right:10px;
1.747 neumanie 7072: }
1.795 www 7073:
7074: .LC_Clear_AboutMe_Image {
1.911 bisitz 7075: clear:left;
1.747 neumanie 7076: }
1.795 www 7077:
1.721 harmsja 7078: dl.LC_ListStyleClean dt {
1.911 bisitz 7079: padding-right: 5px;
7080: display: table-header-group;
1.693 droeschl 7081: }
7082:
1.721 harmsja 7083: dl.LC_ListStyleClean dd {
1.911 bisitz 7084: display: table-row;
1.693 droeschl 7085: }
7086:
1.721 harmsja 7087: .LC_ListStyleClean,
7088: .LC_ListStyleSimple,
7089: .LC_ListStyleNormal,
1.795 www 7090: .LC_ListStyleSpecial {
1.911 bisitz 7091: /* display:block; */
7092: list-style-position: inside;
7093: list-style-type: none;
7094: overflow: hidden;
7095: padding: 0;
1.693 droeschl 7096: }
7097:
1.721 harmsja 7098: .LC_ListStyleSimple li,
7099: .LC_ListStyleSimple dd,
7100: .LC_ListStyleNormal li,
7101: .LC_ListStyleNormal dd,
7102: .LC_ListStyleSpecial li,
1.795 www 7103: .LC_ListStyleSpecial dd {
1.911 bisitz 7104: margin: 0;
7105: padding: 5px 5px 5px 10px;
7106: clear: both;
1.693 droeschl 7107: }
7108:
1.721 harmsja 7109: .LC_ListStyleClean li,
7110: .LC_ListStyleClean dd {
1.911 bisitz 7111: padding-top: 0;
7112: padding-bottom: 0;
1.693 droeschl 7113: }
7114:
1.721 harmsja 7115: .LC_ListStyleSimple dd,
1.795 www 7116: .LC_ListStyleSimple li {
1.911 bisitz 7117: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7118: }
7119:
1.721 harmsja 7120: .LC_ListStyleSpecial li,
7121: .LC_ListStyleSpecial dd {
1.911 bisitz 7122: list-style-type: none;
7123: background-color: RGB(220, 220, 220);
7124: margin-bottom: 4px;
1.693 droeschl 7125: }
7126:
1.721 harmsja 7127: table.LC_SimpleTable {
1.911 bisitz 7128: margin:5px;
7129: border:solid 1px $lg_border_color;
1.795 www 7130: }
1.693 droeschl 7131:
1.721 harmsja 7132: table.LC_SimpleTable tr {
1.911 bisitz 7133: padding: 0;
7134: border:solid 1px $lg_border_color;
1.693 droeschl 7135: }
1.795 www 7136:
7137: table.LC_SimpleTable thead {
1.911 bisitz 7138: background:rgb(220,220,220);
1.693 droeschl 7139: }
7140:
1.721 harmsja 7141: div.LC_columnSection {
1.911 bisitz 7142: display: block;
7143: clear: both;
7144: overflow: hidden;
7145: margin: 0;
1.693 droeschl 7146: }
7147:
1.721 harmsja 7148: div.LC_columnSection>* {
1.911 bisitz 7149: float: left;
7150: margin: 10px 20px 10px 0;
7151: overflow:hidden;
1.693 droeschl 7152: }
1.721 harmsja 7153:
1.795 www 7154: table em {
1.911 bisitz 7155: font-weight: bold;
7156: font-style: normal;
1.748 schulted 7157: }
1.795 www 7158:
1.779 bisitz 7159: table.LC_tableBrowseRes,
1.795 www 7160: table.LC_tableOfContent {
1.911 bisitz 7161: border:none;
7162: border-spacing: 1px;
7163: padding: 3px;
7164: background-color: #FFFFFF;
7165: font-size: 90%;
1.753 droeschl 7166: }
1.789 droeschl 7167:
1.911 bisitz 7168: table.LC_tableOfContent {
7169: border-collapse: collapse;
1.789 droeschl 7170: }
7171:
1.771 droeschl 7172: table.LC_tableBrowseRes a,
1.768 schulted 7173: table.LC_tableOfContent a {
1.911 bisitz 7174: background-color: transparent;
7175: text-decoration: none;
1.753 droeschl 7176: }
7177:
1.795 www 7178: table.LC_tableOfContent img {
1.911 bisitz 7179: border: none;
7180: height: 1.3em;
7181: vertical-align: text-bottom;
7182: margin-right: 0.3em;
1.753 droeschl 7183: }
1.757 schulted 7184:
1.795 www 7185: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7186: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7187: }
7188:
1.795 www 7189: a#LC_content_toolbar_everything {
1.911 bisitz 7190: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7191: }
7192:
1.795 www 7193: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7194: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7195: }
7196:
1.795 www 7197: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7198: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7199: }
7200:
1.795 www 7201: a#LC_content_toolbar_changefolder {
1.911 bisitz 7202: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7203: }
7204:
1.795 www 7205: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7206: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7207: }
7208:
1.1043 raeburn 7209: a#LC_content_toolbar_edittoplevel {
7210: background-image:url(/res/adm/pages/edittoplevel.gif);
7211: }
7212:
1.795 www 7213: ul#LC_toolbar li a:hover {
1.911 bisitz 7214: background-position: bottom center;
1.757 schulted 7215: }
7216:
1.795 www 7217: ul#LC_toolbar {
1.911 bisitz 7218: padding: 0;
7219: margin: 2px;
7220: list-style:none;
7221: position:relative;
7222: background-color:white;
1.1075.2.9 raeburn 7223: overflow: auto;
1.757 schulted 7224: }
7225:
1.795 www 7226: ul#LC_toolbar li {
1.911 bisitz 7227: border:1px solid white;
7228: padding: 0;
7229: margin: 0;
7230: float: left;
7231: display:inline;
7232: vertical-align:middle;
1.1075.2.9 raeburn 7233: white-space: nowrap;
1.911 bisitz 7234: }
1.757 schulted 7235:
1.783 amueller 7236:
1.795 www 7237: a.LC_toolbarItem {
1.911 bisitz 7238: display:block;
7239: padding: 0;
7240: margin: 0;
7241: height: 32px;
7242: width: 32px;
7243: color:white;
7244: border: none;
7245: background-repeat:no-repeat;
7246: background-color:transparent;
1.757 schulted 7247: }
7248:
1.915 droeschl 7249: ul.LC_funclist {
7250: margin: 0;
7251: padding: 0.5em 1em 0.5em 0;
7252: }
7253:
1.933 droeschl 7254: ul.LC_funclist > li:first-child {
7255: font-weight:bold;
7256: margin-left:0.8em;
7257: }
7258:
1.915 droeschl 7259: ul.LC_funclist + ul.LC_funclist {
7260: /*
7261: left border as a seperator if we have more than
7262: one list
7263: */
7264: border-left: 1px solid $sidebg;
7265: /*
7266: this hides the left border behind the border of the
7267: outer box if element is wrapped to the next 'line'
7268: */
7269: margin-left: -1px;
7270: }
7271:
1.843 bisitz 7272: ul.LC_funclist li {
1.915 droeschl 7273: display: inline;
1.782 bisitz 7274: white-space: nowrap;
1.915 droeschl 7275: margin: 0 0 0 25px;
7276: line-height: 150%;
1.782 bisitz 7277: }
7278:
1.974 wenzelju 7279: .LC_hidden {
7280: display: none;
7281: }
7282:
1.1030 www 7283: .LCmodal-overlay {
7284: position:fixed;
7285: top:0;
7286: right:0;
7287: bottom:0;
7288: left:0;
7289: height:100%;
7290: width:100%;
7291: margin:0;
7292: padding:0;
7293: background:#999;
7294: opacity:.75;
7295: filter: alpha(opacity=75);
7296: -moz-opacity: 0.75;
7297: z-index:101;
7298: }
7299:
7300: * html .LCmodal-overlay {
7301: position: absolute;
7302: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7303: }
7304:
7305: .LCmodal-window {
7306: position:fixed;
7307: top:50%;
7308: left:50%;
7309: margin:0;
7310: padding:0;
7311: z-index:102;
7312: }
7313:
7314: * html .LCmodal-window {
7315: position:absolute;
7316: }
7317:
7318: .LCclose-window {
7319: position:absolute;
7320: width:32px;
7321: height:32px;
7322: right:8px;
7323: top:8px;
7324: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7325: text-indent:-99999px;
7326: overflow:hidden;
7327: cursor:pointer;
7328: }
7329:
1.1075.2.17 raeburn 7330: /*
7331: styles used by TTH when "Default set of options to pass to tth/m
7332: when converting TeX" in course settings has been set
7333:
7334: option passed: -t
7335:
7336: */
7337:
7338: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7339: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7340: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7341: td div.norm {line-height:normal;}
7342:
7343: /*
7344: option passed -y3
7345: */
7346:
7347: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7348: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7349: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7350:
1.343 albertel 7351: END
7352: }
7353:
1.306 albertel 7354: =pod
7355:
7356: =item * &headtag()
7357:
7358: Returns a uniform footer for LON-CAPA web pages.
7359:
1.307 albertel 7360: Inputs: $title - optional title for the head
7361: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7362: $args - optional arguments
1.319 albertel 7363: force_register - if is true call registerurl so the remote is
7364: informed
1.415 albertel 7365: redirect -> array ref of
7366: 1- seconds before redirect occurs
7367: 2- url to redirect to
7368: 3- whether the side effect should occur
1.315 albertel 7369: (side effect of setting
7370: $env{'internal.head.redirect'} to the url
7371: redirected too)
1.352 albertel 7372: domain -> force to color decorate a page for a specific
7373: domain
7374: function -> force usage of a specific rolish color scheme
7375: bgcolor -> override the default page bgcolor
1.460 albertel 7376: no_auto_mt_title
7377: -> prevent &mt()ing the title arg
1.464 albertel 7378:
1.306 albertel 7379: =cut
7380:
7381: sub headtag {
1.313 albertel 7382: my ($title,$head_extra,$args) = @_;
1.306 albertel 7383:
1.363 albertel 7384: my $function = $args->{'function'} || &get_users_function();
7385: my $domain = $args->{'domain'} || &determinedomain();
7386: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 7387: my $httphost = $args->{'use_absolute'};
1.418 albertel 7388: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7389: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7390: #time(),
1.418 albertel 7391: $env{'environment.color.timestamp'},
1.363 albertel 7392: $function,$domain,$bgcolor);
7393:
1.369 www 7394: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7395:
1.308 albertel 7396: my $result =
7397: '<head>'.
1.1075.2.56 raeburn 7398: &font_settings($args);
1.319 albertel 7399:
1.1075.2.72 raeburn 7400: my $inhibitprint;
7401: if ($args->{'print_suppress'}) {
7402: $inhibitprint = &print_suppression();
7403: }
1.1064 raeburn 7404:
1.461 albertel 7405: if (!$args->{'frameset'}) {
7406: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7407: }
1.1075.2.12 raeburn 7408: if ($args->{'force_register'}) {
7409: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 7410: }
1.436 albertel 7411: if (!$args->{'no_nav_bar'}
7412: && !$args->{'only_body'}
7413: && !$args->{'frameset'}) {
1.1075.2.52 raeburn 7414: $result .= &help_menu_js($httphost);
1.1032 www 7415: $result.=&modal_window();
1.1038 www 7416: $result.=&togglebox_script();
1.1034 www 7417: $result.=&wishlist_window();
1.1041 www 7418: $result.=&LCprogressbarUpdate_script();
1.1034 www 7419: } else {
7420: if ($args->{'add_modal'}) {
7421: $result.=&modal_window();
7422: }
7423: if ($args->{'add_wishlist'}) {
7424: $result.=&wishlist_window();
7425: }
1.1038 www 7426: if ($args->{'add_togglebox'}) {
7427: $result.=&togglebox_script();
7428: }
1.1041 www 7429: if ($args->{'add_progressbar'}) {
7430: $result.=&LCprogressbarUpdate_script();
7431: }
1.436 albertel 7432: }
1.314 albertel 7433: if (ref($args->{'redirect'})) {
1.414 albertel 7434: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7435: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7436: if (!$inhibit_continue) {
7437: $env{'internal.head.redirect'} = $url;
7438: }
1.313 albertel 7439: $result.=<<ADDMETA
7440: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7441: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7442: ADDMETA
1.1075.2.89 raeburn 7443: } else {
7444: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7445: my $requrl = $env{'request.uri'};
7446: if ($requrl eq '') {
7447: $requrl = $ENV{'REQUEST_URI'};
7448: $requrl =~ s/\?.+$//;
7449: }
7450: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7451: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7452: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7453: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7454: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7455: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7456: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7457: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7458: if ($domdefs{'offloadnow'}{$lonhost}) {
7459: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7460: if (($newserver) && ($newserver ne $lonhost)) {
7461: my $numsec = 5;
7462: my $timeout = $numsec * 1000;
7463: my ($newurl,$locknum,%locks,$msg);
7464: if ($env{'request.role.adv'}) {
7465: ($locknum,%locks) = &Apache::lonnet::get_locks();
7466: }
7467: my $disable_submit = 0;
7468: if ($requrl =~ /$LONCAPA::assess_re/) {
7469: $disable_submit = 1;
7470: }
7471: if ($locknum) {
7472: my @lockinfo = sort(values(%locks));
7473: $msg = &mt('Once the following tasks are complete: ')."\\n".
7474: join(", ",sort(values(%locks)))."\\n".
7475: &mt('your session will be transferred to a different server, after you click "Roles".');
7476: } else {
7477: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7478: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7479: }
7480: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7481: $newurl = '/adm/switchserver?otherserver='.$newserver;
7482: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7483: $newurl .= '&role='.$env{'request.role'};
7484: }
7485: if ($env{'request.symb'}) {
7486: $newurl .= '&symb='.$env{'request.symb'};
7487: } else {
7488: $newurl .= '&origurl='.$requrl;
7489: }
7490: }
1.1075.2.98 raeburn 7491: &js_escape(\$msg);
1.1075.2.89 raeburn 7492: $result.=<<OFFLOAD
7493: <meta http-equiv="pragma" content="no-cache" />
7494: <script type="text/javascript">
1.1075.2.92 raeburn 7495: // <![CDATA[
1.1075.2.89 raeburn 7496: function LC_Offload_Now() {
7497: var dest = "$newurl";
7498: if (dest != '') {
7499: window.location.href="$newurl";
7500: }
7501: }
1.1075.2.92 raeburn 7502: \$(document).ready(function () {
7503: window.alert('$msg');
7504: if ($disable_submit) {
1.1075.2.89 raeburn 7505: \$(".LC_hwk_submit").prop("disabled", true);
7506: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92 raeburn 7507: }
7508: setTimeout('LC_Offload_Now()', $timeout);
7509: });
7510: // ]]>
1.1075.2.89 raeburn 7511: </script>
7512: OFFLOAD
7513: }
7514: }
7515: }
7516: }
7517: }
7518: }
1.313 albertel 7519: }
1.306 albertel 7520: if (!defined($title)) {
7521: $title = 'The LearningOnline Network with CAPA';
7522: }
1.460 albertel 7523: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7524: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61 raeburn 7525: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7526: if (!$args->{'frameset'}) {
7527: $result .= ' /';
7528: }
7529: $result .= '>'
1.1064 raeburn 7530: .$inhibitprint
1.414 albertel 7531: .$head_extra;
1.1075.2.42 raeburn 7532: if ($env{'browser.mobile'}) {
7533: $result .= '
7534: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7535: <meta name="apple-mobile-web-app-capable" content="yes" />';
7536: }
1.962 droeschl 7537: return $result.'</head>';
1.306 albertel 7538: }
7539:
7540: =pod
7541:
1.340 albertel 7542: =item * &font_settings()
7543:
7544: Returns neccessary <meta> to set the proper encoding
7545:
1.1075.2.56 raeburn 7546: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7547:
7548: =cut
7549:
7550: sub font_settings {
1.1075.2.56 raeburn 7551: my ($args) = @_;
1.340 albertel 7552: my $headerstring='';
1.1075.2.56 raeburn 7553: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7554: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 7555: $headerstring.=
1.1075.2.61 raeburn 7556: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7557: if (!$args->{'frameset'}) {
7558: $headerstring.= ' /';
7559: }
7560: $headerstring .= '>'."\n";
1.340 albertel 7561: }
7562: return $headerstring;
7563: }
7564:
1.341 albertel 7565: =pod
7566:
1.1064 raeburn 7567: =item * &print_suppression()
7568:
7569: In course context returns css which causes the body to be blank when media="print",
7570: if printout generation is unavailable for the current resource.
7571:
7572: This could be because:
7573:
7574: (a) printstartdate is in the future
7575:
7576: (b) printenddate is in the past
7577:
7578: (c) there is an active exam block with "printout"
7579: functionality blocked
7580:
7581: Users with pav, pfo or evb privileges are exempt.
7582:
7583: Inputs: none
7584:
7585: =cut
7586:
7587:
7588: sub print_suppression {
7589: my $noprint;
7590: if ($env{'request.course.id'}) {
7591: my $scope = $env{'request.course.id'};
7592: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7593: (&Apache::lonnet::allowed('pfo',$scope))) {
7594: return;
7595: }
7596: if ($env{'request.course.sec'} ne '') {
7597: $scope .= "/$env{'request.course.sec'}";
7598: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7599: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7600: return;
1.1064 raeburn 7601: }
7602: }
7603: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7604: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73 raeburn 7605: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7606: if ($blocked) {
7607: my $checkrole = "cm./$cdom/$cnum";
7608: if ($env{'request.course.sec'} ne '') {
7609: $checkrole .= "/$env{'request.course.sec'}";
7610: }
7611: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7612: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7613: $noprint = 1;
7614: }
7615: }
7616: unless ($noprint) {
7617: my $symb = &Apache::lonnet::symbread();
7618: if ($symb ne '') {
7619: my $navmap = Apache::lonnavmaps::navmap->new();
7620: if (ref($navmap)) {
7621: my $res = $navmap->getBySymb($symb);
7622: if (ref($res)) {
7623: if (!$res->resprintable()) {
7624: $noprint = 1;
7625: }
7626: }
7627: }
7628: }
7629: }
7630: if ($noprint) {
7631: return <<"ENDSTYLE";
7632: <style type="text/css" media="print">
7633: body { display:none }
7634: </style>
7635: ENDSTYLE
7636: }
7637: }
7638: return;
7639: }
7640:
7641: =pod
7642:
1.341 albertel 7643: =item * &xml_begin()
7644:
7645: Returns the needed doctype and <html>
7646:
7647: Inputs: none
7648:
7649: =cut
7650:
7651: sub xml_begin {
1.1075.2.61 raeburn 7652: my ($is_frameset) = @_;
1.341 albertel 7653: my $output='';
7654:
7655: if ($env{'browser.mathml'}) {
7656: $output='<?xml version="1.0"?>'
7657: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7658: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7659:
7660: # .'<!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">] >'
7661: .'<!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">'
7662: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7663: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 7664: } elsif ($is_frameset) {
7665: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7666: '<html>'."\n";
1.341 albertel 7667: } else {
1.1075.2.61 raeburn 7668: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7669: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7670: }
7671: return $output;
7672: }
1.340 albertel 7673:
7674: =pod
7675:
1.306 albertel 7676: =item * &start_page()
7677:
7678: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7679:
1.648 raeburn 7680: Inputs:
7681:
7682: =over 4
7683:
7684: $title - optional title for the page
7685:
7686: $head_extra - optional extra HTML to incude inside the <head>
7687:
7688: $args - additional optional args supported are:
7689:
7690: =over 8
7691:
7692: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7693: arg on
1.814 bisitz 7694: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7695: add_entries -> additional attributes to add to the <body>
7696: domain -> force to color decorate a page for a
1.317 albertel 7697: specific domain
1.648 raeburn 7698: function -> force usage of a specific rolish color
1.317 albertel 7699: scheme
1.648 raeburn 7700: redirect -> see &headtag()
7701: bgcolor -> override the default page bg color
7702: js_ready -> return a string ready for being used in
1.317 albertel 7703: a javascript writeln
1.648 raeburn 7704: html_encode -> return a string ready for being used in
1.320 albertel 7705: a html attribute
1.648 raeburn 7706: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7707: $forcereg arg
1.648 raeburn 7708: frameset -> if true will start with a <frameset>
1.330 albertel 7709: rather than <body>
1.648 raeburn 7710: skip_phases -> hash ref of
1.338 albertel 7711: head -> skip the <html><head> generation
7712: body -> skip all <body> generation
1.1075.2.12 raeburn 7713: no_inline_link -> if true and in remote mode, don't show the
7714: 'Switch To Inline Menu' link
1.648 raeburn 7715: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 7716: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7717: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.15 raeburn 7718: group -> includes the current group, if page is for a
7719: specific group
1.361 albertel 7720:
1.648 raeburn 7721: =back
1.460 albertel 7722:
1.648 raeburn 7723: =back
1.562 albertel 7724:
1.306 albertel 7725: =cut
7726:
7727: sub start_page {
1.309 albertel 7728: my ($title,$head_extra,$args) = @_;
1.318 albertel 7729: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7730:
1.315 albertel 7731: $env{'internal.start_page'}++;
1.1075.2.15 raeburn 7732: my ($result,@advtools);
1.964 droeschl 7733:
1.338 albertel 7734: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 7735: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 7736: }
7737:
7738: if (! exists($args->{'skip_phases'}{'body'}) ) {
7739: if ($args->{'frameset'}) {
7740: my $attr_string = &make_attr_string($args->{'force_register'},
7741: $args->{'add_entries'});
7742: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7743: } else {
7744: $result .=
7745: &bodytag($title,
7746: $args->{'function'}, $args->{'add_entries'},
7747: $args->{'only_body'}, $args->{'domain'},
7748: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 7749: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.15 raeburn 7750: $args, \@advtools);
1.831 bisitz 7751: }
1.330 albertel 7752: }
1.338 albertel 7753:
1.315 albertel 7754: if ($args->{'js_ready'}) {
1.713 kaisler 7755: $result = &js_ready($result);
1.315 albertel 7756: }
1.320 albertel 7757: if ($args->{'html_encode'}) {
1.713 kaisler 7758: $result = &html_encode($result);
7759: }
7760:
1.813 bisitz 7761: # Preparation for new and consistent functionlist at top of screen
7762: # if ($args->{'functionlist'}) {
7763: # $result .= &build_functionlist();
7764: #}
7765:
1.964 droeschl 7766: # Don't add anything more if only_body wanted or in const space
7767: return $result if $args->{'only_body'}
7768: || $env{'request.state'} eq 'construct';
1.813 bisitz 7769:
7770: #Breadcrumbs
1.758 kaisler 7771: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7772: &Apache::lonhtmlcommon::clear_breadcrumbs();
7773: #if any br links exists, add them to the breadcrumbs
7774: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7775: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7776: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7777: }
7778: }
1.1075.2.19 raeburn 7779: # if @advtools array contains items add then to the breadcrumbs
7780: if (@advtools > 0) {
7781: &Apache::lonmenu::advtools_crumbs(@advtools);
7782: }
1.758 kaisler 7783:
7784: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7785: if(exists($args->{'bread_crumbs_component'})){
7786: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7787: }else{
7788: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7789: }
1.1075.2.24 raeburn 7790: } elsif (($env{'environment.remote'} eq 'on') &&
7791: ($env{'form.inhibitmenu'} ne 'yes') &&
7792: ($env{'request.noversionuri'} =~ m{^/res/}) &&
7793: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 7794: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 7795: }
1.315 albertel 7796: return $result;
1.306 albertel 7797: }
7798:
7799: sub end_page {
1.315 albertel 7800: my ($args) = @_;
7801: $env{'internal.end_page'}++;
1.330 albertel 7802: my $result;
1.335 albertel 7803: if ($args->{'discussion'}) {
7804: my ($target,$parser);
7805: if (ref($args->{'discussion'})) {
7806: ($target,$parser) =($args->{'discussion'}{'target'},
7807: $args->{'discussion'}{'parser'});
7808: }
7809: $result .= &Apache::lonxml::xmlend($target,$parser);
7810: }
1.330 albertel 7811: if ($args->{'frameset'}) {
7812: $result .= '</frameset>';
7813: } else {
1.635 raeburn 7814: $result .= &endbodytag($args);
1.330 albertel 7815: }
1.1075.2.6 raeburn 7816: unless ($args->{'notbody'}) {
7817: $result .= "\n</html>";
7818: }
1.330 albertel 7819:
1.315 albertel 7820: if ($args->{'js_ready'}) {
1.317 albertel 7821: $result = &js_ready($result);
1.315 albertel 7822: }
1.335 albertel 7823:
1.320 albertel 7824: if ($args->{'html_encode'}) {
7825: $result = &html_encode($result);
7826: }
1.335 albertel 7827:
1.315 albertel 7828: return $result;
7829: }
7830:
1.1034 www 7831: sub wishlist_window {
7832: return(<<'ENDWISHLIST');
1.1046 raeburn 7833: <script type="text/javascript">
1.1034 www 7834: // <![CDATA[
7835: // <!-- BEGIN LON-CAPA Internal
7836: function set_wishlistlink(title, path) {
7837: if (!title) {
7838: title = document.title;
7839: title = title.replace(/^LON-CAPA /,'');
7840: }
1.1075.2.65 raeburn 7841: title = encodeURIComponent(title);
1.1075.2.83 raeburn 7842: title = title.replace("'","\\\'");
1.1034 www 7843: if (!path) {
7844: path = location.pathname;
7845: }
1.1075.2.65 raeburn 7846: path = encodeURIComponent(path);
1.1075.2.83 raeburn 7847: path = path.replace("'","\\\'");
1.1034 www 7848: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7849: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7850: }
7851: // END LON-CAPA Internal -->
7852: // ]]>
7853: </script>
7854: ENDWISHLIST
7855: }
7856:
1.1030 www 7857: sub modal_window {
7858: return(<<'ENDMODAL');
1.1046 raeburn 7859: <script type="text/javascript">
1.1030 www 7860: // <![CDATA[
7861: // <!-- BEGIN LON-CAPA Internal
7862: var modalWindow = {
7863: parent:"body",
7864: windowId:null,
7865: content:null,
7866: width:null,
7867: height:null,
7868: close:function()
7869: {
7870: $(".LCmodal-window").remove();
7871: $(".LCmodal-overlay").remove();
7872: },
7873: open:function()
7874: {
7875: var modal = "";
7876: modal += "<div class=\"LCmodal-overlay\"></div>";
7877: 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;\">";
7878: modal += this.content;
7879: modal += "</div>";
7880:
7881: $(this.parent).append(modal);
7882:
7883: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7884: $(".LCclose-window").click(function(){modalWindow.close();});
7885: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7886: }
7887: };
1.1075.2.42 raeburn 7888: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7889: {
1.1075.2.83 raeburn 7890: source = source.replace("'","'");
1.1030 www 7891: modalWindow.windowId = "myModal";
7892: modalWindow.width = width;
7893: modalWindow.height = height;
1.1075.2.80 raeburn 7894: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7895: modalWindow.open();
1.1075.2.87 raeburn 7896: };
1.1030 www 7897: // END LON-CAPA Internal -->
7898: // ]]>
7899: </script>
7900: ENDMODAL
7901: }
7902:
7903: sub modal_link {
1.1075.2.42 raeburn 7904: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7905: unless ($width) { $width=480; }
7906: unless ($height) { $height=400; }
1.1031 www 7907: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 7908: unless ($transparency) { $transparency='true'; }
7909:
1.1074 raeburn 7910: my $target_attr;
7911: if (defined($target)) {
7912: $target_attr = 'target="'.$target.'"';
7913: }
7914: return <<"ENDLINK";
1.1075.2.42 raeburn 7915: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7916: $linktext</a>
7917: ENDLINK
1.1030 www 7918: }
7919:
1.1032 www 7920: sub modal_adhoc_script {
7921: my ($funcname,$width,$height,$content)=@_;
7922: return (<<ENDADHOC);
1.1046 raeburn 7923: <script type="text/javascript">
1.1032 www 7924: // <![CDATA[
7925: var $funcname = function()
7926: {
7927: modalWindow.windowId = "myModal";
7928: modalWindow.width = $width;
7929: modalWindow.height = $height;
7930: modalWindow.content = '$content';
7931: modalWindow.open();
7932: };
7933: // ]]>
7934: </script>
7935: ENDADHOC
7936: }
7937:
1.1041 www 7938: sub modal_adhoc_inner {
7939: my ($funcname,$width,$height,$content)=@_;
7940: my $innerwidth=$width-20;
7941: $content=&js_ready(
1.1042 www 7942: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 7943: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7944: $content.
1.1041 www 7945: &end_scrollbox().
1.1075.2.42 raeburn 7946: &end_page()
1.1041 www 7947: );
7948: return &modal_adhoc_script($funcname,$width,$height,$content);
7949: }
7950:
7951: sub modal_adhoc_window {
7952: my ($funcname,$width,$height,$content,$linktext)=@_;
7953: return &modal_adhoc_inner($funcname,$width,$height,$content).
7954: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7955: }
7956:
7957: sub modal_adhoc_launch {
7958: my ($funcname,$width,$height,$content)=@_;
7959: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7960: <script type="text/javascript">
7961: // <![CDATA[
7962: $funcname();
7963: // ]]>
7964: </script>
7965: ENDLAUNCH
7966: }
7967:
7968: sub modal_adhoc_close {
7969: return (<<ENDCLOSE);
7970: <script type="text/javascript">
7971: // <![CDATA[
7972: modalWindow.close();
7973: // ]]>
7974: </script>
7975: ENDCLOSE
7976: }
7977:
1.1038 www 7978: sub togglebox_script {
7979: return(<<ENDTOGGLE);
7980: <script type="text/javascript">
7981: // <![CDATA[
7982: function LCtoggleDisplay(id,hidetext,showtext) {
7983: link = document.getElementById(id + "link").childNodes[0];
7984: with (document.getElementById(id).style) {
7985: if (display == "none" ) {
7986: display = "inline";
7987: link.nodeValue = hidetext;
7988: } else {
7989: display = "none";
7990: link.nodeValue = showtext;
7991: }
7992: }
7993: }
7994: // ]]>
7995: </script>
7996: ENDTOGGLE
7997: }
7998:
1.1039 www 7999: sub start_togglebox {
8000: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8001: unless ($heading) { $heading=''; } else { $heading.=' '; }
8002: unless ($showtext) { $showtext=&mt('show'); }
8003: unless ($hidetext) { $hidetext=&mt('hide'); }
8004: unless ($headerbg) { $headerbg='#FFFFFF'; }
8005: return &start_data_table().
8006: &start_data_table_header_row().
8007: '<td bgcolor="'.$headerbg.'">'.$heading.
8008: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8009: $showtext.'\')">'.$showtext.'</a>]</td>'.
8010: &end_data_table_header_row().
8011: '<tr id="'.$id.'" style="display:none""><td>';
8012: }
8013:
8014: sub end_togglebox {
8015: return '</td></tr>'.&end_data_table();
8016: }
8017:
1.1041 www 8018: sub LCprogressbar_script {
1.1045 www 8019: my ($id)=@_;
1.1041 www 8020: return(<<ENDPROGRESS);
8021: <script type="text/javascript">
8022: // <![CDATA[
1.1045 www 8023: \$('#progressbar$id').progressbar({
1.1041 www 8024: value: 0,
8025: change: function(event, ui) {
8026: var newVal = \$(this).progressbar('option', 'value');
8027: \$('.pblabel', this).text(LCprogressTxt);
8028: }
8029: });
8030: // ]]>
8031: </script>
8032: ENDPROGRESS
8033: }
8034:
8035: sub LCprogressbarUpdate_script {
8036: return(<<ENDPROGRESSUPDATE);
8037: <style type="text/css">
8038: .ui-progressbar { position:relative; }
8039: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8040: </style>
8041: <script type="text/javascript">
8042: // <![CDATA[
1.1045 www 8043: var LCprogressTxt='---';
8044:
8045: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8046: LCprogressTxt=progresstext;
1.1045 www 8047: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8048: }
8049: // ]]>
8050: </script>
8051: ENDPROGRESSUPDATE
8052: }
8053:
1.1042 www 8054: my $LClastpercent;
1.1045 www 8055: my $LCidcnt;
8056: my $LCcurrentid;
1.1042 www 8057:
1.1041 www 8058: sub LCprogressbar {
1.1042 www 8059: my ($r)=(@_);
8060: $LClastpercent=0;
1.1045 www 8061: $LCidcnt++;
8062: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8063: my $starting=&mt('Starting');
8064: my $content=(<<ENDPROGBAR);
1.1045 www 8065: <div id="progressbar$LCcurrentid">
1.1041 www 8066: <span class="pblabel">$starting</span>
8067: </div>
8068: ENDPROGBAR
1.1045 www 8069: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8070: }
8071:
8072: sub LCprogressbarUpdate {
1.1042 www 8073: my ($r,$val,$text)=@_;
8074: unless ($val) {
8075: if ($LClastpercent) {
8076: $val=$LClastpercent;
8077: } else {
8078: $val=0;
8079: }
8080: }
1.1041 www 8081: if ($val<0) { $val=0; }
8082: if ($val>100) { $val=0; }
1.1042 www 8083: $LClastpercent=$val;
1.1041 www 8084: unless ($text) { $text=$val.'%'; }
8085: $text=&js_ready($text);
1.1044 www 8086: &r_print($r,<<ENDUPDATE);
1.1041 www 8087: <script type="text/javascript">
8088: // <![CDATA[
1.1045 www 8089: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8090: // ]]>
8091: </script>
8092: ENDUPDATE
1.1035 www 8093: }
8094:
1.1042 www 8095: sub LCprogressbarClose {
8096: my ($r)=@_;
8097: $LClastpercent=0;
1.1044 www 8098: &r_print($r,<<ENDCLOSE);
1.1042 www 8099: <script type="text/javascript">
8100: // <![CDATA[
1.1045 www 8101: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8102: // ]]>
8103: </script>
8104: ENDCLOSE
1.1044 www 8105: }
8106:
8107: sub r_print {
8108: my ($r,$to_print)=@_;
8109: if ($r) {
8110: $r->print($to_print);
8111: $r->rflush();
8112: } else {
8113: print($to_print);
8114: }
1.1042 www 8115: }
8116:
1.320 albertel 8117: sub html_encode {
8118: my ($result) = @_;
8119:
1.322 albertel 8120: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8121:
8122: return $result;
8123: }
1.1044 www 8124:
1.317 albertel 8125: sub js_ready {
8126: my ($result) = @_;
8127:
1.323 albertel 8128: $result =~ s/[\n\r]/ /xmsg;
8129: $result =~ s/\\/\\\\/xmsg;
8130: $result =~ s/'/\\'/xmsg;
1.372 albertel 8131: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8132:
8133: return $result;
8134: }
8135:
1.315 albertel 8136: sub validate_page {
8137: if ( exists($env{'internal.start_page'})
1.316 albertel 8138: && $env{'internal.start_page'} > 1) {
8139: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8140: $env{'internal.start_page'}.' '.
1.316 albertel 8141: $ENV{'request.filename'});
1.315 albertel 8142: }
8143: if ( exists($env{'internal.end_page'})
1.316 albertel 8144: && $env{'internal.end_page'} > 1) {
8145: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8146: $env{'internal.end_page'}.' '.
1.316 albertel 8147: $env{'request.filename'});
1.315 albertel 8148: }
8149: if ( exists($env{'internal.start_page'})
8150: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8151: &Apache::lonnet::logthis('start_page called without end_page '.
8152: $env{'request.filename'});
1.315 albertel 8153: }
8154: if ( ! exists($env{'internal.start_page'})
8155: && exists($env{'internal.end_page'})) {
1.316 albertel 8156: &Apache::lonnet::logthis('end_page called without start_page'.
8157: $env{'request.filename'});
1.315 albertel 8158: }
1.306 albertel 8159: }
1.315 albertel 8160:
1.996 www 8161:
8162: sub start_scrollbox {
1.1075.2.56 raeburn 8163: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8164: unless ($outerwidth) { $outerwidth='520px'; }
8165: unless ($width) { $width='500px'; }
8166: unless ($height) { $height='200px'; }
1.1075 raeburn 8167: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8168: if ($id ne '') {
1.1075.2.42 raeburn 8169: $table_id = ' id="table_'.$id.'"';
8170: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8171: }
1.1075 raeburn 8172: if ($bgcolor ne '') {
8173: $tdcol = "background-color: $bgcolor;";
8174: }
1.1075.2.42 raeburn 8175: my $nicescroll_js;
8176: if ($env{'browser.mobile'}) {
8177: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8178: }
1.1075 raeburn 8179: return <<"END";
1.1075.2.42 raeburn 8180: $nicescroll_js
8181:
8182: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 8183: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 8184: END
1.996 www 8185: }
8186:
8187: sub end_scrollbox {
1.1036 www 8188: return '</div></td></tr></table>';
1.996 www 8189: }
8190:
1.1075.2.42 raeburn 8191: sub nicescroll_javascript {
8192: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8193: my %options;
8194: if (ref($cursor) eq 'HASH') {
8195: %options = %{$cursor};
8196: }
8197: unless ($options{'railalign'} =~ /^left|right$/) {
8198: $options{'railalign'} = 'left';
8199: }
8200: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8201: my $function = &get_users_function();
8202: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
8203: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8204: $options{'cursorcolor'} = '#00F';
8205: }
8206: }
8207: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8208: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
8209: $options{'cursoropacity'}='1.0';
8210: }
8211: } else {
8212: $options{'cursoropacity'}='1.0';
8213: }
8214: if ($options{'cursorfixedheight'} eq 'none') {
8215: delete($options{'cursorfixedheight'});
8216: } else {
8217: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8218: }
8219: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8220: delete($options{'railoffset'});
8221: }
8222: my @niceoptions;
8223: while (my($key,$value) = each(%options)) {
8224: if ($value =~ /^\{.+\}$/) {
8225: push(@niceoptions,$key.':'.$value);
8226: } else {
8227: push(@niceoptions,$key.':"'.$value.'"');
8228: }
8229: }
8230: my $nicescroll_js = '
8231: $(document).ready(
8232: function() {
8233: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8234: }
8235: );
8236: ';
8237: if ($framecheck) {
8238: $nicescroll_js .= '
8239: function expand_div(caller) {
8240: if (top === self) {
8241: document.getElementById("'.$id.'").style.width = "auto";
8242: document.getElementById("'.$id.'").style.height = "auto";
8243: } else {
8244: try {
8245: if (parent.frames) {
8246: if (parent.frames.length > 1) {
8247: var framesrc = parent.frames[1].location.href;
8248: var currsrc = framesrc.replace(/\#.*$/,"");
8249: if ((caller == "search") || (currsrc == "'.$location.'")) {
8250: document.getElementById("'.$id.'").style.width = "auto";
8251: document.getElementById("'.$id.'").style.height = "auto";
8252: }
8253: }
8254: }
8255: } catch (e) {
8256: return;
8257: }
8258: }
8259: return;
8260: }
8261: ';
8262: }
8263: if ($needjsready) {
8264: $nicescroll_js = '
8265: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8266: } else {
8267: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8268: }
8269: return $nicescroll_js;
8270: }
8271:
1.318 albertel 8272: sub simple_error_page {
1.1075.2.49 raeburn 8273: my ($r,$title,$msg,$args) = @_;
8274: if (ref($args) eq 'HASH') {
8275: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8276: } else {
8277: $msg = &mt($msg);
8278: }
8279:
1.318 albertel 8280: my $page =
8281: &Apache::loncommon::start_page($title).
1.1075.2.49 raeburn 8282: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8283: &Apache::loncommon::end_page();
8284: if (ref($r)) {
8285: $r->print($page);
1.327 albertel 8286: return;
1.318 albertel 8287: }
8288: return $page;
8289: }
1.347 albertel 8290:
8291: {
1.610 albertel 8292: my @row_count;
1.961 onken 8293:
8294: sub start_data_table_count {
8295: unshift(@row_count, 0);
8296: return;
8297: }
8298:
8299: sub end_data_table_count {
8300: shift(@row_count);
8301: return;
8302: }
8303:
1.347 albertel 8304: sub start_data_table {
1.1018 raeburn 8305: my ($add_class,$id) = @_;
1.422 albertel 8306: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8307: my $table_id;
8308: if (defined($id)) {
8309: $table_id = ' id="'.$id.'"';
8310: }
1.961 onken 8311: &start_data_table_count();
1.1018 raeburn 8312: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8313: }
8314:
8315: sub end_data_table {
1.961 onken 8316: &end_data_table_count();
1.389 albertel 8317: return '</table>'."\n";;
1.347 albertel 8318: }
8319:
8320: sub start_data_table_row {
1.974 wenzelju 8321: my ($add_class, $id) = @_;
1.610 albertel 8322: $row_count[0]++;
8323: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8324: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8325: $id = (' id="'.$id.'"') unless ($id eq '');
8326: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8327: }
1.471 banghart 8328:
8329: sub continue_data_table_row {
1.974 wenzelju 8330: my ($add_class, $id) = @_;
1.610 albertel 8331: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8332: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8333: $id = (' id="'.$id.'"') unless ($id eq '');
8334: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8335: }
1.347 albertel 8336:
8337: sub end_data_table_row {
1.389 albertel 8338: return '</tr>'."\n";;
1.347 albertel 8339: }
1.367 www 8340:
1.421 albertel 8341: sub start_data_table_empty_row {
1.707 bisitz 8342: # $row_count[0]++;
1.421 albertel 8343: return '<tr class="LC_empty_row" >'."\n";;
8344: }
8345:
8346: sub end_data_table_empty_row {
8347: return '</tr>'."\n";;
8348: }
8349:
1.367 www 8350: sub start_data_table_header_row {
1.389 albertel 8351: return '<tr class="LC_header_row">'."\n";;
1.367 www 8352: }
8353:
8354: sub end_data_table_header_row {
1.389 albertel 8355: return '</tr>'."\n";;
1.367 www 8356: }
1.890 droeschl 8357:
8358: sub data_table_caption {
8359: my $caption = shift;
8360: return "<caption class=\"LC_caption\">$caption</caption>";
8361: }
1.347 albertel 8362: }
8363:
1.548 albertel 8364: =pod
8365:
8366: =item * &inhibit_menu_check($arg)
8367:
8368: Checks for a inhibitmenu state and generates output to preserve it
8369:
8370: Inputs: $arg - can be any of
8371: - undef - in which case the return value is a string
8372: to add into arguments list of a uri
8373: - 'input' - in which case the return value is a HTML
8374: <form> <input> field of type hidden to
8375: preserve the value
8376: - a url - in which case the return value is the url with
8377: the neccesary cgi args added to preserve the
8378: inhibitmenu state
8379: - a ref to a url - no return value, but the string is
8380: updated to include the neccessary cgi
8381: args to preserve the inhibitmenu state
8382:
8383: =cut
8384:
8385: sub inhibit_menu_check {
8386: my ($arg) = @_;
8387: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8388: if ($arg eq 'input') {
8389: if ($env{'form.inhibitmenu'}) {
8390: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8391: } else {
8392: return
8393: }
8394: }
8395: if ($env{'form.inhibitmenu'}) {
8396: if (ref($arg)) {
8397: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8398: } elsif ($arg eq '') {
8399: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8400: } else {
8401: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8402: }
8403: }
8404: if (!ref($arg)) {
8405: return $arg;
8406: }
8407: }
8408:
1.251 albertel 8409: ###############################################
1.182 matthew 8410:
8411: =pod
8412:
1.549 albertel 8413: =back
8414:
8415: =head1 User Information Routines
8416:
8417: =over 4
8418:
1.405 albertel 8419: =item * &get_users_function()
1.182 matthew 8420:
8421: Used by &bodytag to determine the current users primary role.
8422: Returns either 'student','coordinator','admin', or 'author'.
8423:
8424: =cut
8425:
8426: ###############################################
8427: sub get_users_function {
1.815 tempelho 8428: my $function = 'norole';
1.818 tempelho 8429: if ($env{'request.role'}=~/^(st)/) {
8430: $function='student';
8431: }
1.907 raeburn 8432: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8433: $function='coordinator';
8434: }
1.258 albertel 8435: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8436: $function='admin';
8437: }
1.826 bisitz 8438: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8439: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8440: $function='author';
8441: }
8442: return $function;
1.54 www 8443: }
1.99 www 8444:
8445: ###############################################
8446:
1.233 raeburn 8447: =pod
8448:
1.821 raeburn 8449: =item * &show_course()
8450:
8451: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8452: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8453:
8454: Inputs:
8455: None
8456:
8457: Outputs:
8458: Scalar: 1 if 'Course' to be used, 0 otherwise.
8459:
8460: =cut
8461:
8462: ###############################################
8463: sub show_course {
8464: my $course = !$env{'user.adv'};
8465: if (!$env{'user.adv'}) {
8466: foreach my $env (keys(%env)) {
8467: next if ($env !~ m/^user\.priv\./);
8468: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8469: $course = 0;
8470: last;
8471: }
8472: }
8473: }
8474: return $course;
8475: }
8476:
8477: ###############################################
8478:
8479: =pod
8480:
1.542 raeburn 8481: =item * &check_user_status()
1.274 raeburn 8482:
8483: Determines current status of supplied role for a
8484: specific user. Roles can be active, previous or future.
8485:
8486: Inputs:
8487: user's domain, user's username, course's domain,
1.375 raeburn 8488: course's number, optional section ID.
1.274 raeburn 8489:
8490: Outputs:
8491: role status: active, previous or future.
8492:
8493: =cut
8494:
8495: sub check_user_status {
1.412 raeburn 8496: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8497: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85 raeburn 8498: my @uroles = keys(%userinfo);
1.274 raeburn 8499: my $srchstr;
8500: my $active_chk = 'none';
1.412 raeburn 8501: my $now = time;
1.274 raeburn 8502: if (@uroles > 0) {
1.908 raeburn 8503: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8504: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8505: } else {
1.412 raeburn 8506: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8507: }
8508: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8509: my $role_end = 0;
8510: my $role_start = 0;
8511: $active_chk = 'active';
1.412 raeburn 8512: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8513: $role_end = $1;
8514: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8515: $role_start = $1;
1.274 raeburn 8516: }
8517: }
8518: if ($role_start > 0) {
1.412 raeburn 8519: if ($now < $role_start) {
1.274 raeburn 8520: $active_chk = 'future';
8521: }
8522: }
8523: if ($role_end > 0) {
1.412 raeburn 8524: if ($now > $role_end) {
1.274 raeburn 8525: $active_chk = 'previous';
8526: }
8527: }
8528: }
8529: }
8530: return $active_chk;
8531: }
8532:
8533: ###############################################
8534:
8535: =pod
8536:
1.405 albertel 8537: =item * &get_sections()
1.233 raeburn 8538:
8539: Determines all the sections for a course including
8540: sections with students and sections containing other roles.
1.419 raeburn 8541: Incoming parameters:
8542:
8543: 1. domain
8544: 2. course number
8545: 3. reference to array containing roles for which sections should
8546: be gathered (optional).
8547: 4. reference to array containing status types for which sections
8548: should be gathered (optional).
8549:
8550: If the third argument is undefined, sections are gathered for any role.
8551: If the fourth argument is undefined, sections are gathered for any status.
8552: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8553:
1.374 raeburn 8554: Returns section hash (keys are section IDs, values are
8555: number of users in each section), subject to the
1.419 raeburn 8556: optional roles filter, optional status filter
1.233 raeburn 8557:
8558: =cut
8559:
8560: ###############################################
8561: sub get_sections {
1.419 raeburn 8562: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8563: if (!defined($cdom) || !defined($cnum)) {
8564: my $cid = $env{'request.course.id'};
8565:
8566: return if (!defined($cid));
8567:
8568: $cdom = $env{'course.'.$cid.'.domain'};
8569: $cnum = $env{'course.'.$cid.'.num'};
8570: }
8571:
8572: my %sectioncount;
1.419 raeburn 8573: my $now = time;
1.240 albertel 8574:
1.1075.2.33 raeburn 8575: my $check_students = 1;
8576: my $only_students = 0;
8577: if (ref($possible_roles) eq 'ARRAY') {
8578: if (grep(/^st$/,@{$possible_roles})) {
8579: if (@{$possible_roles} == 1) {
8580: $only_students = 1;
8581: }
8582: } else {
8583: $check_students = 0;
8584: }
8585: }
8586:
8587: if ($check_students) {
1.276 albertel 8588: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8589: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8590: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8591: my $start_index = &Apache::loncoursedata::CL_START();
8592: my $end_index = &Apache::loncoursedata::CL_END();
8593: my $status;
1.366 albertel 8594: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8595: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8596: $data->[$status_index],
8597: $data->[$start_index],
8598: $data->[$end_index]);
8599: if ($stu_status eq 'Active') {
8600: $status = 'active';
8601: } elsif ($end < $now) {
8602: $status = 'previous';
8603: } elsif ($start > $now) {
8604: $status = 'future';
8605: }
8606: if ($section ne '-1' && $section !~ /^\s*$/) {
8607: if ((!defined($possible_status)) || (($status ne '') &&
8608: (grep/^\Q$status\E$/,@{$possible_status}))) {
8609: $sectioncount{$section}++;
8610: }
1.240 albertel 8611: }
8612: }
8613: }
1.1075.2.33 raeburn 8614: if ($only_students) {
8615: return %sectioncount;
8616: }
1.240 albertel 8617: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8618: foreach my $user (sort(keys(%courseroles))) {
8619: if ($user !~ /^(\w{2})/) { next; }
8620: my ($role) = ($user =~ /^(\w{2})/);
8621: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8622: my ($section,$status);
1.240 albertel 8623: if ($role eq 'cr' &&
8624: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8625: $section=$1;
8626: }
8627: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8628: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8629: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8630: if ($end == -1 && $start == -1) {
8631: next; #deleted role
8632: }
8633: if (!defined($possible_status)) {
8634: $sectioncount{$section}++;
8635: } else {
8636: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8637: $status = 'active';
8638: } elsif ($end < $now) {
8639: $status = 'future';
8640: } elsif ($start > $now) {
8641: $status = 'previous';
8642: }
8643: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8644: $sectioncount{$section}++;
8645: }
8646: }
1.233 raeburn 8647: }
1.366 albertel 8648: return %sectioncount;
1.233 raeburn 8649: }
8650:
1.274 raeburn 8651: ###############################################
1.294 raeburn 8652:
8653: =pod
1.405 albertel 8654:
8655: =item * &get_course_users()
8656:
1.275 raeburn 8657: Retrieves usernames:domains for users in the specified course
8658: with specific role(s), and access status.
8659:
8660: Incoming parameters:
1.277 albertel 8661: 1. course domain
8662: 2. course number
8663: 3. access status: users must have - either active,
1.275 raeburn 8664: previous, future, or all.
1.277 albertel 8665: 4. reference to array of permissible roles
1.288 raeburn 8666: 5. reference to array of section restrictions (optional)
8667: 6. reference to results object (hash of hashes).
8668: 7. reference to optional userdata hash
1.609 raeburn 8669: 8. reference to optional statushash
1.630 raeburn 8670: 9. flag if privileged users (except those set to unhide in
8671: course settings) should be excluded
1.609 raeburn 8672: Keys of top level results hash are roles.
1.275 raeburn 8673: Keys of inner hashes are username:domain, with
8674: values set to access type.
1.288 raeburn 8675: Optional userdata hash returns an array with arguments in the
8676: same order as loncoursedata::get_classlist() for student data.
8677:
1.609 raeburn 8678: Optional statushash returns
8679:
1.288 raeburn 8680: Entries for end, start, section and status are blank because
8681: of the possibility of multiple values for non-student roles.
8682:
1.275 raeburn 8683: =cut
1.405 albertel 8684:
1.275 raeburn 8685: ###############################################
1.405 albertel 8686:
1.275 raeburn 8687: sub get_course_users {
1.630 raeburn 8688: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8689: my %idx = ();
1.419 raeburn 8690: my %seclists;
1.288 raeburn 8691:
8692: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8693: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8694: $idx{end} = &Apache::loncoursedata::CL_END();
8695: $idx{start} = &Apache::loncoursedata::CL_START();
8696: $idx{id} = &Apache::loncoursedata::CL_ID();
8697: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8698: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8699: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8700:
1.290 albertel 8701: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8702: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8703: my $now = time;
1.277 albertel 8704: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8705: my $match = 0;
1.412 raeburn 8706: my $secmatch = 0;
1.419 raeburn 8707: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8708: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8709: if ($section eq '') {
8710: $section = 'none';
8711: }
1.291 albertel 8712: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8713: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8714: $secmatch = 1;
8715: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8716: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8717: $secmatch = 1;
8718: }
8719: } else {
1.419 raeburn 8720: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8721: $secmatch = 1;
8722: }
1.290 albertel 8723: }
1.412 raeburn 8724: if (!$secmatch) {
8725: next;
8726: }
1.419 raeburn 8727: }
1.275 raeburn 8728: if (defined($$types{'active'})) {
1.288 raeburn 8729: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8730: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8731: $match = 1;
1.275 raeburn 8732: }
8733: }
8734: if (defined($$types{'previous'})) {
1.609 raeburn 8735: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8736: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8737: $match = 1;
1.275 raeburn 8738: }
8739: }
8740: if (defined($$types{'future'})) {
1.609 raeburn 8741: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8742: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8743: $match = 1;
1.275 raeburn 8744: }
8745: }
1.609 raeburn 8746: if ($match) {
8747: push(@{$seclists{$student}},$section);
8748: if (ref($userdata) eq 'HASH') {
8749: $$userdata{$student} = $$classlist{$student};
8750: }
8751: if (ref($statushash) eq 'HASH') {
8752: $statushash->{$student}{'st'}{$section} = $status;
8753: }
1.288 raeburn 8754: }
1.275 raeburn 8755: }
8756: }
1.412 raeburn 8757: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8758: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8759: my $now = time;
1.609 raeburn 8760: my %displaystatus = ( previous => 'Expired',
8761: active => 'Active',
8762: future => 'Future',
8763: );
1.1075.2.36 raeburn 8764: my (%nothide,@possdoms);
1.630 raeburn 8765: if ($hidepriv) {
8766: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8767: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8768: if ($user !~ /:/) {
8769: $nothide{join(':',split(/[\@]/,$user))}=1;
8770: } else {
8771: $nothide{$user} = 1;
8772: }
8773: }
1.1075.2.36 raeburn 8774: my @possdoms = ($cdom);
8775: if ($coursehash{'checkforpriv'}) {
8776: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8777: }
1.630 raeburn 8778: }
1.439 raeburn 8779: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8780: my $match = 0;
1.412 raeburn 8781: my $secmatch = 0;
1.439 raeburn 8782: my $status;
1.412 raeburn 8783: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8784: $user =~ s/:$//;
1.439 raeburn 8785: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8786: if ($end == -1 || $start == -1) {
8787: next;
8788: }
8789: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8790: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8791: my ($uname,$udom) = split(/:/,$user);
8792: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8793: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8794: $secmatch = 1;
8795: } elsif ($usec eq '') {
1.420 albertel 8796: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8797: $secmatch = 1;
8798: }
8799: } else {
8800: if (grep(/^\Q$usec\E$/,@{$sections})) {
8801: $secmatch = 1;
8802: }
8803: }
8804: if (!$secmatch) {
8805: next;
8806: }
1.288 raeburn 8807: }
1.419 raeburn 8808: if ($usec eq '') {
8809: $usec = 'none';
8810: }
1.275 raeburn 8811: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8812: if ($hidepriv) {
1.1075.2.36 raeburn 8813: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8814: (!$nothide{$uname.':'.$udom})) {
8815: next;
8816: }
8817: }
1.503 raeburn 8818: if ($end > 0 && $end < $now) {
1.439 raeburn 8819: $status = 'previous';
8820: } elsif ($start > $now) {
8821: $status = 'future';
8822: } else {
8823: $status = 'active';
8824: }
1.277 albertel 8825: foreach my $type (keys(%{$types})) {
1.275 raeburn 8826: if ($status eq $type) {
1.420 albertel 8827: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8828: push(@{$$users{$role}{$user}},$type);
8829: }
1.288 raeburn 8830: $match = 1;
8831: }
8832: }
1.419 raeburn 8833: if (($match) && (ref($userdata) eq 'HASH')) {
8834: if (!exists($$userdata{$uname.':'.$udom})) {
8835: &get_user_info($udom,$uname,\%idx,$userdata);
8836: }
1.420 albertel 8837: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8838: push(@{$seclists{$uname.':'.$udom}},$usec);
8839: }
1.609 raeburn 8840: if (ref($statushash) eq 'HASH') {
8841: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8842: }
1.275 raeburn 8843: }
8844: }
8845: }
8846: }
1.290 albertel 8847: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8848: if ((defined($cdom)) && (defined($cnum))) {
8849: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8850: if ( defined($csettings{'internal.courseowner'}) ) {
8851: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8852: next if ($owner eq '');
8853: my ($ownername,$ownerdom);
8854: if ($owner =~ /^([^:]+):([^:]+)$/) {
8855: $ownername = $1;
8856: $ownerdom = $2;
8857: } else {
8858: $ownername = $owner;
8859: $ownerdom = $cdom;
8860: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8861: }
8862: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8863: if (defined($userdata) &&
1.609 raeburn 8864: !exists($$userdata{$owner})) {
8865: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8866: if (!grep(/^none$/,@{$seclists{$owner}})) {
8867: push(@{$seclists{$owner}},'none');
8868: }
8869: if (ref($statushash) eq 'HASH') {
8870: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8871: }
1.290 albertel 8872: }
1.279 raeburn 8873: }
8874: }
8875: }
1.419 raeburn 8876: foreach my $user (keys(%seclists)) {
8877: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8878: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8879: }
1.275 raeburn 8880: }
8881: return;
8882: }
8883:
1.288 raeburn 8884: sub get_user_info {
8885: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8886: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8887: &plainname($uname,$udom,'lastname');
1.291 albertel 8888: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8889: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8890: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8891: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8892: return;
8893: }
1.275 raeburn 8894:
1.472 raeburn 8895: ###############################################
8896:
8897: =pod
8898:
8899: =item * &get_user_quota()
8900:
1.1075.2.41 raeburn 8901: Retrieves quota assigned for storage of user files.
8902: Default is to report quota for portfolio files.
1.472 raeburn 8903:
8904: Incoming parameters:
8905: 1. user's username
8906: 2. user's domain
1.1075.2.41 raeburn 8907: 3. quota name - portfolio, author, or course
8908: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 8909: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 8910: course
1.472 raeburn 8911:
8912: Returns:
1.1075.2.58 raeburn 8913: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8914: 2. (Optional) Type of setting: custom or default
8915: (individually assigned or default for user's
8916: institutional status).
8917: 3. (Optional) - User's institutional status (e.g., faculty, staff
8918: or student - types as defined in localenroll::inst_usertypes
8919: for user's domain, which determines default quota for user.
8920: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8921:
8922: If a value has been stored in the user's environment,
1.536 raeburn 8923: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 8924: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8925:
8926: =cut
8927:
8928: ###############################################
8929:
8930:
8931: sub get_user_quota {
1.1075.2.42 raeburn 8932: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8933: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8934: if (!defined($udom)) {
8935: $udom = $env{'user.domain'};
8936: }
8937: if (!defined($uname)) {
8938: $uname = $env{'user.name'};
8939: }
8940: if (($udom eq '' || $uname eq '') ||
8941: ($udom eq 'public') && ($uname eq 'public')) {
8942: $quota = 0;
1.536 raeburn 8943: $quotatype = 'default';
8944: $defquota = 0;
1.472 raeburn 8945: } else {
1.536 raeburn 8946: my $inststatus;
1.1075.2.41 raeburn 8947: if ($quotaname eq 'course') {
8948: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8949: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8950: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8951: } else {
8952: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8953: $quota = $cenv{'internal.uploadquota'};
8954: }
1.536 raeburn 8955: } else {
1.1075.2.41 raeburn 8956: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8957: if ($quotaname eq 'author') {
8958: $quota = $env{'environment.authorquota'};
8959: } else {
8960: $quota = $env{'environment.portfolioquota'};
8961: }
8962: $inststatus = $env{'environment.inststatus'};
8963: } else {
8964: my %userenv =
8965: &Apache::lonnet::get('environment',['portfolioquota',
8966: 'authorquota','inststatus'],$udom,$uname);
8967: my ($tmp) = keys(%userenv);
8968: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8969: if ($quotaname eq 'author') {
8970: $quota = $userenv{'authorquota'};
8971: } else {
8972: $quota = $userenv{'portfolioquota'};
8973: }
8974: $inststatus = $userenv{'inststatus'};
8975: } else {
8976: undef(%userenv);
8977: }
8978: }
8979: }
8980: if ($quota eq '' || wantarray) {
8981: if ($quotaname eq 'course') {
8982: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 8983: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8984: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 8985: $defquota = $domdefs{$crstype.'quota'};
8986: }
8987: if ($defquota eq '') {
8988: $defquota = 500;
8989: }
1.1075.2.41 raeburn 8990: } else {
8991: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8992: }
8993: if ($quota eq '') {
8994: $quota = $defquota;
8995: $quotatype = 'default';
8996: } else {
8997: $quotatype = 'custom';
8998: }
1.472 raeburn 8999: }
9000: }
1.536 raeburn 9001: if (wantarray) {
9002: return ($quota,$quotatype,$settingstatus,$defquota);
9003: } else {
9004: return $quota;
9005: }
1.472 raeburn 9006: }
9007:
9008: ###############################################
9009:
9010: =pod
9011:
9012: =item * &default_quota()
9013:
1.536 raeburn 9014: Retrieves default quota assigned for storage of user portfolio files,
9015: given an (optional) user's institutional status.
1.472 raeburn 9016:
9017: Incoming parameters:
1.1075.2.42 raeburn 9018:
1.472 raeburn 9019: 1. domain
1.536 raeburn 9020: 2. (Optional) institutional status(es). This is a : separated list of
9021: status types (e.g., faculty, staff, student etc.)
9022: which apply to the user for whom the default is being retrieved.
9023: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 9024: default quota will be returned.
9025: 3. quota name - portfolio, author, or course
9026: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9027:
9028: Returns:
1.1075.2.42 raeburn 9029:
1.1075.2.58 raeburn 9030: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9031: 2. (Optional) institutional type which determined the value of the
9032: default quota.
1.472 raeburn 9033:
9034: If a value has been stored in the domain's configuration db,
9035: it will return that, otherwise it returns 20 (for backwards
9036: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 9037: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9038:
1.536 raeburn 9039: If the user's status includes multiple types (e.g., staff and student),
9040: the largest default quota which applies to the user determines the
9041: default quota returned.
9042:
1.472 raeburn 9043: =cut
9044:
9045: ###############################################
9046:
9047:
9048: sub default_quota {
1.1075.2.41 raeburn 9049: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9050: my ($defquota,$settingstatus);
9051: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9052: ['quotas'],$udom);
1.1075.2.41 raeburn 9053: my $key = 'defaultquota';
9054: if ($quotaname eq 'author') {
9055: $key = 'authorquota';
9056: }
1.622 raeburn 9057: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9058: if ($inststatus ne '') {
1.765 raeburn 9059: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9060: foreach my $item (@statuses) {
1.1075.2.41 raeburn 9061: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9062: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9063: if ($defquota eq '') {
1.1075.2.41 raeburn 9064: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9065: $settingstatus = $item;
1.1075.2.41 raeburn 9066: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9067: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9068: $settingstatus = $item;
9069: }
9070: }
1.1075.2.41 raeburn 9071: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9072: if ($quotahash{'quotas'}{$item} ne '') {
9073: if ($defquota eq '') {
9074: $defquota = $quotahash{'quotas'}{$item};
9075: $settingstatus = $item;
9076: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9077: $defquota = $quotahash{'quotas'}{$item};
9078: $settingstatus = $item;
9079: }
1.536 raeburn 9080: }
9081: }
9082: }
9083: }
9084: if ($defquota eq '') {
1.1075.2.41 raeburn 9085: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9086: $defquota = $quotahash{'quotas'}{$key}{'default'};
9087: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9088: $defquota = $quotahash{'quotas'}{'default'};
9089: }
1.536 raeburn 9090: $settingstatus = 'default';
1.1075.2.42 raeburn 9091: if ($defquota eq '') {
9092: if ($quotaname eq 'author') {
9093: $defquota = 500;
9094: }
9095: }
1.536 raeburn 9096: }
9097: } else {
9098: $settingstatus = 'default';
1.1075.2.41 raeburn 9099: if ($quotaname eq 'author') {
9100: $defquota = 500;
9101: } else {
9102: $defquota = 20;
9103: }
1.536 raeburn 9104: }
9105: if (wantarray) {
9106: return ($defquota,$settingstatus);
1.472 raeburn 9107: } else {
1.536 raeburn 9108: return $defquota;
1.472 raeburn 9109: }
9110: }
9111:
1.1075.2.41 raeburn 9112: ###############################################
9113:
9114: =pod
9115:
1.1075.2.42 raeburn 9116: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 9117:
9118: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 9119: of existing file within authoring space will cause quota for the authoring
9120: space to be exceeded.
9121:
9122: Same, if upload of a file directly to a course/community via Course Editor
9123: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 9124:
1.1075.2.61 raeburn 9125: Inputs: 7
1.1075.2.42 raeburn 9126: 1. username or coursenum
1.1075.2.41 raeburn 9127: 2. domain
1.1075.2.42 raeburn 9128: 3. context ('author' or 'course')
1.1075.2.41 raeburn 9129: 4. filename of file for which action is being requested
9130: 5. filesize (kB) of file
9131: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 9132: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 9133:
9134: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
9135: otherwise return null.
9136:
1.1075.2.42 raeburn 9137: =back
9138:
1.1075.2.41 raeburn 9139: =cut
9140:
1.1075.2.42 raeburn 9141: sub excess_filesize_warning {
1.1075.2.59 raeburn 9142: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 9143: my $current_disk_usage = 0;
1.1075.2.59 raeburn 9144: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 9145: if ($context eq 'author') {
9146: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9147: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9148: } else {
9149: foreach my $subdir ('docs','supplemental') {
9150: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9151: }
9152: }
1.1075.2.41 raeburn 9153: $disk_quota = int($disk_quota * 1000);
9154: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69 raeburn 9155: return '<p class="LC_warning">'.
1.1075.2.41 raeburn 9156: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69 raeburn 9157: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9158: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41 raeburn 9159: $disk_quota,$current_disk_usage).
9160: '</p>';
9161: }
9162: return;
9163: }
9164:
9165: ###############################################
9166:
9167:
1.384 raeburn 9168: sub get_secgrprole_info {
9169: my ($cdom,$cnum,$needroles,$type) = @_;
9170: my %sections_count = &get_sections($cdom,$cnum);
9171: my @sections = (sort {$a <=> $b} keys(%sections_count));
9172: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9173: my @groups = sort(keys(%curr_groups));
9174: my $allroles = [];
9175: my $rolehash;
9176: my $accesshash = {
9177: active => 'Currently has access',
9178: future => 'Will have future access',
9179: previous => 'Previously had access',
9180: };
9181: if ($needroles) {
9182: $rolehash = {'all' => 'all'};
1.385 albertel 9183: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9184: if (&Apache::lonnet::error(%user_roles)) {
9185: undef(%user_roles);
9186: }
9187: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9188: my ($role)=split(/\:/,$item,2);
9189: if ($role eq 'cr') { next; }
9190: if ($role =~ /^cr/) {
9191: $$rolehash{$role} = (split('/',$role))[3];
9192: } else {
9193: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9194: }
9195: }
9196: foreach my $key (sort(keys(%{$rolehash}))) {
9197: push(@{$allroles},$key);
9198: }
9199: push (@{$allroles},'st');
9200: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9201: }
9202: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9203: }
9204:
1.555 raeburn 9205: sub user_picker {
1.994 raeburn 9206: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9207: my $currdom = $dom;
9208: my %curr_selected = (
9209: srchin => 'dom',
1.580 raeburn 9210: srchby => 'lastname',
1.555 raeburn 9211: );
9212: my $srchterm;
1.625 raeburn 9213: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9214: if ($srch->{'srchby'} ne '') {
9215: $curr_selected{'srchby'} = $srch->{'srchby'};
9216: }
9217: if ($srch->{'srchin'} ne '') {
9218: $curr_selected{'srchin'} = $srch->{'srchin'};
9219: }
9220: if ($srch->{'srchtype'} ne '') {
9221: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9222: }
9223: if ($srch->{'srchdomain'} ne '') {
9224: $currdom = $srch->{'srchdomain'};
9225: }
9226: $srchterm = $srch->{'srchterm'};
9227: }
1.1075.2.98 raeburn 9228: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 9229: 'usr' => 'Search criteria',
1.563 raeburn 9230: 'doma' => 'Domain/institution to search',
1.558 albertel 9231: 'uname' => 'username',
9232: 'lastname' => 'last name',
1.555 raeburn 9233: 'lastfirst' => 'last name, first name',
1.558 albertel 9234: 'crs' => 'in this course',
1.576 raeburn 9235: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9236: 'alc' => 'all LON-CAPA',
1.573 raeburn 9237: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9238: 'exact' => 'is',
9239: 'contains' => 'contains',
1.569 raeburn 9240: 'begins' => 'begins with',
1.1075.2.98 raeburn 9241: );
9242: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 9243: 'youm' => "You must include some text to search for.",
9244: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9245: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9246: 'yomc' => "You must choose a domain when using an institutional directory search.",
9247: 'ymcd' => "You must choose a domain when using a domain search.",
9248: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9249: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9250: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9251: );
1.1075.2.98 raeburn 9252: &html_escape(\%html_lt);
9253: &js_escape(\%js_lt);
1.563 raeburn 9254: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9255: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9256:
9257: my @srchins = ('crs','dom','alc','instd');
9258:
9259: foreach my $option (@srchins) {
9260: # FIXME 'alc' option unavailable until
9261: # loncreateuser::print_user_query_page()
9262: # has been completed.
9263: next if ($option eq 'alc');
1.880 raeburn 9264: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9265: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9266: if ($curr_selected{'srchin'} eq $option) {
9267: $srchinsel .= '
1.1075.2.98 raeburn 9268: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 9269: } else {
9270: $srchinsel .= '
1.1075.2.98 raeburn 9271: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 9272: }
1.555 raeburn 9273: }
1.563 raeburn 9274: $srchinsel .= "\n </select>\n";
1.555 raeburn 9275:
9276: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9277: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9278: if ($curr_selected{'srchby'} eq $option) {
9279: $srchbysel .= '
1.1075.2.98 raeburn 9280: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9281: } else {
9282: $srchbysel .= '
1.1075.2.98 raeburn 9283: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9284: }
9285: }
9286: $srchbysel .= "\n </select>\n";
9287:
9288: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9289: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9290: if ($curr_selected{'srchtype'} eq $option) {
9291: $srchtypesel .= '
1.1075.2.98 raeburn 9292: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9293: } else {
9294: $srchtypesel .= '
1.1075.2.98 raeburn 9295: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9296: }
9297: }
9298: $srchtypesel .= "\n </select>\n";
9299:
1.558 albertel 9300: my ($newuserscript,$new_user_create);
1.994 raeburn 9301: my $context_dom = $env{'request.role.domain'};
9302: if ($context eq 'requestcrs') {
9303: if ($env{'form.coursedom'} ne '') {
9304: $context_dom = $env{'form.coursedom'};
9305: }
9306: }
1.556 raeburn 9307: if ($forcenewuser) {
1.576 raeburn 9308: if (ref($srch) eq 'HASH') {
1.994 raeburn 9309: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9310: if ($cancreate) {
9311: $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>';
9312: } else {
1.799 bisitz 9313: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9314: my %usertypetext = (
9315: official => 'institutional',
9316: unofficial => 'non-institutional',
9317: );
1.799 bisitz 9318: $new_user_create = '<p class="LC_warning">'
9319: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9320: .' '
9321: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9322: ,'<a href="'.$helplink.'">','</a>')
9323: .'</p><br />';
1.627 raeburn 9324: }
1.576 raeburn 9325: }
9326: }
9327:
1.556 raeburn 9328: $newuserscript = <<"ENDSCRIPT";
9329:
1.570 raeburn 9330: function setSearch(createnew,callingForm) {
1.556 raeburn 9331: if (createnew == 1) {
1.570 raeburn 9332: for (var i=0; i<callingForm.srchby.length; i++) {
9333: if (callingForm.srchby.options[i].value == 'uname') {
9334: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9335: }
9336: }
1.570 raeburn 9337: for (var i=0; i<callingForm.srchin.length; i++) {
9338: if ( callingForm.srchin.options[i].value == 'dom') {
9339: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9340: }
9341: }
1.570 raeburn 9342: for (var i=0; i<callingForm.srchtype.length; i++) {
9343: if (callingForm.srchtype.options[i].value == 'exact') {
9344: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9345: }
9346: }
1.570 raeburn 9347: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9348: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9349: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9350: }
9351: }
9352: }
9353: }
9354: ENDSCRIPT
1.558 albertel 9355:
1.556 raeburn 9356: }
9357:
1.555 raeburn 9358: my $output = <<"END_BLOCK";
1.556 raeburn 9359: <script type="text/javascript">
1.824 bisitz 9360: // <![CDATA[
1.570 raeburn 9361: function validateEntry(callingForm) {
1.558 albertel 9362:
1.556 raeburn 9363: var checkok = 1;
1.558 albertel 9364: var srchin;
1.570 raeburn 9365: for (var i=0; i<callingForm.srchin.length; i++) {
9366: if ( callingForm.srchin[i].checked ) {
9367: srchin = callingForm.srchin[i].value;
1.558 albertel 9368: }
9369: }
9370:
1.570 raeburn 9371: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9372: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9373: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9374: var srchterm = callingForm.srchterm.value;
9375: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9376: var msg = "";
9377:
9378: if (srchterm == "") {
9379: checkok = 0;
1.1075.2.98 raeburn 9380: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 9381: }
9382:
1.569 raeburn 9383: if (srchtype== 'begins') {
9384: if (srchterm.length < 2) {
9385: checkok = 0;
1.1075.2.98 raeburn 9386: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 9387: }
9388: }
9389:
1.556 raeburn 9390: if (srchtype== 'contains') {
9391: if (srchterm.length < 3) {
9392: checkok = 0;
1.1075.2.98 raeburn 9393: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 9394: }
9395: }
9396: if (srchin == 'instd') {
9397: if (srchdomain == '') {
9398: checkok = 0;
1.1075.2.98 raeburn 9399: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 9400: }
9401: }
9402: if (srchin == 'dom') {
9403: if (srchdomain == '') {
9404: checkok = 0;
1.1075.2.98 raeburn 9405: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 9406: }
9407: }
9408: if (srchby == 'lastfirst') {
9409: if (srchterm.indexOf(",") == -1) {
9410: checkok = 0;
1.1075.2.98 raeburn 9411: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 9412: }
9413: if (srchterm.indexOf(",") == srchterm.length -1) {
9414: checkok = 0;
1.1075.2.98 raeburn 9415: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 9416: }
9417: }
9418: if (checkok == 0) {
1.1075.2.98 raeburn 9419: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 9420: return;
9421: }
9422: if (checkok == 1) {
1.570 raeburn 9423: callingForm.submit();
1.556 raeburn 9424: }
9425: }
9426:
9427: $newuserscript
9428:
1.824 bisitz 9429: // ]]>
1.556 raeburn 9430: </script>
1.558 albertel 9431:
9432: $new_user_create
9433:
1.555 raeburn 9434: END_BLOCK
1.558 albertel 9435:
1.876 raeburn 9436: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98 raeburn 9437: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 9438: $domform.
9439: &Apache::lonhtmlcommon::row_closure().
1.1075.2.98 raeburn 9440: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 9441: $srchbysel.
9442: $srchtypesel.
9443: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9444: $srchinsel.
9445: &Apache::lonhtmlcommon::row_closure(1).
9446: &Apache::lonhtmlcommon::end_pick_box().
9447: '<br />';
1.555 raeburn 9448: return $output;
9449: }
9450:
1.612 raeburn 9451: sub user_rule_check {
1.615 raeburn 9452: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99 raeburn 9453: my ($response,%inst_response);
1.612 raeburn 9454: if (ref($usershash) eq 'HASH') {
1.1075.2.99 raeburn 9455: if (keys(%{$usershash}) > 1) {
9456: my (%by_username,%by_id,%userdoms);
9457: my $checkid;
1.612 raeburn 9458: if (ref($checks) eq 'HASH') {
1.1075.2.99 raeburn 9459: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
9460: $checkid = 1;
9461: }
9462: }
9463: foreach my $user (keys(%{$usershash})) {
9464: my ($uname,$udom) = split(/:/,$user);
9465: if ($checkid) {
9466: if (ref($usershash->{$user}) eq 'HASH') {
9467: if ($usershash->{$user}->{'id'} ne '') {
9468: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
9469: $userdoms{$udom} = 1;
9470: if (ref($inst_results) eq 'HASH') {
9471: $inst_results->{$uname.':'.$udom} = {};
9472: }
9473: }
9474: }
9475: } else {
9476: $by_username{$udom}{$uname} = 1;
9477: $userdoms{$udom} = 1;
9478: if (ref($inst_results) eq 'HASH') {
9479: $inst_results->{$uname.':'.$udom} = {};
9480: }
9481: }
9482: }
9483: foreach my $udom (keys(%userdoms)) {
9484: if (!$got_rules->{$udom}) {
9485: my %domconfig = &Apache::lonnet::get_dom('configuration',
9486: ['usercreation'],$udom);
9487: if (ref($domconfig{'usercreation'}) eq 'HASH') {
9488: foreach my $item ('username','id') {
9489: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9490: $$curr_rules{$udom}{$item} =
9491: $domconfig{'usercreation'}{$item.'_rule'};
9492: }
9493: }
9494: }
9495: $got_rules->{$udom} = 1;
9496: }
9497: }
9498: if ($checkid) {
9499: foreach my $udom (keys(%by_id)) {
9500: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
9501: if ($outcome eq 'ok') {
9502: foreach my $id (keys(%{$by_id{$udom}})) {
9503: my $uname = $by_id{$udom}{$id};
9504: $inst_response{$uname.':'.$udom} = $outcome;
9505: }
9506: if (ref($results) eq 'HASH') {
9507: foreach my $uname (keys(%{$results})) {
9508: if (exists($inst_response{$uname.':'.$udom})) {
9509: $inst_response{$uname.':'.$udom} = $outcome;
9510: $inst_results->{$uname.':'.$udom} = $results->{$uname};
9511: }
9512: }
9513: }
9514: }
1.612 raeburn 9515: }
1.615 raeburn 9516: } else {
1.1075.2.99 raeburn 9517: foreach my $udom (keys(%by_username)) {
9518: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
9519: if ($outcome eq 'ok') {
9520: foreach my $uname (keys(%{$by_username{$udom}})) {
9521: $inst_response{$uname.':'.$udom} = $outcome;
9522: }
9523: if (ref($results) eq 'HASH') {
9524: foreach my $uname (keys(%{$results})) {
9525: $inst_results->{$uname.':'.$udom} = $results->{$uname};
9526: }
9527: }
9528: }
9529: }
1.612 raeburn 9530: }
1.1075.2.99 raeburn 9531: } elsif (keys(%{$usershash}) == 1) {
9532: my $user = (keys(%{$usershash}))[0];
9533: my ($uname,$udom) = split(/:/,$user);
9534: if (($udom ne '') && ($uname ne '')) {
9535: if (ref($usershash->{$user}) eq 'HASH') {
9536: if (ref($checks) eq 'HASH') {
9537: if (defined($checks->{'username'})) {
9538: ($inst_response{$user},%{$inst_results->{$user}}) =
9539: &Apache::lonnet::get_instuser($udom,$uname);
9540: } elsif (defined($checks->{'id'})) {
9541: if ($usershash->{$user}->{'id'} ne '') {
9542: ($inst_response{$user},%{$inst_results->{$user}}) =
9543: &Apache::lonnet::get_instuser($udom,undef,
9544: $usershash->{$user}->{'id'});
9545: } else {
9546: ($inst_response{$user},%{$inst_results->{$user}}) =
9547: &Apache::lonnet::get_instuser($udom,$uname);
9548: }
9549: }
9550: } else {
9551: ($inst_response{$user},%{$inst_results->{$user}}) =
9552: &Apache::lonnet::get_instuser($udom,$uname);
9553: return;
9554: }
9555: if (!$got_rules->{$udom}) {
9556: my %domconfig = &Apache::lonnet::get_dom('configuration',
9557: ['usercreation'],$udom);
9558: if (ref($domconfig{'usercreation'}) eq 'HASH') {
9559: foreach my $item ('username','id') {
9560: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9561: $$curr_rules{$udom}{$item} =
9562: $domconfig{'usercreation'}{$item.'_rule'};
9563: }
9564: }
1.585 raeburn 9565: }
1.1075.2.99 raeburn 9566: $got_rules->{$udom} = 1;
1.585 raeburn 9567: }
9568: }
1.1075.2.99 raeburn 9569: } else {
9570: return;
9571: }
9572: } else {
9573: return;
9574: }
9575: foreach my $user (keys(%{$usershash})) {
9576: my ($uname,$udom) = split(/:/,$user);
9577: next if (($udom eq '') || ($uname eq ''));
9578: my $id;
9579: if (ref($inst_results) eq 'HASH') {
9580: if (ref($inst_results->{$user}) eq 'HASH') {
9581: $id = $inst_results->{$user}->{'id'};
9582: }
9583: }
9584: if ($id eq '') {
9585: if (ref($usershash->{$user})) {
9586: $id = $usershash->{$user}->{'id'};
9587: }
1.585 raeburn 9588: }
1.612 raeburn 9589: foreach my $item (keys(%{$checks})) {
9590: if (ref($$curr_rules{$udom}) eq 'HASH') {
9591: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9592: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99 raeburn 9593: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
9594: $$curr_rules{$udom}{$item});
1.612 raeburn 9595: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9596: if ($rule_check{$rule}) {
9597: $$rulematch{$user}{$item} = $rule;
1.1075.2.99 raeburn 9598: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 9599: if (ref($inst_results) eq 'HASH') {
9600: if (ref($inst_results->{$user}) eq 'HASH') {
9601: if (keys(%{$inst_results->{$user}}) == 0) {
9602: $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99 raeburn 9603: } elsif ($item eq 'id') {
9604: if ($inst_results->{$user}->{'id'} eq '') {
9605: $$alerts{$item}{$udom}{$uname} = 1;
9606: }
1.615 raeburn 9607: }
1.612 raeburn 9608: }
9609: }
1.615 raeburn 9610: }
9611: last;
1.585 raeburn 9612: }
9613: }
9614: }
9615: }
9616: }
9617: }
9618: }
9619: }
1.612 raeburn 9620: return;
9621: }
9622:
9623: sub user_rule_formats {
9624: my ($domain,$domdesc,$curr_rules,$check) = @_;
9625: my %text = (
9626: 'username' => 'Usernames',
9627: 'id' => 'IDs',
9628: );
9629: my $output;
9630: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9631: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9632: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 9633: $output = '<br />'.
9634: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9635: '<span class="LC_cusr_emph">','</span>',$domdesc).
9636: ' <ul>';
1.612 raeburn 9637: foreach my $rule (@{$ruleorder}) {
9638: if (ref($curr_rules) eq 'ARRAY') {
9639: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9640: if (ref($rules->{$rule}) eq 'HASH') {
9641: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9642: $rules->{$rule}{'desc'}.'</li>';
9643: }
9644: }
9645: }
9646: }
9647: $output .= '</ul>';
9648: }
9649: }
9650: return $output;
9651: }
9652:
9653: sub instrule_disallow_msg {
1.615 raeburn 9654: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9655: my $response;
9656: my %text = (
9657: item => 'username',
9658: items => 'usernames',
9659: match => 'matches',
9660: do => 'does',
9661: action => 'a username',
9662: one => 'one',
9663: );
9664: if ($count > 1) {
9665: $text{'item'} = 'usernames';
9666: $text{'match'} ='match';
9667: $text{'do'} = 'do';
9668: $text{'action'} = 'usernames',
9669: $text{'one'} = 'ones';
9670: }
9671: if ($checkitem eq 'id') {
9672: $text{'items'} = 'IDs';
9673: $text{'item'} = 'ID';
9674: $text{'action'} = 'an ID';
1.615 raeburn 9675: if ($count > 1) {
9676: $text{'item'} = 'IDs';
9677: $text{'action'} = 'IDs';
9678: }
1.612 raeburn 9679: }
1.674 bisitz 9680: $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 9681: if ($mode eq 'upload') {
9682: if ($checkitem eq 'username') {
9683: $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'}.");
9684: } elsif ($checkitem eq 'id') {
1.674 bisitz 9685: $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 9686: }
1.669 raeburn 9687: } elsif ($mode eq 'selfcreate') {
9688: if ($checkitem eq 'id') {
9689: $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.");
9690: }
1.615 raeburn 9691: } else {
9692: if ($checkitem eq 'username') {
9693: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9694: } elsif ($checkitem eq 'id') {
9695: $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.");
9696: }
1.612 raeburn 9697: }
9698: return $response;
1.585 raeburn 9699: }
9700:
1.624 raeburn 9701: sub personal_data_fieldtitles {
9702: my %fieldtitles = &Apache::lonlocal::texthash (
9703: id => 'Student/Employee ID',
9704: permanentemail => 'E-mail address',
9705: lastname => 'Last Name',
9706: firstname => 'First Name',
9707: middlename => 'Middle Name',
9708: generation => 'Generation',
9709: gen => 'Generation',
1.765 raeburn 9710: inststatus => 'Affiliation',
1.624 raeburn 9711: );
9712: return %fieldtitles;
9713: }
9714:
1.642 raeburn 9715: sub sorted_inst_types {
9716: my ($dom) = @_;
1.1075.2.70 raeburn 9717: my ($usertypes,$order);
9718: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9719: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9720: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9721: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9722: } else {
9723: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9724: }
1.642 raeburn 9725: my $othertitle = &mt('All users');
9726: if ($env{'request.course.id'}) {
1.668 raeburn 9727: $othertitle = &mt('Any users');
1.642 raeburn 9728: }
9729: my @types;
9730: if (ref($order) eq 'ARRAY') {
9731: @types = @{$order};
9732: }
9733: if (@types == 0) {
9734: if (ref($usertypes) eq 'HASH') {
9735: @types = sort(keys(%{$usertypes}));
9736: }
9737: }
9738: if (keys(%{$usertypes}) > 0) {
9739: $othertitle = &mt('Other users');
9740: }
9741: return ($othertitle,$usertypes,\@types);
9742: }
9743:
1.645 raeburn 9744: sub get_institutional_codes {
9745: my ($settings,$allcourses,$LC_code) = @_;
9746: # Get complete list of course sections to update
9747: my @currsections = ();
9748: my @currxlists = ();
9749: my $coursecode = $$settings{'internal.coursecode'};
9750:
9751: if ($$settings{'internal.sectionnums'} ne '') {
9752: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9753: }
9754:
9755: if ($$settings{'internal.crosslistings'} ne '') {
9756: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9757: }
9758:
9759: if (@currxlists > 0) {
9760: foreach (@currxlists) {
9761: if (m/^([^:]+):(\w*)$/) {
9762: unless (grep/^$1$/,@{$allcourses}) {
9763: push @{$allcourses},$1;
9764: $$LC_code{$1} = $2;
9765: }
9766: }
9767: }
9768: }
9769:
9770: if (@currsections > 0) {
9771: foreach (@currsections) {
9772: if (m/^(\w+):(\w*)$/) {
9773: my $sec = $coursecode.$1;
9774: my $lc_sec = $2;
9775: unless (grep/^$sec$/,@{$allcourses}) {
9776: push @{$allcourses},$sec;
9777: $$LC_code{$sec} = $lc_sec;
9778: }
9779: }
9780: }
9781: }
9782: return;
9783: }
9784:
1.971 raeburn 9785: sub get_standard_codeitems {
9786: return ('Year','Semester','Department','Number','Section');
9787: }
9788:
1.112 bowersj2 9789: =pod
9790:
1.780 raeburn 9791: =head1 Slot Helpers
9792:
9793: =over 4
9794:
9795: =item * sorted_slots()
9796:
1.1040 raeburn 9797: Sorts an array of slot names in order of an optional sort key,
9798: default sort is by slot start time (earliest first).
1.780 raeburn 9799:
9800: Inputs:
9801:
9802: =over 4
9803:
9804: slotsarr - Reference to array of unsorted slot names.
9805:
9806: slots - Reference to hash of hash, where outer hash keys are slot names.
9807:
1.1040 raeburn 9808: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9809:
1.549 albertel 9810: =back
9811:
1.780 raeburn 9812: Returns:
9813:
9814: =over 4
9815:
1.1040 raeburn 9816: sorted - An array of slot names sorted by a specified sort key
9817: (default sort key is start time of the slot).
1.780 raeburn 9818:
9819: =back
9820:
9821: =cut
9822:
9823:
9824: sub sorted_slots {
1.1040 raeburn 9825: my ($slotsarr,$slots,$sortkey) = @_;
9826: if ($sortkey eq '') {
9827: $sortkey = 'starttime';
9828: }
1.780 raeburn 9829: my @sorted;
9830: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9831: @sorted =
9832: sort {
9833: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9834: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9835: }
9836: if (ref($slots->{$a})) { return -1;}
9837: if (ref($slots->{$b})) { return 1;}
9838: return 0;
9839: } @{$slotsarr};
9840: }
9841: return @sorted;
9842: }
9843:
1.1040 raeburn 9844: =pod
9845:
9846: =item * get_future_slots()
9847:
9848: Inputs:
9849:
9850: =over 4
9851:
9852: cnum - course number
9853:
9854: cdom - course domain
9855:
9856: now - current UNIX time
9857:
9858: symb - optional symb
9859:
9860: =back
9861:
9862: Returns:
9863:
9864: =over 4
9865:
9866: sorted_reservable - ref to array of student_schedulable slots currently
9867: reservable, ordered by end date of reservation period.
9868:
9869: reservable_now - ref to hash of student_schedulable slots currently
9870: reservable.
9871:
9872: Keys in inner hash are:
9873: (a) symb: either blank or symb to which slot use is restricted.
9874: (b) endreserve: end date of reservation period.
9875:
9876: sorted_future - ref to array of student_schedulable slots reservable in
9877: the future, ordered by start date of reservation period.
9878:
9879: future_reservable - ref to hash of student_schedulable slots reservable
9880: in the future.
9881:
9882: Keys in inner hash are:
9883: (a) symb: either blank or symb to which slot use is restricted.
9884: (b) startreserve: start date of reservation period.
9885:
9886: =back
9887:
9888: =cut
9889:
9890: sub get_future_slots {
9891: my ($cnum,$cdom,$now,$symb) = @_;
9892: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9893: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9894: foreach my $slot (keys(%slots)) {
9895: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9896: if ($symb) {
9897: next if (($slots{$slot}->{'symb'} ne '') &&
9898: ($slots{$slot}->{'symb'} ne $symb));
9899: }
9900: if (($slots{$slot}->{'starttime'} > $now) &&
9901: ($slots{$slot}->{'endtime'} > $now)) {
9902: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9903: my $userallowed = 0;
9904: if ($slots{$slot}->{'allowedsections'}) {
9905: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9906: if (!defined($env{'request.role.sec'})
9907: && grep(/^No section assigned$/,@allowed_sec)) {
9908: $userallowed=1;
9909: } else {
9910: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9911: $userallowed=1;
9912: }
9913: }
9914: unless ($userallowed) {
9915: if (defined($env{'request.course.groups'})) {
9916: my @groups = split(/:/,$env{'request.course.groups'});
9917: foreach my $group (@groups) {
9918: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9919: $userallowed=1;
9920: last;
9921: }
9922: }
9923: }
9924: }
9925: }
9926: if ($slots{$slot}->{'allowedusers'}) {
9927: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9928: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9929: if (grep(/^\Q$user\E$/,@allowed_users)) {
9930: $userallowed = 1;
9931: }
9932: }
9933: next unless($userallowed);
9934: }
9935: my $startreserve = $slots{$slot}->{'startreserve'};
9936: my $endreserve = $slots{$slot}->{'endreserve'};
9937: my $symb = $slots{$slot}->{'symb'};
9938: if (($startreserve < $now) &&
9939: (!$endreserve || $endreserve > $now)) {
9940: my $lastres = $endreserve;
9941: if (!$lastres) {
9942: $lastres = $slots{$slot}->{'starttime'};
9943: }
9944: $reservable_now{$slot} = {
9945: symb => $symb,
9946: endreserve => $lastres
9947: };
9948: } elsif (($startreserve > $now) &&
9949: (!$endreserve || $endreserve > $startreserve)) {
9950: $future_reservable{$slot} = {
9951: symb => $symb,
9952: startreserve => $startreserve
9953: };
9954: }
9955: }
9956: }
9957: my @unsorted_reservable = keys(%reservable_now);
9958: if (@unsorted_reservable > 0) {
9959: @sorted_reservable =
9960: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9961: }
9962: my @unsorted_future = keys(%future_reservable);
9963: if (@unsorted_future > 0) {
9964: @sorted_future =
9965: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9966: }
9967: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9968: }
1.780 raeburn 9969:
9970: =pod
9971:
1.1057 foxr 9972: =back
9973:
1.549 albertel 9974: =head1 HTTP Helpers
9975:
9976: =over 4
9977:
1.648 raeburn 9978: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9979:
1.258 albertel 9980: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9981: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9982: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9983:
9984: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9985: $possible_names is an ref to an array of form element names. As an example:
9986: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9987: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9988:
9989: =cut
1.1 albertel 9990:
1.6 albertel 9991: sub get_unprocessed_cgi {
1.25 albertel 9992: my ($query,$possible_names)= @_;
1.26 matthew 9993: # $Apache::lonxml::debug=1;
1.356 albertel 9994: foreach my $pair (split(/&/,$query)) {
9995: my ($name, $value) = split(/=/,$pair);
1.369 www 9996: $name = &unescape($name);
1.25 albertel 9997: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9998: $value =~ tr/+/ /;
9999: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10000: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10001: }
1.16 harris41 10002: }
1.6 albertel 10003: }
10004:
1.112 bowersj2 10005: =pod
10006:
1.648 raeburn 10007: =item * &cacheheader()
1.112 bowersj2 10008:
10009: returns cache-controlling header code
10010:
10011: =cut
10012:
1.7 albertel 10013: sub cacheheader {
1.258 albertel 10014: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10015: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10016: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10017: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10018: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10019: return $output;
1.7 albertel 10020: }
10021:
1.112 bowersj2 10022: =pod
10023:
1.648 raeburn 10024: =item * &no_cache($r)
1.112 bowersj2 10025:
10026: specifies header code to not have cache
10027:
10028: =cut
10029:
1.9 albertel 10030: sub no_cache {
1.216 albertel 10031: my ($r) = @_;
10032: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10033: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10034: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10035: $r->no_cache(1);
10036: $r->header_out("Expires" => $date);
10037: $r->header_out("Pragma" => "no-cache");
1.123 www 10038: }
10039:
10040: sub content_type {
1.181 albertel 10041: my ($r,$type,$charset) = @_;
1.299 foxr 10042: if ($r) {
10043: # Note that printout.pl calls this with undef for $r.
10044: &no_cache($r);
10045: }
1.258 albertel 10046: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10047: unless ($charset) {
10048: $charset=&Apache::lonlocal::current_encoding;
10049: }
10050: if ($charset) { $type.='; charset='.$charset; }
10051: if ($r) {
10052: $r->content_type($type);
10053: } else {
10054: print("Content-type: $type\n\n");
10055: }
1.9 albertel 10056: }
1.25 albertel 10057:
1.112 bowersj2 10058: =pod
10059:
1.648 raeburn 10060: =item * &add_to_env($name,$value)
1.112 bowersj2 10061:
1.258 albertel 10062: adds $name to the %env hash with value
1.112 bowersj2 10063: $value, if $name already exists, the entry is converted to an array
10064: reference and $value is added to the array.
10065:
10066: =cut
10067:
1.25 albertel 10068: sub add_to_env {
10069: my ($name,$value)=@_;
1.258 albertel 10070: if (defined($env{$name})) {
10071: if (ref($env{$name})) {
1.25 albertel 10072: #already have multiple values
1.258 albertel 10073: push(@{ $env{$name} },$value);
1.25 albertel 10074: } else {
10075: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10076: my $first=$env{$name};
10077: undef($env{$name});
10078: push(@{ $env{$name} },$first,$value);
1.25 albertel 10079: }
10080: } else {
1.258 albertel 10081: $env{$name}=$value;
1.25 albertel 10082: }
1.31 albertel 10083: }
1.149 albertel 10084:
10085: =pod
10086:
1.648 raeburn 10087: =item * &get_env_multiple($name)
1.149 albertel 10088:
1.258 albertel 10089: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10090: values may be defined and end up as an array ref.
10091:
10092: returns an array of values
10093:
10094: =cut
10095:
10096: sub get_env_multiple {
10097: my ($name) = @_;
10098: my @values;
1.258 albertel 10099: if (defined($env{$name})) {
1.149 albertel 10100: # exists is it an array
1.258 albertel 10101: if (ref($env{$name})) {
10102: @values=@{ $env{$name} };
1.149 albertel 10103: } else {
1.258 albertel 10104: $values[0]=$env{$name};
1.149 albertel 10105: }
10106: }
10107: return(@values);
10108: }
10109:
1.660 raeburn 10110: sub ask_for_embedded_content {
10111: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10112: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 10113: %currsubfile,%unused,$rem);
1.1071 raeburn 10114: my $counter = 0;
10115: my $numnew = 0;
1.987 raeburn 10116: my $numremref = 0;
10117: my $numinvalid = 0;
10118: my $numpathchg = 0;
10119: my $numexisting = 0;
1.1071 raeburn 10120: my $numunused = 0;
10121: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 10122: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10123: my $heading = &mt('Upload embedded files');
10124: my $buttontext = &mt('Upload');
10125:
1.1075.2.11 raeburn 10126: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 10127: if ($actionurl eq '/adm/dependencies') {
10128: $navmap = Apache::lonnavmaps::navmap->new();
10129: }
10130: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10131: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 10132: }
1.1075.2.35 raeburn 10133: if (($actionurl eq '/adm/portfolio') ||
10134: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10135: my $current_path='/';
10136: if ($env{'form.currentpath'}) {
10137: $current_path = $env{'form.currentpath'};
10138: }
10139: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 10140: $udom = $cdom;
10141: $uname = $cnum;
1.984 raeburn 10142: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10143: } else {
10144: $udom = $env{'user.domain'};
10145: $uname = $env{'user.name'};
10146: $url = '/userfiles/portfolio';
10147: }
1.987 raeburn 10148: $toplevel = $url.'/';
1.984 raeburn 10149: $url .= $current_path;
10150: $getpropath = 1;
1.987 raeburn 10151: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10152: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10153: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10154: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10155: $toplevel = $url;
1.984 raeburn 10156: if ($rest ne '') {
1.987 raeburn 10157: $url .= $rest;
10158: }
10159: } elsif ($actionurl eq '/adm/coursedocs') {
10160: if (ref($args) eq 'HASH') {
1.1071 raeburn 10161: $url = $args->{'docs_url'};
10162: $toplevel = $url;
1.1075.2.11 raeburn 10163: if ($args->{'context'} eq 'paste') {
10164: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10165: ($path) =
10166: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10167: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10168: $fileloc =~ s{^/}{};
10169: }
1.1071 raeburn 10170: }
10171: } elsif ($actionurl eq '/adm/dependencies') {
10172: if ($env{'request.course.id'} ne '') {
10173: if (ref($args) eq 'HASH') {
10174: $url = $args->{'docs_url'};
10175: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 10176: $toplevel = $url;
10177: unless ($toplevel =~ m{^/}) {
10178: $toplevel = "/$url";
10179: }
1.1075.2.11 raeburn 10180: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 10181: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10182: $path = $1;
10183: } else {
10184: ($path) =
10185: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10186: }
1.1075.2.79 raeburn 10187: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10188: $fileloc = $toplevel;
10189: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10190: my ($udom,$uname,$fname) =
10191: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10192: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10193: } else {
10194: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10195: }
1.1071 raeburn 10196: $fileloc =~ s{^/}{};
10197: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10198: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10199: }
1.987 raeburn 10200: }
1.1075.2.35 raeburn 10201: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10202: $udom = $cdom;
10203: $uname = $cnum;
10204: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10205: $toplevel = $url;
10206: $path = $url;
10207: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10208: $fileloc =~ s{^/}{};
10209: }
10210: foreach my $file (keys(%{$allfiles})) {
10211: my $embed_file;
10212: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10213: $embed_file = $1;
10214: } else {
10215: $embed_file = $file;
10216: }
1.1075.2.55 raeburn 10217: my ($absolutepath,$cleaned_file);
10218: if ($embed_file =~ m{^\w+://}) {
10219: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 10220: $newfiles{$cleaned_file} = 1;
10221: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10222: } else {
1.1075.2.55 raeburn 10223: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10224: if ($embed_file =~ m{^/}) {
10225: $absolutepath = $embed_file;
10226: }
1.1075.2.47 raeburn 10227: if ($cleaned_file =~ m{/}) {
10228: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10229: $path = &check_for_traversal($path,$url,$toplevel);
10230: my $item = $fname;
10231: if ($path ne '') {
10232: $item = $path.'/'.$fname;
10233: $subdependencies{$path}{$fname} = 1;
10234: } else {
10235: $dependencies{$item} = 1;
10236: }
10237: if ($absolutepath) {
10238: $mapping{$item} = $absolutepath;
10239: } else {
10240: $mapping{$item} = $embed_file;
10241: }
10242: } else {
10243: $dependencies{$embed_file} = 1;
10244: if ($absolutepath) {
1.1075.2.47 raeburn 10245: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10246: } else {
1.1075.2.47 raeburn 10247: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10248: }
10249: }
1.984 raeburn 10250: }
10251: }
1.1071 raeburn 10252: my $dirptr = 16384;
1.984 raeburn 10253: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10254: $currsubfile{$path} = {};
1.1075.2.35 raeburn 10255: if (($actionurl eq '/adm/portfolio') ||
10256: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10257: my ($sublistref,$listerror) =
10258: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10259: if (ref($sublistref) eq 'ARRAY') {
10260: foreach my $line (@{$sublistref}) {
10261: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10262: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10263: }
1.984 raeburn 10264: }
1.987 raeburn 10265: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10266: if (opendir(my $dir,$url.'/'.$path)) {
10267: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10268: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10269: }
1.1075.2.11 raeburn 10270: } elsif (($actionurl eq '/adm/dependencies') ||
10271: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10272: ($args->{'context'} eq 'paste')) ||
10273: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10274: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 10275: my $dir;
10276: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10277: $dir = $fileloc;
10278: } else {
10279: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10280: }
1.1071 raeburn 10281: if ($dir ne '') {
10282: my ($sublistref,$listerror) =
10283: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10284: if (ref($sublistref) eq 'ARRAY') {
10285: foreach my $line (@{$sublistref}) {
10286: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10287: undef,$mtime)=split(/\&/,$line,12);
10288: unless (($testdir&$dirptr) ||
10289: ($file_name =~ /^\.\.?$/)) {
10290: $currsubfile{$path}{$file_name} = [$size,$mtime];
10291: }
10292: }
10293: }
10294: }
1.984 raeburn 10295: }
10296: }
10297: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10298: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10299: my $item = $path.'/'.$file;
10300: unless ($mapping{$item} eq $item) {
10301: $pathchanges{$item} = 1;
10302: }
10303: $existing{$item} = 1;
10304: $numexisting ++;
10305: } else {
10306: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10307: }
10308: }
1.1071 raeburn 10309: if ($actionurl eq '/adm/dependencies') {
10310: foreach my $path (keys(%currsubfile)) {
10311: if (ref($currsubfile{$path}) eq 'HASH') {
10312: foreach my $file (keys(%{$currsubfile{$path}})) {
10313: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 10314: next if (($rem ne '') &&
10315: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10316: (ref($navmap) &&
10317: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10318: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10319: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10320: $unused{$path.'/'.$file} = 1;
10321: }
10322: }
10323: }
10324: }
10325: }
1.984 raeburn 10326: }
1.987 raeburn 10327: my %currfile;
1.1075.2.35 raeburn 10328: if (($actionurl eq '/adm/portfolio') ||
10329: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10330: my ($dirlistref,$listerror) =
10331: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10332: if (ref($dirlistref) eq 'ARRAY') {
10333: foreach my $line (@{$dirlistref}) {
10334: my ($file_name,$rest) = split(/\&/,$line,2);
10335: $currfile{$file_name} = 1;
10336: }
1.984 raeburn 10337: }
1.987 raeburn 10338: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10339: if (opendir(my $dir,$url)) {
1.987 raeburn 10340: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10341: map {$currfile{$_} = 1;} @dir_list;
10342: }
1.1075.2.11 raeburn 10343: } elsif (($actionurl eq '/adm/dependencies') ||
10344: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10345: ($args->{'context'} eq 'paste')) ||
10346: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10347: if ($env{'request.course.id'} ne '') {
10348: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10349: if ($dir ne '') {
10350: my ($dirlistref,$listerror) =
10351: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10352: if (ref($dirlistref) eq 'ARRAY') {
10353: foreach my $line (@{$dirlistref}) {
10354: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10355: $size,undef,$mtime)=split(/\&/,$line,12);
10356: unless (($testdir&$dirptr) ||
10357: ($file_name =~ /^\.\.?$/)) {
10358: $currfile{$file_name} = [$size,$mtime];
10359: }
10360: }
10361: }
10362: }
10363: }
1.984 raeburn 10364: }
10365: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10366: if (exists($currfile{$file})) {
1.987 raeburn 10367: unless ($mapping{$file} eq $file) {
10368: $pathchanges{$file} = 1;
10369: }
10370: $existing{$file} = 1;
10371: $numexisting ++;
10372: } else {
1.984 raeburn 10373: $newfiles{$file} = 1;
10374: }
10375: }
1.1071 raeburn 10376: foreach my $file (keys(%currfile)) {
10377: unless (($file eq $filename) ||
10378: ($file eq $filename.'.bak') ||
10379: ($dependencies{$file})) {
1.1075.2.11 raeburn 10380: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 10381: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10382: next if (($rem ne '') &&
10383: (($env{"httpref.$rem".$file} ne '') ||
10384: (ref($navmap) &&
10385: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10386: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10387: ($navmap->getResourceByUrl($rem.$1)))))));
10388: }
1.1075.2.11 raeburn 10389: }
1.1071 raeburn 10390: $unused{$file} = 1;
10391: }
10392: }
1.1075.2.11 raeburn 10393: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10394: ($args->{'context'} eq 'paste')) {
10395: $counter = scalar(keys(%existing));
10396: $numpathchg = scalar(keys(%pathchanges));
10397: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 10398: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10399: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10400: $counter = scalar(keys(%existing));
10401: $numpathchg = scalar(keys(%pathchanges));
10402: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 10403: }
1.984 raeburn 10404: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10405: if ($actionurl eq '/adm/dependencies') {
10406: next if ($embed_file =~ m{^\w+://});
10407: }
1.660 raeburn 10408: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10409: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10410: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10411: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 10412: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10413: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10414: }
1.1075.2.35 raeburn 10415: $upload_output .= '</td>';
1.1071 raeburn 10416: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 10417: $upload_output.='<td align="right">'.
10418: '<span class="LC_info LC_fontsize_medium">'.
10419: &mt("URL points to web address").'</span>';
1.987 raeburn 10420: $numremref++;
1.660 raeburn 10421: } elsif ($args->{'error_on_invalid_names'}
10422: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 10423: $upload_output.='<td align="right"><span class="LC_warning">'.
10424: &mt('Invalid characters').'</span>';
1.987 raeburn 10425: $numinvalid++;
1.660 raeburn 10426: } else {
1.1075.2.35 raeburn 10427: $upload_output .= '<td>'.
10428: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10429: $embed_file,\%mapping,
1.1071 raeburn 10430: $allfiles,$codebase,'upload');
10431: $counter ++;
10432: $numnew ++;
1.987 raeburn 10433: }
10434: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10435: }
10436: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10437: if ($actionurl eq '/adm/dependencies') {
10438: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10439: $modify_output .= &start_data_table_row().
10440: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10441: '<img src="'.&icon($embed_file).'" border="0" />'.
10442: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10443: '<td>'.$size.'</td>'.
10444: '<td>'.$mtime.'</td>'.
10445: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10446: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10447: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10448: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10449: &embedded_file_element('upload_embedded',$counter,
10450: $embed_file,\%mapping,
10451: $allfiles,$codebase,'modify').
10452: '</div></td>'.
10453: &end_data_table_row()."\n";
10454: $counter ++;
10455: } else {
10456: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10457: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10458: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10459: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10460: &Apache::loncommon::end_data_table_row()."\n";
10461: }
10462: }
10463: my $delidx = $counter;
10464: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10465: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10466: $delete_output .= &start_data_table_row().
10467: '<td><img src="'.&icon($oldfile).'" />'.
10468: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10469: '<td>'.$size.'</td>'.
10470: '<td>'.$mtime.'</td>'.
10471: '<td><label><input type="checkbox" name="del_upload_dep" '.
10472: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10473: &embedded_file_element('upload_embedded',$delidx,
10474: $oldfile,\%mapping,$allfiles,
10475: $codebase,'delete').'</td>'.
10476: &end_data_table_row()."\n";
10477: $numunused ++;
10478: $delidx ++;
1.987 raeburn 10479: }
10480: if ($upload_output) {
10481: $upload_output = &start_data_table().
10482: $upload_output.
10483: &end_data_table()."\n";
10484: }
1.1071 raeburn 10485: if ($modify_output) {
10486: $modify_output = &start_data_table().
10487: &start_data_table_header_row().
10488: '<th>'.&mt('File').'</th>'.
10489: '<th>'.&mt('Size (KB)').'</th>'.
10490: '<th>'.&mt('Modified').'</th>'.
10491: '<th>'.&mt('Upload replacement?').'</th>'.
10492: &end_data_table_header_row().
10493: $modify_output.
10494: &end_data_table()."\n";
10495: }
10496: if ($delete_output) {
10497: $delete_output = &start_data_table().
10498: &start_data_table_header_row().
10499: '<th>'.&mt('File').'</th>'.
10500: '<th>'.&mt('Size (KB)').'</th>'.
10501: '<th>'.&mt('Modified').'</th>'.
10502: '<th>'.&mt('Delete?').'</th>'.
10503: &end_data_table_header_row().
10504: $delete_output.
10505: &end_data_table()."\n";
10506: }
1.987 raeburn 10507: my $applies = 0;
10508: if ($numremref) {
10509: $applies ++;
10510: }
10511: if ($numinvalid) {
10512: $applies ++;
10513: }
10514: if ($numexisting) {
10515: $applies ++;
10516: }
1.1071 raeburn 10517: if ($counter || $numunused) {
1.987 raeburn 10518: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10519: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10520: $state.'<h3>'.$heading.'</h3>';
10521: if ($actionurl eq '/adm/dependencies') {
10522: if ($numnew) {
10523: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10524: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10525: $upload_output.'<br />'."\n";
10526: }
10527: if ($numexisting) {
10528: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10529: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10530: $modify_output.'<br />'."\n";
10531: $buttontext = &mt('Save changes');
10532: }
10533: if ($numunused) {
10534: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10535: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10536: $delete_output.'<br />'."\n";
10537: $buttontext = &mt('Save changes');
10538: }
10539: } else {
10540: $output .= $upload_output.'<br />'."\n";
10541: }
10542: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10543: $counter.'" />'."\n";
10544: if ($actionurl eq '/adm/dependencies') {
10545: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10546: $numnew.'" />'."\n";
10547: } elsif ($actionurl eq '') {
1.987 raeburn 10548: $output .= '<input type="hidden" name="phase" value="three" />';
10549: }
10550: } elsif ($applies) {
10551: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10552: if ($applies > 1) {
10553: $output .=
1.1075.2.35 raeburn 10554: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10555: if ($numremref) {
10556: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10557: }
10558: if ($numinvalid) {
10559: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10560: }
10561: if ($numexisting) {
10562: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10563: }
10564: $output .= '</ul><br />';
10565: } elsif ($numremref) {
10566: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10567: } elsif ($numinvalid) {
10568: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10569: } elsif ($numexisting) {
10570: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10571: }
10572: $output .= $upload_output.'<br />';
10573: }
10574: my ($pathchange_output,$chgcount);
1.1071 raeburn 10575: $chgcount = $counter;
1.987 raeburn 10576: if (keys(%pathchanges) > 0) {
10577: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10578: if ($counter) {
1.987 raeburn 10579: $output .= &embedded_file_element('pathchange',$chgcount,
10580: $embed_file,\%mapping,
1.1071 raeburn 10581: $allfiles,$codebase,'change');
1.987 raeburn 10582: } else {
10583: $pathchange_output .=
10584: &start_data_table_row().
10585: '<td><input type ="checkbox" name="namechange" value="'.
10586: $chgcount.'" checked="checked" /></td>'.
10587: '<td>'.$mapping{$embed_file}.'</td>'.
10588: '<td>'.$embed_file.
10589: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10590: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10591: '</td>'.&end_data_table_row();
1.660 raeburn 10592: }
1.987 raeburn 10593: $numpathchg ++;
10594: $chgcount ++;
1.660 raeburn 10595: }
10596: }
1.1075.2.35 raeburn 10597: if (($counter) || ($numunused)) {
1.987 raeburn 10598: if ($numpathchg) {
10599: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10600: $numpathchg.'" />'."\n";
10601: }
10602: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10603: ($actionurl eq '/adm/imsimport')) {
10604: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10605: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10606: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10607: } elsif ($actionurl eq '/adm/dependencies') {
10608: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10609: }
1.1075.2.35 raeburn 10610: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10611: } elsif ($numpathchg) {
10612: my %pathchange = ();
10613: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10614: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10615: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 10616: }
1.987 raeburn 10617: }
1.1071 raeburn 10618: return ($output,$counter,$numpathchg);
1.987 raeburn 10619: }
10620:
1.1075.2.47 raeburn 10621: =pod
10622:
10623: =item * clean_path($name)
10624:
10625: Performs clean-up of directories, subdirectories and filename in an
10626: embedded object, referenced in an HTML file which is being uploaded
10627: to a course or portfolio, where
10628: "Upload embedded images/multimedia files if HTML file" checkbox was
10629: checked.
10630:
10631: Clean-up is similar to replacements in lonnet::clean_filename()
10632: except each / between sub-directory and next level is preserved.
10633:
10634: =cut
10635:
10636: sub clean_path {
10637: my ($embed_file) = @_;
10638: $embed_file =~s{^/+}{};
10639: my @contents;
10640: if ($embed_file =~ m{/}) {
10641: @contents = split(/\//,$embed_file);
10642: } else {
10643: @contents = ($embed_file);
10644: }
10645: my $lastidx = scalar(@contents)-1;
10646: for (my $i=0; $i<=$lastidx; $i++) {
10647: $contents[$i]=~s{\\}{/}g;
10648: $contents[$i]=~s/\s+/\_/g;
10649: $contents[$i]=~s{[^/\w\.\-]}{}g;
10650: if ($i == $lastidx) {
10651: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10652: }
10653: }
10654: if ($lastidx > 0) {
10655: return join('/',@contents);
10656: } else {
10657: return $contents[0];
10658: }
10659: }
10660:
1.987 raeburn 10661: sub embedded_file_element {
1.1071 raeburn 10662: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10663: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10664: (ref($codebase) eq 'HASH'));
10665: my $output;
1.1071 raeburn 10666: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10667: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10668: }
10669: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10670: &escape($embed_file).'" />';
10671: unless (($context eq 'upload_embedded') &&
10672: ($mapping->{$embed_file} eq $embed_file)) {
10673: $output .='
10674: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10675: }
10676: my $attrib;
10677: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10678: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10679: }
10680: $output .=
10681: "\n\t\t".
10682: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10683: $attrib.'" />';
10684: if (exists($codebase->{$mapping->{$embed_file}})) {
10685: $output .=
10686: "\n\t\t".
10687: '<input name="codebase_'.$num.'" type="hidden" value="'.
10688: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10689: }
1.987 raeburn 10690: return $output;
1.660 raeburn 10691: }
10692:
1.1071 raeburn 10693: sub get_dependency_details {
10694: my ($currfile,$currsubfile,$embed_file) = @_;
10695: my ($size,$mtime,$showsize,$showmtime);
10696: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10697: if ($embed_file =~ m{/}) {
10698: my ($path,$fname) = split(/\//,$embed_file);
10699: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10700: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10701: }
10702: } else {
10703: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10704: ($size,$mtime) = @{$currfile->{$embed_file}};
10705: }
10706: }
10707: $showsize = $size/1024.0;
10708: $showsize = sprintf("%.1f",$showsize);
10709: if ($mtime > 0) {
10710: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10711: }
10712: }
10713: return ($showsize,$showmtime);
10714: }
10715:
10716: sub ask_embedded_js {
10717: return <<"END";
10718: <script type="text/javascript"">
10719: // <![CDATA[
10720: function toggleBrowse(counter) {
10721: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10722: var fileid = document.getElementById('embedded_item_'+counter);
10723: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10724: if (chkboxid.checked == true) {
10725: uploaddivid.style.display='block';
10726: } else {
10727: uploaddivid.style.display='none';
10728: fileid.value = '';
10729: }
10730: }
10731: // ]]>
10732: </script>
10733:
10734: END
10735: }
10736:
1.661 raeburn 10737: sub upload_embedded {
10738: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10739: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10740: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10741: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10742: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10743: my $orig_uploaded_filename =
10744: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10745: foreach my $type ('orig','ref','attrib','codebase') {
10746: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10747: $env{'form.embedded_'.$type.'_'.$i} =
10748: &unescape($env{'form.embedded_'.$type.'_'.$i});
10749: }
10750: }
1.661 raeburn 10751: my ($path,$fname) =
10752: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10753: # no path, whole string is fname
10754: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10755: $fname = &Apache::lonnet::clean_filename($fname);
10756: # See if there is anything left
10757: next if ($fname eq '');
10758:
10759: # Check if file already exists as a file or directory.
10760: my ($state,$msg);
10761: if ($context eq 'portfolio') {
10762: my $port_path = $dirpath;
10763: if ($group ne '') {
10764: $port_path = "groups/$group/$port_path";
10765: }
1.987 raeburn 10766: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10767: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10768: $dir_root,$port_path,$disk_quota,
10769: $current_disk_usage,$uname,$udom);
10770: if ($state eq 'will_exceed_quota'
1.984 raeburn 10771: || $state eq 'file_locked') {
1.661 raeburn 10772: $output .= $msg;
10773: next;
10774: }
10775: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10776: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10777: if ($state eq 'exists') {
10778: $output .= $msg;
10779: next;
10780: }
10781: }
10782: # Check if extension is valid
10783: if (($fname =~ /\.(\w+)$/) &&
10784: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 10785: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10786: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10787: next;
10788: } elsif (($fname =~ /\.(\w+)$/) &&
10789: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10790: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10791: next;
10792: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 10793: $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 10794: next;
10795: }
10796: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 10797: my $subdir = $path;
10798: $subdir =~ s{/+$}{};
1.661 raeburn 10799: if ($context eq 'portfolio') {
1.984 raeburn 10800: my $result;
10801: if ($state eq 'existingfile') {
10802: $result=
10803: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 10804: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10805: } else {
1.984 raeburn 10806: $result=
10807: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10808: $dirpath.
1.1075.2.35 raeburn 10809: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10810: if ($result !~ m|^/uploaded/|) {
10811: $output .= '<span class="LC_error">'
10812: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10813: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10814: .'</span><br />';
10815: next;
10816: } else {
1.987 raeburn 10817: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10818: $path.$fname.'</span>').'<br />';
1.984 raeburn 10819: }
1.661 raeburn 10820: }
1.1075.2.35 raeburn 10821: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
10822: my $extendedsubdir = $dirpath.'/'.$subdir;
10823: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10824: my $result =
1.1075.2.35 raeburn 10825: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10826: if ($result !~ m|^/uploaded/|) {
10827: $output .= '<span class="LC_error">'
10828: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10829: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10830: .'</span><br />';
10831: next;
10832: } else {
10833: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10834: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 10835: if ($context eq 'syllabus') {
10836: &Apache::lonnet::make_public_indefinitely($result);
10837: }
1.987 raeburn 10838: }
1.661 raeburn 10839: } else {
10840: # Save the file
10841: my $target = $env{'form.embedded_item_'.$i};
10842: my $fullpath = $dir_root.$dirpath.'/'.$path;
10843: my $dest = $fullpath.$fname;
10844: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10845: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10846: my $count;
10847: my $filepath = $dir_root;
1.1027 raeburn 10848: foreach my $subdir (@parts) {
10849: $filepath .= "/$subdir";
10850: if (!-e $filepath) {
1.661 raeburn 10851: mkdir($filepath,0770);
10852: }
10853: }
10854: my $fh;
10855: if (!open($fh,'>'.$dest)) {
10856: &Apache::lonnet::logthis('Failed to create '.$dest);
10857: $output .= '<span class="LC_error">'.
1.1071 raeburn 10858: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10859: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10860: '</span><br />';
10861: } else {
10862: if (!print $fh $env{'form.embedded_item_'.$i}) {
10863: &Apache::lonnet::logthis('Failed to write to '.$dest);
10864: $output .= '<span class="LC_error">'.
1.1071 raeburn 10865: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10866: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10867: '</span><br />';
10868: } else {
1.987 raeburn 10869: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10870: $url.'</span>').'<br />';
10871: unless ($context eq 'testbank') {
10872: $footer .= &mt('View embedded file: [_1]',
10873: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10874: }
10875: }
10876: close($fh);
10877: }
10878: }
10879: if ($env{'form.embedded_ref_'.$i}) {
10880: $pathchange{$i} = 1;
10881: }
10882: }
10883: if ($output) {
10884: $output = '<p>'.$output.'</p>';
10885: }
10886: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10887: $returnflag = 'ok';
1.1071 raeburn 10888: my $numpathchgs = scalar(keys(%pathchange));
10889: if ($numpathchgs > 0) {
1.987 raeburn 10890: if ($context eq 'portfolio') {
10891: $output .= '<p>'.&mt('or').'</p>';
10892: } elsif ($context eq 'testbank') {
1.1071 raeburn 10893: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10894: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10895: $returnflag = 'modify_orightml';
10896: }
10897: }
1.1071 raeburn 10898: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10899: }
10900:
10901: sub modify_html_form {
10902: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10903: my $end = 0;
10904: my $modifyform;
10905: if ($context eq 'upload_embedded') {
10906: return unless (ref($pathchange) eq 'HASH');
10907: if ($env{'form.number_embedded_items'}) {
10908: $end += $env{'form.number_embedded_items'};
10909: }
10910: if ($env{'form.number_pathchange_items'}) {
10911: $end += $env{'form.number_pathchange_items'};
10912: }
10913: if ($end) {
10914: for (my $i=0; $i<$end; $i++) {
10915: if ($i < $env{'form.number_embedded_items'}) {
10916: next unless($pathchange->{$i});
10917: }
10918: $modifyform .=
10919: &start_data_table_row().
10920: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10921: 'checked="checked" /></td>'.
10922: '<td>'.$env{'form.embedded_ref_'.$i}.
10923: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10924: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10925: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10926: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10927: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10928: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10929: '<td>'.$env{'form.embedded_orig_'.$i}.
10930: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10931: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10932: &end_data_table_row();
1.1071 raeburn 10933: }
1.987 raeburn 10934: }
10935: } else {
10936: $modifyform = $pathchgtable;
10937: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10938: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10939: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10940: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10941: }
10942: }
10943: if ($modifyform) {
1.1071 raeburn 10944: if ($actionurl eq '/adm/dependencies') {
10945: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10946: }
1.987 raeburn 10947: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10948: '<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".
10949: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10950: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10951: '</ol></p>'."\n".'<p>'.
10952: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10953: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10954: &start_data_table()."\n".
10955: &start_data_table_header_row().
10956: '<th>'.&mt('Change?').'</th>'.
10957: '<th>'.&mt('Current reference').'</th>'.
10958: '<th>'.&mt('Required reference').'</th>'.
10959: &end_data_table_header_row()."\n".
10960: $modifyform.
10961: &end_data_table().'<br />'."\n".$hiddenstate.
10962: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10963: '</form>'."\n";
10964: }
10965: return;
10966: }
10967:
10968: sub modify_html_refs {
1.1075.2.35 raeburn 10969: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10970: my $container;
10971: if ($context eq 'portfolio') {
10972: $container = $env{'form.container'};
10973: } elsif ($context eq 'coursedoc') {
10974: $container = $env{'form.primaryurl'};
1.1071 raeburn 10975: } elsif ($context eq 'manage_dependencies') {
10976: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10977: $container = "/$container";
1.1075.2.35 raeburn 10978: } elsif ($context eq 'syllabus') {
10979: $container = $url;
1.987 raeburn 10980: } else {
1.1027 raeburn 10981: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10982: }
10983: my (%allfiles,%codebase,$output,$content);
10984: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 10985: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10986: if (wantarray) {
10987: return ('',0,0);
10988: } else {
10989: return;
10990: }
10991: }
10992: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 10993: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10994: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10995: if (wantarray) {
10996: return ('',0,0);
10997: } else {
10998: return;
10999: }
11000: }
1.987 raeburn 11001: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11002: if ($content eq '-1') {
11003: if (wantarray) {
11004: return ('',0,0);
11005: } else {
11006: return;
11007: }
11008: }
1.987 raeburn 11009: } else {
1.1071 raeburn 11010: unless ($container =~ /^\Q$dir_root\E/) {
11011: if (wantarray) {
11012: return ('',0,0);
11013: } else {
11014: return;
11015: }
11016: }
1.987 raeburn 11017: if (open(my $fh,"<$container")) {
11018: $content = join('', <$fh>);
11019: close($fh);
11020: } else {
1.1071 raeburn 11021: if (wantarray) {
11022: return ('',0,0);
11023: } else {
11024: return;
11025: }
1.987 raeburn 11026: }
11027: }
11028: my ($count,$codebasecount) = (0,0);
11029: my $mm = new File::MMagic;
11030: my $mime_type = $mm->checktype_contents($content);
11031: if ($mime_type eq 'text/html') {
11032: my $parse_result =
11033: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11034: \%codebase,\$content);
11035: if ($parse_result eq 'ok') {
11036: foreach my $i (@changes) {
11037: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11038: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11039: if ($allfiles{$ref}) {
11040: my $newname = $orig;
11041: my ($attrib_regexp,$codebase);
1.1006 raeburn 11042: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11043: if ($attrib_regexp =~ /:/) {
11044: $attrib_regexp =~ s/\:/|/g;
11045: }
11046: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11047: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11048: $count += $numchg;
1.1075.2.35 raeburn 11049: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 11050: delete($allfiles{$ref});
1.987 raeburn 11051: }
11052: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11053: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11054: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11055: $codebasecount ++;
11056: }
11057: }
11058: }
1.1075.2.35 raeburn 11059: my $skiprewrites;
1.987 raeburn 11060: if ($count || $codebasecount) {
11061: my $saveresult;
1.1071 raeburn 11062: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 11063: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11064: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11065: if ($url eq $container) {
11066: my ($fname) = ($container =~ m{/([^/]+)$});
11067: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11068: $count,'<span class="LC_filename">'.
1.1071 raeburn 11069: $fname.'</span>').'</p>';
1.987 raeburn 11070: } else {
11071: $output = '<p class="LC_error">'.
11072: &mt('Error: update failed for: [_1].',
11073: '<span class="LC_filename">'.
11074: $container.'</span>').'</p>';
11075: }
1.1075.2.35 raeburn 11076: if ($context eq 'syllabus') {
11077: unless ($saveresult eq 'ok') {
11078: $skiprewrites = 1;
11079: }
11080: }
1.987 raeburn 11081: } else {
11082: if (open(my $fh,">$container")) {
11083: print $fh $content;
11084: close($fh);
11085: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11086: $count,'<span class="LC_filename">'.
11087: $container.'</span>').'</p>';
1.661 raeburn 11088: } else {
1.987 raeburn 11089: $output = '<p class="LC_error">'.
11090: &mt('Error: could not update [_1].',
11091: '<span class="LC_filename">'.
11092: $container.'</span>').'</p>';
1.661 raeburn 11093: }
11094: }
11095: }
1.1075.2.35 raeburn 11096: if (($context eq 'syllabus') && (!$skiprewrites)) {
11097: my ($actionurl,$state);
11098: $actionurl = "/public/$udom/$uname/syllabus";
11099: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11100: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11101: \%codebase,
11102: {'context' => 'rewrites',
11103: 'ignore_remote_references' => 1,});
11104: if (ref($mapping) eq 'HASH') {
11105: my $rewrites = 0;
11106: foreach my $key (keys(%{$mapping})) {
11107: next if ($key =~ m{^https?://});
11108: my $ref = $mapping->{$key};
11109: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11110: my $attrib;
11111: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11112: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11113: }
11114: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11115: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11116: $rewrites += $numchg;
11117: }
11118: }
11119: if ($rewrites) {
11120: my $saveresult;
11121: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11122: if ($url eq $container) {
11123: my ($fname) = ($container =~ m{/([^/]+)$});
11124: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11125: $count,'<span class="LC_filename">'.
11126: $fname.'</span>').'</p>';
11127: } else {
11128: $output .= '<p class="LC_error">'.
11129: &mt('Error: could not update links in [_1].',
11130: '<span class="LC_filename">'.
11131: $container.'</span>').'</p>';
11132:
11133: }
11134: }
11135: }
11136: }
1.987 raeburn 11137: } else {
11138: &logthis('Failed to parse '.$container.
11139: ' to modify references: '.$parse_result);
1.661 raeburn 11140: }
11141: }
1.1071 raeburn 11142: if (wantarray) {
11143: return ($output,$count,$codebasecount);
11144: } else {
11145: return $output;
11146: }
1.661 raeburn 11147: }
11148:
11149: sub check_for_existing {
11150: my ($path,$fname,$element) = @_;
11151: my ($state,$msg);
11152: if (-d $path.'/'.$fname) {
11153: $state = 'exists';
11154: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11155: } elsif (-e $path.'/'.$fname) {
11156: $state = 'exists';
11157: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11158: }
11159: if ($state eq 'exists') {
11160: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11161: }
11162: return ($state,$msg);
11163: }
11164:
11165: sub check_for_upload {
11166: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11167: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11168: my $filesize = length($env{'form.'.$element});
11169: if (!$filesize) {
11170: my $msg = '<span class="LC_error">'.
11171: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11172: '<span class="LC_filename">'.$fname.'</span>',
11173: $filesize).'<br />'.
1.1007 raeburn 11174: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11175: '</span>';
11176: return ('zero_bytes',$msg);
11177: }
11178: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11179: my $getpropath = 1;
1.1021 raeburn 11180: my ($dirlistref,$listerror) =
11181: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11182: my $found_file = 0;
11183: my $locked_file = 0;
1.991 raeburn 11184: my @lockers;
11185: my $navmap;
11186: if ($env{'request.course.id'}) {
11187: $navmap = Apache::lonnavmaps::navmap->new();
11188: }
1.1021 raeburn 11189: if (ref($dirlistref) eq 'ARRAY') {
11190: foreach my $line (@{$dirlistref}) {
11191: my ($file_name,$rest)=split(/\&/,$line,2);
11192: if ($file_name eq $fname){
11193: $file_name = $path.$file_name;
11194: if ($group ne '') {
11195: $file_name = $group.$file_name;
11196: }
11197: $found_file = 1;
11198: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11199: foreach my $lock (@lockers) {
11200: if (ref($lock) eq 'ARRAY') {
11201: my ($symb,$crsid) = @{$lock};
11202: if ($crsid eq $env{'request.course.id'}) {
11203: if (ref($navmap)) {
11204: my $res = $navmap->getBySymb($symb);
11205: foreach my $part (@{$res->parts()}) {
11206: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11207: unless (($slot_status == $res->RESERVED) ||
11208: ($slot_status == $res->RESERVED_LOCATION)) {
11209: $locked_file = 1;
11210: }
1.991 raeburn 11211: }
1.1021 raeburn 11212: } else {
11213: $locked_file = 1;
1.991 raeburn 11214: }
11215: } else {
11216: $locked_file = 1;
11217: }
11218: }
1.1021 raeburn 11219: }
11220: } else {
11221: my @info = split(/\&/,$rest);
11222: my $currsize = $info[6]/1000;
11223: if ($currsize < $filesize) {
11224: my $extra = $filesize - $currsize;
11225: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 11226: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11227: &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 11228: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11229: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11230: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11231: return ('will_exceed_quota',$msg);
11232: }
1.984 raeburn 11233: }
11234: }
1.661 raeburn 11235: }
11236: }
11237: }
11238: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 11239: my $msg = '<p class="LC_warning">'.
11240: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
11241: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11242: return ('will_exceed_quota',$msg);
11243: } elsif ($found_file) {
11244: if ($locked_file) {
1.1075.2.69 raeburn 11245: my $msg = '<p class="LC_warning">';
1.661 raeburn 11246: $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 11247: $msg .= '</p>';
1.661 raeburn 11248: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11249: return ('file_locked',$msg);
11250: } else {
1.1075.2.69 raeburn 11251: my $msg = '<p class="LC_error">';
1.984 raeburn 11252: $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 11253: $msg .= '</p>';
1.984 raeburn 11254: return ('existingfile',$msg);
1.661 raeburn 11255: }
11256: }
11257: }
11258:
1.987 raeburn 11259: sub check_for_traversal {
11260: my ($path,$url,$toplevel) = @_;
11261: my @parts=split(/\//,$path);
11262: my $cleanpath;
11263: my $fullpath = $url;
11264: for (my $i=0;$i<@parts;$i++) {
11265: next if ($parts[$i] eq '.');
11266: if ($parts[$i] eq '..') {
11267: $fullpath =~ s{([^/]+/)$}{};
11268: } else {
11269: $fullpath .= $parts[$i].'/';
11270: }
11271: }
11272: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11273: $cleanpath = $1;
11274: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11275: my $curr_toprel = $1;
11276: my @parts = split(/\//,$curr_toprel);
11277: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11278: my @urlparts = split(/\//,$url_toprel);
11279: my $doubledots;
11280: my $startdiff = -1;
11281: for (my $i=0; $i<@urlparts; $i++) {
11282: if ($startdiff == -1) {
11283: unless ($urlparts[$i] eq $parts[$i]) {
11284: $startdiff = $i;
11285: $doubledots .= '../';
11286: }
11287: } else {
11288: $doubledots .= '../';
11289: }
11290: }
11291: if ($startdiff > -1) {
11292: $cleanpath = $doubledots;
11293: for (my $i=$startdiff; $i<@parts; $i++) {
11294: $cleanpath .= $parts[$i].'/';
11295: }
11296: }
11297: }
11298: $cleanpath =~ s{(/)$}{};
11299: return $cleanpath;
11300: }
1.31 albertel 11301:
1.1053 raeburn 11302: sub is_archive_file {
11303: my ($mimetype) = @_;
11304: if (($mimetype eq 'application/octet-stream') ||
11305: ($mimetype eq 'application/x-stuffit') ||
11306: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11307: return 1;
11308: }
11309: return;
11310: }
11311:
11312: sub decompress_form {
1.1065 raeburn 11313: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11314: my %lt = &Apache::lonlocal::texthash (
11315: this => 'This file is an archive file.',
1.1067 raeburn 11316: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11317: itsc => 'Its contents are as follows:',
1.1053 raeburn 11318: youm => 'You may wish to extract its contents.',
11319: extr => 'Extract contents',
1.1067 raeburn 11320: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11321: proa => 'Process automatically?',
1.1053 raeburn 11322: yes => 'Yes',
11323: no => 'No',
1.1067 raeburn 11324: fold => 'Title for folder containing movie',
11325: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11326: );
1.1065 raeburn 11327: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11328: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11329: my $info = &list_archive_contents($fileloc,\@paths);
11330: if (@paths) {
11331: foreach my $path (@paths) {
11332: $path =~ s{^/}{};
1.1067 raeburn 11333: if ($path =~ m{^([^/]+)/$}) {
11334: $topdir = $1;
11335: }
1.1065 raeburn 11336: if ($path =~ m{^([^/]+)/}) {
11337: $toplevel{$1} = $path;
11338: } else {
11339: $toplevel{$path} = $path;
11340: }
11341: }
11342: }
1.1067 raeburn 11343: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 11344: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11345: "$topdir/media/",
11346: "$topdir/media/$topdir.mp4",
11347: "$topdir/media/FirstFrame.png",
11348: "$topdir/media/player.swf",
11349: "$topdir/media/swfobject.js",
11350: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 11351: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 11352: "$topdir/$topdir.mp4",
11353: "$topdir/$topdir\_config.xml",
11354: "$topdir/$topdir\_controller.swf",
11355: "$topdir/$topdir\_embed.css",
11356: "$topdir/$topdir\_First_Frame.png",
11357: "$topdir/$topdir\_player.html",
11358: "$topdir/$topdir\_Thumbnails.png",
11359: "$topdir/playerProductInstall.swf",
11360: "$topdir/scripts/",
11361: "$topdir/scripts/config_xml.js",
11362: "$topdir/scripts/handlebars.js",
11363: "$topdir/scripts/jquery-1.7.1.min.js",
11364: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11365: "$topdir/scripts/modernizr.js",
11366: "$topdir/scripts/player-min.js",
11367: "$topdir/scripts/swfobject.js",
11368: "$topdir/skins/",
11369: "$topdir/skins/configuration_express.xml",
11370: "$topdir/skins/express_show/",
11371: "$topdir/skins/express_show/player-min.css",
11372: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 11373: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11374: "$topdir/$topdir.mp4",
11375: "$topdir/$topdir\_config.xml",
11376: "$topdir/$topdir\_controller.swf",
11377: "$topdir/$topdir\_embed.css",
11378: "$topdir/$topdir\_First_Frame.png",
11379: "$topdir/$topdir\_player.html",
11380: "$topdir/$topdir\_Thumbnails.png",
11381: "$topdir/playerProductInstall.swf",
11382: "$topdir/scripts/",
11383: "$topdir/scripts/config_xml.js",
11384: "$topdir/scripts/techsmith-smart-player.min.js",
11385: "$topdir/skins/",
11386: "$topdir/skins/configuration_express.xml",
11387: "$topdir/skins/express_show/",
11388: "$topdir/skins/express_show/spritesheet.min.css",
11389: "$topdir/skins/express_show/spritesheet.png",
11390: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 11391: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11392: if (@diffs == 0) {
1.1075.2.59 raeburn 11393: $is_camtasia = 6;
11394: } else {
1.1075.2.81 raeburn 11395: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 11396: if (@diffs == 0) {
11397: $is_camtasia = 8;
1.1075.2.81 raeburn 11398: } else {
11399: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11400: if (@diffs == 0) {
11401: $is_camtasia = 8;
11402: }
1.1075.2.59 raeburn 11403: }
1.1067 raeburn 11404: }
11405: }
11406: my $output;
11407: if ($is_camtasia) {
11408: $output = <<"ENDCAM";
11409: <script type="text/javascript" language="Javascript">
11410: // <![CDATA[
11411:
11412: function camtasiaToggle() {
11413: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11414: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 11415: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11416: document.getElementById('camtasia_titles').style.display='block';
11417: } else {
11418: document.getElementById('camtasia_titles').style.display='none';
11419: }
11420: }
11421: }
11422: return;
11423: }
11424:
11425: // ]]>
11426: </script>
11427: <p>$lt{'camt'}</p>
11428: ENDCAM
1.1065 raeburn 11429: } else {
1.1067 raeburn 11430: $output = '<p>'.$lt{'this'};
11431: if ($info eq '') {
11432: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11433: } else {
11434: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11435: '<div><pre>'.$info.'</pre></div>';
11436: }
1.1065 raeburn 11437: }
1.1067 raeburn 11438: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11439: my $duplicates;
11440: my $num = 0;
11441: if (ref($dirlist) eq 'ARRAY') {
11442: foreach my $item (@{$dirlist}) {
11443: if (ref($item) eq 'ARRAY') {
11444: if (exists($toplevel{$item->[0]})) {
11445: $duplicates .=
11446: &start_data_table_row().
11447: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11448: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11449: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11450: 'value="1" />'.&mt('Yes').'</label>'.
11451: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11452: '<td>'.$item->[0].'</td>';
11453: if ($item->[2]) {
11454: $duplicates .= '<td>'.&mt('Directory').'</td>';
11455: } else {
11456: $duplicates .= '<td>'.&mt('File').'</td>';
11457: }
11458: $duplicates .= '<td>'.$item->[3].'</td>'.
11459: '<td>'.
11460: &Apache::lonlocal::locallocaltime($item->[4]).
11461: '</td>'.
11462: &end_data_table_row();
11463: $num ++;
11464: }
11465: }
11466: }
11467: }
11468: my $itemcount;
11469: if (@paths > 0) {
11470: $itemcount = scalar(@paths);
11471: } else {
11472: $itemcount = 1;
11473: }
1.1067 raeburn 11474: if ($is_camtasia) {
11475: $output .= $lt{'auto'}.'<br />'.
11476: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 11477: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11478: $lt{'yes'}.'</label> <label>'.
11479: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11480: $lt{'no'}.'</label></span><br />'.
11481: '<div id="camtasia_titles" style="display:block">'.
11482: &Apache::lonhtmlcommon::start_pick_box().
11483: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11484: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11485: &Apache::lonhtmlcommon::row_closure().
11486: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11487: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11488: &Apache::lonhtmlcommon::row_closure(1).
11489: &Apache::lonhtmlcommon::end_pick_box().
11490: '</div>';
11491: }
1.1065 raeburn 11492: $output .=
11493: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11494: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11495: "\n";
1.1065 raeburn 11496: if ($duplicates ne '') {
11497: $output .= '<p><span class="LC_warning">'.
11498: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11499: &start_data_table().
11500: &start_data_table_header_row().
11501: '<th>'.&mt('Overwrite?').'</th>'.
11502: '<th>'.&mt('Name').'</th>'.
11503: '<th>'.&mt('Type').'</th>'.
11504: '<th>'.&mt('Size').'</th>'.
11505: '<th>'.&mt('Last modified').'</th>'.
11506: &end_data_table_header_row().
11507: $duplicates.
11508: &end_data_table().
11509: '</p>';
11510: }
1.1067 raeburn 11511: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11512: if (ref($hiddenelements) eq 'HASH') {
11513: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11514: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11515: }
11516: }
11517: $output .= <<"END";
1.1067 raeburn 11518: <br />
1.1053 raeburn 11519: <input type="submit" name="decompress" value="$lt{'extr'}" />
11520: </form>
11521: $noextract
11522: END
11523: return $output;
11524: }
11525:
1.1065 raeburn 11526: sub decompression_utility {
11527: my ($program) = @_;
11528: my @utilities = ('tar','gunzip','bunzip2','unzip');
11529: my $location;
11530: if (grep(/^\Q$program\E$/,@utilities)) {
11531: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11532: '/usr/sbin/') {
11533: if (-x $dir.$program) {
11534: $location = $dir.$program;
11535: last;
11536: }
11537: }
11538: }
11539: return $location;
11540: }
11541:
11542: sub list_archive_contents {
11543: my ($file,$pathsref) = @_;
11544: my (@cmd,$output);
11545: my $needsregexp;
11546: if ($file =~ /\.zip$/) {
11547: @cmd = (&decompression_utility('unzip'),"-l");
11548: $needsregexp = 1;
11549: } elsif (($file =~ m/\.tar\.gz$/) ||
11550: ($file =~ /\.tgz$/)) {
11551: @cmd = (&decompression_utility('tar'),"-ztf");
11552: } elsif ($file =~ /\.tar\.bz2$/) {
11553: @cmd = (&decompression_utility('tar'),"-jtf");
11554: } elsif ($file =~ m|\.tar$|) {
11555: @cmd = (&decompression_utility('tar'),"-tf");
11556: }
11557: if (@cmd) {
11558: undef($!);
11559: undef($@);
11560: if (open(my $fh,"-|", @cmd, $file)) {
11561: while (my $line = <$fh>) {
11562: $output .= $line;
11563: chomp($line);
11564: my $item;
11565: if ($needsregexp) {
11566: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11567: } else {
11568: $item = $line;
11569: }
11570: if ($item ne '') {
11571: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11572: push(@{$pathsref},$item);
11573: }
11574: }
11575: }
11576: close($fh);
11577: }
11578: }
11579: return $output;
11580: }
11581:
1.1053 raeburn 11582: sub decompress_uploaded_file {
11583: my ($file,$dir) = @_;
11584: &Apache::lonnet::appenv({'cgi.file' => $file});
11585: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11586: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11587: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11588: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11589: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11590: my $decompressed = $env{'cgi.decompressed'};
11591: &Apache::lonnet::delenv('cgi.file');
11592: &Apache::lonnet::delenv('cgi.dir');
11593: &Apache::lonnet::delenv('cgi.decompressed');
11594: return ($decompressed,$result);
11595: }
11596:
1.1055 raeburn 11597: sub process_decompression {
11598: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11599: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 11600: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 11601: $error = &mt('Filename not a supported archive file type.').
11602: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11603: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11604: } else {
11605: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11606: if ($docuhome eq 'no_host') {
11607: $error = &mt('Could not determine home server for course.');
11608: } else {
11609: my @ids=&Apache::lonnet::current_machine_ids();
11610: my $currdir = "$dir_root/$destination";
11611: if (grep(/^\Q$docuhome\E$/,@ids)) {
11612: $dir = &LONCAPA::propath($docudom,$docuname).
11613: "$dir_root/$destination";
11614: } else {
11615: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11616: "$dir_root/$docudom/$docuname/$destination";
11617: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11618: $error = &mt('Archive file not found.');
11619: }
11620: }
1.1065 raeburn 11621: my (@to_overwrite,@to_skip);
11622: if ($env{'form.archive_overwrite_total'} > 0) {
11623: my $total = $env{'form.archive_overwrite_total'};
11624: for (my $i=0; $i<$total; $i++) {
11625: if ($env{'form.archive_overwrite_'.$i} == 1) {
11626: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11627: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11628: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11629: }
11630: }
11631: }
11632: my $numskip = scalar(@to_skip);
11633: if (($numskip > 0) &&
11634: ($numskip == $env{'form.archive_itemcount'})) {
11635: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11636: } elsif ($dir eq '') {
1.1055 raeburn 11637: $error = &mt('Directory containing archive file unavailable.');
11638: } elsif (!$error) {
1.1065 raeburn 11639: my ($decompressed,$display);
11640: if ($numskip > 0) {
11641: my $tempdir = time.'_'.$$.int(rand(10000));
11642: mkdir("$dir/$tempdir",0755);
11643: system("mv $dir/$file $dir/$tempdir/$file");
11644: ($decompressed,$display) =
11645: &decompress_uploaded_file($file,"$dir/$tempdir");
11646: foreach my $item (@to_skip) {
11647: if (($item ne '') && ($item !~ /\.\./)) {
11648: if (-f "$dir/$tempdir/$item") {
11649: unlink("$dir/$tempdir/$item");
11650: } elsif (-d "$dir/$tempdir/$item") {
11651: system("rm -rf $dir/$tempdir/$item");
11652: }
11653: }
11654: }
11655: system("mv $dir/$tempdir/* $dir");
11656: rmdir("$dir/$tempdir");
11657: } else {
11658: ($decompressed,$display) =
11659: &decompress_uploaded_file($file,$dir);
11660: }
1.1055 raeburn 11661: if ($decompressed eq 'ok') {
1.1065 raeburn 11662: $output = '<p class="LC_info">'.
11663: &mt('Files extracted successfully from archive.').
11664: '</p>'."\n";
1.1055 raeburn 11665: my ($warning,$result,@contents);
11666: my ($newdirlistref,$newlisterror) =
11667: &Apache::lonnet::dirlist($currdir,$docudom,
11668: $docuname,1);
11669: my (%is_dir,%changes,@newitems);
11670: my $dirptr = 16384;
1.1065 raeburn 11671: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11672: foreach my $dir_line (@{$newdirlistref}) {
11673: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11674: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11675: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11676: push(@newitems,$item);
11677: if ($dirptr&$testdir) {
11678: $is_dir{$item} = 1;
11679: }
11680: $changes{$item} = 1;
11681: }
11682: }
11683: }
11684: if (keys(%changes) > 0) {
11685: foreach my $item (sort(@newitems)) {
11686: if ($changes{$item}) {
11687: push(@contents,$item);
11688: }
11689: }
11690: }
11691: if (@contents > 0) {
1.1067 raeburn 11692: my $wantform;
11693: unless ($env{'form.autoextract_camtasia'}) {
11694: $wantform = 1;
11695: }
1.1056 raeburn 11696: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11697: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11698: $currdir,\%is_dir,
11699: \%children,\%parent,
1.1056 raeburn 11700: \@contents,\%dirorder,
11701: \%titles,$wantform);
1.1055 raeburn 11702: if ($datatable ne '') {
11703: $output .= &archive_options_form('decompressed',$datatable,
11704: $count,$hiddenelem);
1.1065 raeburn 11705: my $startcount = 6;
1.1055 raeburn 11706: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11707: \%titles,\%children);
1.1055 raeburn 11708: }
1.1067 raeburn 11709: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 11710: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11711: my %displayed;
11712: my $total = 1;
11713: $env{'form.archive_directory'} = [];
11714: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11715: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11716: $path =~ s{/$}{};
11717: my $item;
11718: if ($path ne '') {
11719: $item = "$path/$titles{$i}";
11720: } else {
11721: $item = $titles{$i};
11722: }
11723: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11724: if ($item eq $contents[0]) {
11725: push(@{$env{'form.archive_directory'}},$i);
11726: $env{'form.archive_'.$i} = 'display';
11727: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11728: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 11729: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11730: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11731: $env{'form.archive_'.$i} = 'display';
11732: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11733: $displayed{'web'} = $i;
11734: } else {
1.1075.2.59 raeburn 11735: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11736: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11737: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11738: push(@{$env{'form.archive_directory'}},$i);
11739: }
11740: $env{'form.archive_'.$i} = 'dependency';
11741: }
11742: $total ++;
11743: }
11744: for (my $i=1; $i<$total; $i++) {
11745: next if ($i == $displayed{'web'});
11746: next if ($i == $displayed{'folder'});
11747: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11748: }
11749: $env{'form.phase'} = 'decompress_cleanup';
11750: $env{'form.archivedelete'} = 1;
11751: $env{'form.archive_count'} = $total-1;
11752: $output .=
11753: &process_extracted_files('coursedocs',$docudom,
11754: $docuname,$destination,
11755: $dir_root,$hiddenelem);
11756: }
1.1055 raeburn 11757: } else {
11758: $warning = &mt('No new items extracted from archive file.');
11759: }
11760: } else {
11761: $output = $display;
11762: $error = &mt('An error occurred during extraction from the archive file.');
11763: }
11764: }
11765: }
11766: }
11767: if ($error) {
11768: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11769: $error.'</p>'."\n";
11770: }
11771: if ($warning) {
11772: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11773: }
11774: return $output;
11775: }
11776:
11777: sub get_extracted {
1.1056 raeburn 11778: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11779: $titles,$wantform) = @_;
1.1055 raeburn 11780: my $count = 0;
11781: my $depth = 0;
11782: my $datatable;
1.1056 raeburn 11783: my @hierarchy;
1.1055 raeburn 11784: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11785: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11786: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11787: foreach my $item (@{$contents}) {
11788: $count ++;
1.1056 raeburn 11789: @{$dirorder->{$count}} = @hierarchy;
11790: $titles->{$count} = $item;
1.1055 raeburn 11791: &archive_hierarchy($depth,$count,$parent,$children);
11792: if ($wantform) {
11793: $datatable .= &archive_row($is_dir->{$item},$item,
11794: $currdir,$depth,$count);
11795: }
11796: if ($is_dir->{$item}) {
11797: $depth ++;
1.1056 raeburn 11798: push(@hierarchy,$count);
11799: $parent->{$depth} = $count;
1.1055 raeburn 11800: $datatable .=
11801: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11802: \$depth,\$count,\@hierarchy,$dirorder,
11803: $children,$parent,$titles,$wantform);
1.1055 raeburn 11804: $depth --;
1.1056 raeburn 11805: pop(@hierarchy);
1.1055 raeburn 11806: }
11807: }
11808: return ($count,$datatable);
11809: }
11810:
11811: sub recurse_extracted_archive {
1.1056 raeburn 11812: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11813: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11814: my $result='';
1.1056 raeburn 11815: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11816: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11817: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11818: return $result;
11819: }
11820: my $dirptr = 16384;
11821: my ($newdirlistref,$newlisterror) =
11822: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11823: if (ref($newdirlistref) eq 'ARRAY') {
11824: foreach my $dir_line (@{$newdirlistref}) {
11825: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11826: unless ($item =~ /^\.+$/) {
11827: $$count ++;
1.1056 raeburn 11828: @{$dirorder->{$$count}} = @{$hierarchy};
11829: $titles->{$$count} = $item;
1.1055 raeburn 11830: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11831:
1.1055 raeburn 11832: my $is_dir;
11833: if ($dirptr&$testdir) {
11834: $is_dir = 1;
11835: }
11836: if ($wantform) {
11837: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11838: }
11839: if ($is_dir) {
11840: $$depth ++;
1.1056 raeburn 11841: push(@{$hierarchy},$$count);
11842: $parent->{$$depth} = $$count;
1.1055 raeburn 11843: $result .=
11844: &recurse_extracted_archive("$currdir/$item",$docudom,
11845: $docuname,$depth,$count,
1.1056 raeburn 11846: $hierarchy,$dirorder,$children,
11847: $parent,$titles,$wantform);
1.1055 raeburn 11848: $$depth --;
1.1056 raeburn 11849: pop(@{$hierarchy});
1.1055 raeburn 11850: }
11851: }
11852: }
11853: }
11854: return $result;
11855: }
11856:
11857: sub archive_hierarchy {
11858: my ($depth,$count,$parent,$children) =@_;
11859: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11860: if (exists($parent->{$depth})) {
11861: $children->{$parent->{$depth}} .= $count.':';
11862: }
11863: }
11864: return;
11865: }
11866:
11867: sub archive_row {
11868: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11869: my ($name) = ($item =~ m{([^/]+)$});
11870: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11871: 'display' => 'Add as file',
1.1055 raeburn 11872: 'dependency' => 'Include as dependency',
11873: 'discard' => 'Discard',
11874: );
11875: if ($is_dir) {
1.1059 raeburn 11876: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11877: }
1.1056 raeburn 11878: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11879: my $offset = 0;
1.1055 raeburn 11880: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11881: $offset ++;
1.1065 raeburn 11882: if ($action ne 'display') {
11883: $offset ++;
11884: }
1.1055 raeburn 11885: $output .= '<td><span class="LC_nobreak">'.
11886: '<label><input type="radio" name="archive_'.$count.
11887: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11888: my $text = $choices{$action};
11889: if ($is_dir) {
11890: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11891: if ($action eq 'display') {
1.1059 raeburn 11892: $text = &mt('Add as folder');
1.1055 raeburn 11893: }
1.1056 raeburn 11894: } else {
11895: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11896:
11897: }
11898: $output .= ' /> '.$choices{$action}.'</label></span>';
11899: if ($action eq 'dependency') {
11900: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11901: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11902: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11903: '<option value=""></option>'."\n".
11904: '</select>'."\n".
11905: '</div>';
1.1059 raeburn 11906: } elsif ($action eq 'display') {
11907: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11908: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11909: '</div>';
1.1055 raeburn 11910: }
1.1056 raeburn 11911: $output .= '</td>';
1.1055 raeburn 11912: }
11913: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11914: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11915: for (my $i=0; $i<$depth; $i++) {
11916: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11917: }
11918: if ($is_dir) {
11919: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11920: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11921: } else {
11922: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11923: }
11924: $output .= ' '.$name.'</td>'."\n".
11925: &end_data_table_row();
11926: return $output;
11927: }
11928:
11929: sub archive_options_form {
1.1065 raeburn 11930: my ($form,$display,$count,$hiddenelem) = @_;
11931: my %lt = &Apache::lonlocal::texthash(
11932: perm => 'Permanently remove archive file?',
11933: hows => 'How should each extracted item be incorporated in the course?',
11934: cont => 'Content actions for all',
11935: addf => 'Add as folder/file',
11936: incd => 'Include as dependency for a displayed file',
11937: disc => 'Discard',
11938: no => 'No',
11939: yes => 'Yes',
11940: save => 'Save',
11941: );
11942: my $output = <<"END";
11943: <form name="$form" method="post" action="">
11944: <p><span class="LC_nobreak">$lt{'perm'}
11945: <label>
11946: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11947: </label>
11948:
11949: <label>
11950: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11951: </span>
11952: </p>
11953: <input type="hidden" name="phase" value="decompress_cleanup" />
11954: <br />$lt{'hows'}
11955: <div class="LC_columnSection">
11956: <fieldset>
11957: <legend>$lt{'cont'}</legend>
11958: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11959: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11960: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11961: </fieldset>
11962: </div>
11963: END
11964: return $output.
1.1055 raeburn 11965: &start_data_table()."\n".
1.1065 raeburn 11966: $display."\n".
1.1055 raeburn 11967: &end_data_table()."\n".
11968: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11969: $hiddenelem.
1.1065 raeburn 11970: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11971: '</form>';
11972: }
11973:
11974: sub archive_javascript {
1.1056 raeburn 11975: my ($startcount,$numitems,$titles,$children) = @_;
11976: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11977: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11978: my $scripttag = <<START;
11979: <script type="text/javascript">
11980: // <![CDATA[
11981:
11982: function checkAll(form,prefix) {
11983: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11984: for (var i=0; i < form.elements.length; i++) {
11985: var id = form.elements[i].id;
11986: if ((id != '') && (id != undefined)) {
11987: if (idstr.test(id)) {
11988: if (form.elements[i].type == 'radio') {
11989: form.elements[i].checked = true;
1.1056 raeburn 11990: var nostart = i-$startcount;
1.1059 raeburn 11991: var offset = nostart%7;
11992: var count = (nostart-offset)/7;
1.1056 raeburn 11993: dependencyCheck(form,count,offset);
1.1055 raeburn 11994: }
11995: }
11996: }
11997: }
11998: }
11999:
12000: function propagateCheck(form,count) {
12001: if (count > 0) {
1.1059 raeburn 12002: var startelement = $startcount + ((count-1) * 7);
12003: for (var j=1; j<6; j++) {
12004: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12005: var item = startelement + j;
12006: if (form.elements[item].type == 'radio') {
12007: if (form.elements[item].checked) {
12008: containerCheck(form,count,j);
12009: break;
12010: }
1.1055 raeburn 12011: }
12012: }
12013: }
12014: }
12015: }
12016:
12017: numitems = $numitems
1.1056 raeburn 12018: var titles = new Array(numitems);
12019: var parents = new Array(numitems);
1.1055 raeburn 12020: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12021: parents[i] = new Array;
1.1055 raeburn 12022: }
1.1059 raeburn 12023: var maintitle = '$maintitle';
1.1055 raeburn 12024:
12025: START
12026:
1.1056 raeburn 12027: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12028: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12029: for (my $i=0; $i<@contents; $i ++) {
12030: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12031: }
12032: }
12033:
1.1056 raeburn 12034: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12035: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12036: }
12037:
1.1055 raeburn 12038: $scripttag .= <<END;
12039:
12040: function containerCheck(form,count,offset) {
12041: if (count > 0) {
1.1056 raeburn 12042: dependencyCheck(form,count,offset);
1.1059 raeburn 12043: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12044: form.elements[item].checked = true;
12045: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12046: if (parents[count].length > 0) {
12047: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12048: containerCheck(form,parents[count][j],offset);
12049: }
12050: }
12051: }
12052: }
12053: }
12054:
12055: function dependencyCheck(form,count,offset) {
12056: if (count > 0) {
1.1059 raeburn 12057: var chosen = (offset+$startcount)+7*(count-1);
12058: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12059: var currtype = form.elements[depitem].type;
12060: if (form.elements[chosen].value == 'dependency') {
12061: document.getElementById('arc_depon_'+count).style.display='block';
12062: form.elements[depitem].options.length = 0;
12063: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 12064: for (var i=1; i<=numitems; i++) {
12065: if (i == count) {
12066: continue;
12067: }
1.1059 raeburn 12068: var startelement = $startcount + (i-1) * 7;
12069: for (var j=1; j<6; j++) {
12070: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12071: var item = startelement + j;
12072: if (form.elements[item].type == 'radio') {
12073: if (form.elements[item].checked) {
12074: if (form.elements[item].value == 'display') {
12075: var n = form.elements[depitem].options.length;
12076: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12077: }
12078: }
12079: }
12080: }
12081: }
12082: }
12083: } else {
12084: document.getElementById('arc_depon_'+count).style.display='none';
12085: form.elements[depitem].options.length = 0;
12086: form.elements[depitem].options[0] = new Option('Select','',true,true);
12087: }
1.1059 raeburn 12088: titleCheck(form,count,offset);
1.1056 raeburn 12089: }
12090: }
12091:
12092: function propagateSelect(form,count,offset) {
12093: if (count > 0) {
1.1065 raeburn 12094: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12095: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12096: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12097: if (parents[count].length > 0) {
12098: for (var j=0; j<parents[count].length; j++) {
12099: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12100: }
12101: }
12102: }
12103: }
12104: }
1.1056 raeburn 12105:
12106: function containerSelect(form,count,offset,picked) {
12107: if (count > 0) {
1.1065 raeburn 12108: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12109: if (form.elements[item].type == 'radio') {
12110: if (form.elements[item].value == 'dependency') {
12111: if (form.elements[item+1].type == 'select-one') {
12112: for (var i=0; i<form.elements[item+1].options.length; i++) {
12113: if (form.elements[item+1].options[i].value == picked) {
12114: form.elements[item+1].selectedIndex = i;
12115: break;
12116: }
12117: }
12118: }
12119: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12120: if (parents[count].length > 0) {
12121: for (var j=0; j<parents[count].length; j++) {
12122: containerSelect(form,parents[count][j],offset,picked);
12123: }
12124: }
12125: }
12126: }
12127: }
12128: }
12129: }
12130:
1.1059 raeburn 12131: function titleCheck(form,count,offset) {
12132: if (count > 0) {
12133: var chosen = (offset+$startcount)+7*(count-1);
12134: var depitem = $startcount + ((count-1) * 7) + 2;
12135: var currtype = form.elements[depitem].type;
12136: if (form.elements[chosen].value == 'display') {
12137: document.getElementById('arc_title_'+count).style.display='block';
12138: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12139: document.getElementById('archive_title_'+count).value=maintitle;
12140: }
12141: } else {
12142: document.getElementById('arc_title_'+count).style.display='none';
12143: if (currtype == 'text') {
12144: document.getElementById('archive_title_'+count).value='';
12145: }
12146: }
12147: }
12148: return;
12149: }
12150:
1.1055 raeburn 12151: // ]]>
12152: </script>
12153: END
12154: return $scripttag;
12155: }
12156:
12157: sub process_extracted_files {
1.1067 raeburn 12158: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12159: my $numitems = $env{'form.archive_count'};
12160: return unless ($numitems);
12161: my @ids=&Apache::lonnet::current_machine_ids();
12162: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12163: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12164: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12165: if (grep(/^\Q$docuhome\E$/,@ids)) {
12166: $prefix = &LONCAPA::propath($docudom,$docuname);
12167: $pathtocheck = "$dir_root/$destination";
12168: $dir = $dir_root;
12169: $ishome = 1;
12170: } else {
12171: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12172: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12173: $dir = "$dir_root/$docudom/$docuname";
12174: }
12175: my $currdir = "$dir_root/$destination";
12176: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12177: if ($env{'form.folderpath'}) {
12178: my @items = split('&',$env{'form.folderpath'});
12179: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 12180: if ($env{'form.folderpath'} =~ /\:1$/) {
12181: $containers{'0'}='page';
12182: } else {
12183: $containers{'0'}='sequence';
12184: }
1.1055 raeburn 12185: }
12186: my @archdirs = &get_env_multiple('form.archive_directory');
12187: if ($numitems) {
12188: for (my $i=1; $i<=$numitems; $i++) {
12189: my $path = $env{'form.archive_content_'.$i};
12190: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12191: my $item = $1;
12192: $toplevelitems{$item} = $i;
12193: if (grep(/^\Q$i\E$/,@archdirs)) {
12194: $is_dir{$item} = 1;
12195: }
12196: }
12197: }
12198: }
1.1067 raeburn 12199: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12200: if (keys(%toplevelitems) > 0) {
12201: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12202: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12203: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12204: }
1.1066 raeburn 12205: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12206: if ($numitems) {
12207: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 12208: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12209: my $path = $env{'form.archive_content_'.$i};
12210: if ($path =~ /^\Q$pathtocheck\E/) {
12211: if ($env{'form.archive_'.$i} eq 'discard') {
12212: if ($prefix ne '' && $path ne '') {
12213: if (-e $prefix.$path) {
1.1066 raeburn 12214: if ((@archdirs > 0) &&
12215: (grep(/^\Q$i\E$/,@archdirs))) {
12216: $todeletedir{$prefix.$path} = 1;
12217: } else {
12218: $todelete{$prefix.$path} = 1;
12219: }
1.1055 raeburn 12220: }
12221: }
12222: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12223: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12224: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12225: $docstitle = $env{'form.archive_title_'.$i};
12226: if ($docstitle eq '') {
12227: $docstitle = $title;
12228: }
1.1055 raeburn 12229: $outer = 0;
1.1056 raeburn 12230: if (ref($dirorder{$i}) eq 'ARRAY') {
12231: if (@{$dirorder{$i}} > 0) {
12232: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12233: if ($env{'form.archive_'.$item} eq 'display') {
12234: $outer = $item;
12235: last;
12236: }
12237: }
12238: }
12239: }
12240: my ($errtext,$fatal) =
12241: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12242: '/'.$folders{$outer}.'.'.
12243: $containers{$outer});
12244: next if ($fatal);
12245: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12246: if ($context eq 'coursedocs') {
1.1056 raeburn 12247: $mapinner{$i} = time;
1.1055 raeburn 12248: $folders{$i} = 'default_'.$mapinner{$i};
12249: $containers{$i} = 'sequence';
12250: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12251: $folders{$i}.'.'.$containers{$i};
12252: my $newidx = &LONCAPA::map::getresidx();
12253: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12254: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12255: push(@LONCAPA::map::order,$newidx);
12256: my ($outtext,$errtext) =
12257: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12258: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12259: '.'.$containers{$outer},1,1);
1.1056 raeburn 12260: $newseqid{$i} = $newidx;
1.1067 raeburn 12261: unless ($errtext) {
12262: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12263: }
1.1055 raeburn 12264: }
12265: } else {
12266: if ($context eq 'coursedocs') {
12267: my $newidx=&LONCAPA::map::getresidx();
12268: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12269: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12270: $title;
12271: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12272: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12273: }
12274: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12275: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12276: }
12277: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12278: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12279: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12280: unless ($ishome) {
12281: my $fetch = "$newdest{$i}/$title";
12282: $fetch =~ s/^\Q$prefix$dir\E//;
12283: $prompttofetch{$fetch} = 1;
12284: }
1.1055 raeburn 12285: }
12286: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12287: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12288: push(@LONCAPA::map::order, $newidx);
12289: my ($outtext,$errtext)=
12290: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12291: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12292: '.'.$containers{$outer},1,1);
1.1067 raeburn 12293: unless ($errtext) {
12294: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12295: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12296: }
12297: }
1.1055 raeburn 12298: }
12299: }
1.1075.2.11 raeburn 12300: }
12301: } else {
12302: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12303: }
12304: }
12305: for (my $i=1; $i<=$numitems; $i++) {
12306: next unless ($env{'form.archive_'.$i} eq 'dependency');
12307: my $path = $env{'form.archive_content_'.$i};
12308: if ($path =~ /^\Q$pathtocheck\E/) {
12309: my ($title) = ($path =~ m{/([^/]+)$});
12310: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12311: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12312: if (ref($dirorder{$i}) eq 'ARRAY') {
12313: my ($itemidx,$fullpath,$relpath);
12314: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12315: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12316: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 12317: if ($dirorder{$i}->[$j] eq $container) {
12318: $itemidx = $j;
1.1056 raeburn 12319: }
12320: }
1.1075.2.11 raeburn 12321: }
12322: if ($itemidx eq '') {
12323: $itemidx = 0;
12324: }
12325: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12326: if ($mapinner{$referrer{$i}}) {
12327: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12328: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12329: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12330: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12331: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12332: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12333: if (!-e $fullpath) {
12334: mkdir($fullpath,0755);
1.1056 raeburn 12335: }
12336: }
1.1075.2.11 raeburn 12337: } else {
12338: last;
1.1056 raeburn 12339: }
1.1075.2.11 raeburn 12340: }
12341: }
12342: } elsif ($newdest{$referrer{$i}}) {
12343: $fullpath = $newdest{$referrer{$i}};
12344: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12345: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12346: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12347: last;
12348: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12349: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12350: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12351: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12352: if (!-e $fullpath) {
12353: mkdir($fullpath,0755);
1.1056 raeburn 12354: }
12355: }
1.1075.2.11 raeburn 12356: } else {
12357: last;
1.1056 raeburn 12358: }
1.1075.2.11 raeburn 12359: }
12360: }
12361: if ($fullpath ne '') {
12362: if (-e "$prefix$path") {
12363: system("mv $prefix$path $fullpath/$title");
12364: }
12365: if (-e "$fullpath/$title") {
12366: my $showpath;
12367: if ($relpath ne '') {
12368: $showpath = "$relpath/$title";
12369: } else {
12370: $showpath = "/$title";
1.1056 raeburn 12371: }
1.1075.2.11 raeburn 12372: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12373: }
12374: unless ($ishome) {
12375: my $fetch = "$fullpath/$title";
12376: $fetch =~ s/^\Q$prefix$dir\E//;
12377: $prompttofetch{$fetch} = 1;
1.1055 raeburn 12378: }
12379: }
12380: }
1.1075.2.11 raeburn 12381: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12382: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12383: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12384: }
12385: } else {
1.1075.2.11 raeburn 12386: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055 raeburn 12387: }
12388: }
12389: if (keys(%todelete)) {
12390: foreach my $key (keys(%todelete)) {
12391: unlink($key);
1.1066 raeburn 12392: }
12393: }
12394: if (keys(%todeletedir)) {
12395: foreach my $key (keys(%todeletedir)) {
12396: rmdir($key);
12397: }
12398: }
12399: foreach my $dir (sort(keys(%is_dir))) {
12400: if (($pathtocheck ne '') && ($dir ne '')) {
12401: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12402: }
12403: }
1.1067 raeburn 12404: if ($result ne '') {
12405: $output .= '<ul>'."\n".
12406: $result."\n".
12407: '</ul>';
12408: }
12409: unless ($ishome) {
12410: my $replicationfail;
12411: foreach my $item (keys(%prompttofetch)) {
12412: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12413: unless ($fetchresult eq 'ok') {
12414: $replicationfail .= '<li>'.$item.'</li>'."\n";
12415: }
12416: }
12417: if ($replicationfail) {
12418: $output .= '<p class="LC_error">'.
12419: &mt('Course home server failed to retrieve:').'<ul>'.
12420: $replicationfail.
12421: '</ul></p>';
12422: }
12423: }
1.1055 raeburn 12424: } else {
12425: $warning = &mt('No items found in archive.');
12426: }
12427: if ($error) {
12428: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12429: $error.'</p>'."\n";
12430: }
12431: if ($warning) {
12432: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12433: }
12434: return $output;
12435: }
12436:
1.1066 raeburn 12437: sub cleanup_empty_dirs {
12438: my ($path) = @_;
12439: if (($path ne '') && (-d $path)) {
12440: if (opendir(my $dirh,$path)) {
12441: my @dircontents = grep(!/^\./,readdir($dirh));
12442: my $numitems = 0;
12443: foreach my $item (@dircontents) {
12444: if (-d "$path/$item") {
1.1075.2.28 raeburn 12445: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12446: if (-e "$path/$item") {
12447: $numitems ++;
12448: }
12449: } else {
12450: $numitems ++;
12451: }
12452: }
12453: if ($numitems == 0) {
12454: rmdir($path);
12455: }
12456: closedir($dirh);
12457: }
12458: }
12459: return;
12460: }
12461:
1.41 ng 12462: =pod
1.45 matthew 12463:
1.1075.2.56 raeburn 12464: =item * &get_folder_hierarchy()
1.1068 raeburn 12465:
12466: Provides hierarchy of names of folders/sub-folders containing the current
12467: item,
12468:
12469: Inputs: 3
12470: - $navmap - navmaps object
12471:
12472: - $map - url for map (either the trigger itself, or map containing
12473: the resource, which is the trigger).
12474:
12475: - $showitem - 1 => show title for map itself; 0 => do not show.
12476:
12477: Outputs: 1 @pathitems - array of folder/subfolder names.
12478:
12479: =cut
12480:
12481: sub get_folder_hierarchy {
12482: my ($navmap,$map,$showitem) = @_;
12483: my @pathitems;
12484: if (ref($navmap)) {
12485: my $mapres = $navmap->getResourceByUrl($map);
12486: if (ref($mapres)) {
12487: my $pcslist = $mapres->map_hierarchy();
12488: if ($pcslist ne '') {
12489: my @pcs = split(/,/,$pcslist);
12490: foreach my $pc (@pcs) {
12491: if ($pc == 1) {
1.1075.2.38 raeburn 12492: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12493: } else {
12494: my $res = $navmap->getByMapPc($pc);
12495: if (ref($res)) {
12496: my $title = $res->compTitle();
12497: $title =~ s/\W+/_/g;
12498: if ($title ne '') {
12499: push(@pathitems,$title);
12500: }
12501: }
12502: }
12503: }
12504: }
1.1071 raeburn 12505: if ($showitem) {
12506: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 12507: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12508: } else {
12509: my $maptitle = $mapres->compTitle();
12510: $maptitle =~ s/\W+/_/g;
12511: if ($maptitle ne '') {
12512: push(@pathitems,$maptitle);
12513: }
1.1068 raeburn 12514: }
12515: }
12516: }
12517: }
12518: return @pathitems;
12519: }
12520:
12521: =pod
12522:
1.1015 raeburn 12523: =item * &get_turnedin_filepath()
12524:
12525: Determines path in a user's portfolio file for storage of files uploaded
12526: to a specific essayresponse or dropbox item.
12527:
12528: Inputs: 3 required + 1 optional.
12529: $symb is symb for resource, $uname and $udom are for current user (required).
12530: $caller is optional (can be "submission", if routine is called when storing
12531: an upoaded file when "Submit Answer" button was pressed).
12532:
12533: Returns array containing $path and $multiresp.
12534: $path is path in portfolio. $multiresp is 1 if this resource contains more
12535: than one file upload item. Callers of routine should append partid as a
12536: subdirectory to $path in cases where $multiresp is 1.
12537:
12538: Called by: homework/essayresponse.pm and homework/structuretags.pm
12539:
12540: =cut
12541:
12542: sub get_turnedin_filepath {
12543: my ($symb,$uname,$udom,$caller) = @_;
12544: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12545: my $turnindir;
12546: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12547: $turnindir = $userhash{'turnindir'};
12548: my ($path,$multiresp);
12549: if ($turnindir eq '') {
12550: if ($caller eq 'submission') {
12551: $turnindir = &mt('turned in');
12552: $turnindir =~ s/\W+/_/g;
12553: my %newhash = (
12554: 'turnindir' => $turnindir,
12555: );
12556: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12557: }
12558: }
12559: if ($turnindir ne '') {
12560: $path = '/'.$turnindir.'/';
12561: my ($multipart,$turnin,@pathitems);
12562: my $navmap = Apache::lonnavmaps::navmap->new();
12563: if (defined($navmap)) {
12564: my $mapres = $navmap->getResourceByUrl($map);
12565: if (ref($mapres)) {
12566: my $pcslist = $mapres->map_hierarchy();
12567: if ($pcslist ne '') {
12568: foreach my $pc (split(/,/,$pcslist)) {
12569: my $res = $navmap->getByMapPc($pc);
12570: if (ref($res)) {
12571: my $title = $res->compTitle();
12572: $title =~ s/\W+/_/g;
12573: if ($title ne '') {
1.1075.2.48 raeburn 12574: if (($pc > 1) && (length($title) > 12)) {
12575: $title = substr($title,0,12);
12576: }
1.1015 raeburn 12577: push(@pathitems,$title);
12578: }
12579: }
12580: }
12581: }
12582: my $maptitle = $mapres->compTitle();
12583: $maptitle =~ s/\W+/_/g;
12584: if ($maptitle ne '') {
1.1075.2.48 raeburn 12585: if (length($maptitle) > 12) {
12586: $maptitle = substr($maptitle,0,12);
12587: }
1.1015 raeburn 12588: push(@pathitems,$maptitle);
12589: }
12590: unless ($env{'request.state'} eq 'construct') {
12591: my $res = $navmap->getBySymb($symb);
12592: if (ref($res)) {
12593: my $partlist = $res->parts();
12594: my $totaluploads = 0;
12595: if (ref($partlist) eq 'ARRAY') {
12596: foreach my $part (@{$partlist}) {
12597: my @types = $res->responseType($part);
12598: my @ids = $res->responseIds($part);
12599: for (my $i=0; $i < scalar(@ids); $i++) {
12600: if ($types[$i] eq 'essay') {
12601: my $partid = $part.'_'.$ids[$i];
12602: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12603: $totaluploads ++;
12604: }
12605: }
12606: }
12607: }
12608: if ($totaluploads > 1) {
12609: $multiresp = 1;
12610: }
12611: }
12612: }
12613: }
12614: } else {
12615: return;
12616: }
12617: } else {
12618: return;
12619: }
12620: my $restitle=&Apache::lonnet::gettitle($symb);
12621: $restitle =~ s/\W+/_/g;
12622: if ($restitle eq '') {
12623: $restitle = ($resurl =~ m{/[^/]+$});
12624: if ($restitle eq '') {
12625: $restitle = time;
12626: }
12627: }
1.1075.2.48 raeburn 12628: if (length($restitle) > 12) {
12629: $restitle = substr($restitle,0,12);
12630: }
1.1015 raeburn 12631: push(@pathitems,$restitle);
12632: $path .= join('/',@pathitems);
12633: }
12634: return ($path,$multiresp);
12635: }
12636:
12637: =pod
12638:
1.464 albertel 12639: =back
1.41 ng 12640:
1.112 bowersj2 12641: =head1 CSV Upload/Handling functions
1.38 albertel 12642:
1.41 ng 12643: =over 4
12644:
1.648 raeburn 12645: =item * &upfile_store($r)
1.41 ng 12646:
12647: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12648: needs $env{'form.upfile'}
1.41 ng 12649: returns $datatoken to be put into hidden field
12650:
12651: =cut
1.31 albertel 12652:
12653: sub upfile_store {
12654: my $r=shift;
1.258 albertel 12655: $env{'form.upfile'}=~s/\r/\n/gs;
12656: $env{'form.upfile'}=~s/\f/\n/gs;
12657: $env{'form.upfile'}=~s/\n+/\n/gs;
12658: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12659:
1.258 albertel 12660: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12661: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12662: {
1.158 raeburn 12663: my $datafile = $r->dir_config('lonDaemons').
12664: '/tmp/'.$datatoken.'.tmp';
12665: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12666: print $fh $env{'form.upfile'};
1.158 raeburn 12667: close($fh);
12668: }
1.31 albertel 12669: }
12670: return $datatoken;
12671: }
12672:
1.56 matthew 12673: =pod
12674:
1.648 raeburn 12675: =item * &load_tmp_file($r)
1.41 ng 12676:
12677: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12678: needs $env{'form.datatoken'},
12679: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12680:
12681: =cut
1.31 albertel 12682:
12683: sub load_tmp_file {
12684: my $r=shift;
12685: my @studentdata=();
12686: {
1.158 raeburn 12687: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12688: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12689: if ( open(my $fh,"<$studentfile") ) {
12690: @studentdata=<$fh>;
12691: close($fh);
12692: }
1.31 albertel 12693: }
1.258 albertel 12694: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12695: }
12696:
1.56 matthew 12697: =pod
12698:
1.648 raeburn 12699: =item * &upfile_record_sep()
1.41 ng 12700:
12701: Separate uploaded file into records
12702: returns array of records,
1.258 albertel 12703: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12704:
12705: =cut
1.31 albertel 12706:
12707: sub upfile_record_sep {
1.258 albertel 12708: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12709: } else {
1.248 albertel 12710: my @records;
1.258 albertel 12711: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12712: if ($line=~/^\s*$/) { next; }
12713: push(@records,$line);
12714: }
12715: return @records;
1.31 albertel 12716: }
12717: }
12718:
1.56 matthew 12719: =pod
12720:
1.648 raeburn 12721: =item * &record_sep($record)
1.41 ng 12722:
1.258 albertel 12723: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12724:
12725: =cut
12726:
1.263 www 12727: sub takeleft {
12728: my $index=shift;
12729: return substr('0000'.$index,-4,4);
12730: }
12731:
1.31 albertel 12732: sub record_sep {
12733: my $record=shift;
12734: my %components=();
1.258 albertel 12735: if ($env{'form.upfiletype'} eq 'xml') {
12736: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12737: my $i=0;
1.356 albertel 12738: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12739: $field=~s/^(\"|\')//;
12740: $field=~s/(\"|\')$//;
1.263 www 12741: $components{&takeleft($i)}=$field;
1.31 albertel 12742: $i++;
12743: }
1.258 albertel 12744: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12745: my $i=0;
1.356 albertel 12746: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12747: $field=~s/^(\"|\')//;
12748: $field=~s/(\"|\')$//;
1.263 www 12749: $components{&takeleft($i)}=$field;
1.31 albertel 12750: $i++;
12751: }
12752: } else {
1.561 www 12753: my $separator=',';
1.480 banghart 12754: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12755: $separator=';';
1.480 banghart 12756: }
1.31 albertel 12757: my $i=0;
1.561 www 12758: # the character we are looking for to indicate the end of a quote or a record
12759: my $looking_for=$separator;
12760: # do not add the characters to the fields
12761: my $ignore=0;
12762: # we just encountered a separator (or the beginning of the record)
12763: my $just_found_separator=1;
12764: # store the field we are working on here
12765: my $field='';
12766: # work our way through all characters in record
12767: foreach my $character ($record=~/(.)/g) {
12768: if ($character eq $looking_for) {
12769: if ($character ne $separator) {
12770: # Found the end of a quote, again looking for separator
12771: $looking_for=$separator;
12772: $ignore=1;
12773: } else {
12774: # Found a separator, store away what we got
12775: $components{&takeleft($i)}=$field;
12776: $i++;
12777: $just_found_separator=1;
12778: $ignore=0;
12779: $field='';
12780: }
12781: next;
12782: }
12783: # single or double quotation marks after a separator indicate beginning of a quote
12784: # we are now looking for the end of the quote and need to ignore separators
12785: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12786: $looking_for=$character;
12787: next;
12788: }
12789: # ignore would be true after we reached the end of a quote
12790: if ($ignore) { next; }
12791: if (($just_found_separator) && ($character=~/\s/)) { next; }
12792: $field.=$character;
12793: $just_found_separator=0;
1.31 albertel 12794: }
1.561 www 12795: # catch the very last entry, since we never encountered the separator
12796: $components{&takeleft($i)}=$field;
1.31 albertel 12797: }
12798: return %components;
12799: }
12800:
1.144 matthew 12801: ######################################################
12802: ######################################################
12803:
1.56 matthew 12804: =pod
12805:
1.648 raeburn 12806: =item * &upfile_select_html()
1.41 ng 12807:
1.144 matthew 12808: Return HTML code to select a file from the users machine and specify
12809: the file type.
1.41 ng 12810:
12811: =cut
12812:
1.144 matthew 12813: ######################################################
12814: ######################################################
1.31 albertel 12815: sub upfile_select_html {
1.144 matthew 12816: my %Types = (
12817: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12818: semisv => &mt('Semicolon separated values'),
1.144 matthew 12819: space => &mt('Space separated'),
12820: tab => &mt('Tabulator separated'),
12821: # xml => &mt('HTML/XML'),
12822: );
12823: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12824: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12825: foreach my $type (sort(keys(%Types))) {
12826: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12827: }
12828: $Str .= "</select>\n";
12829: return $Str;
1.31 albertel 12830: }
12831:
1.301 albertel 12832: sub get_samples {
12833: my ($records,$toget) = @_;
12834: my @samples=({});
12835: my $got=0;
12836: foreach my $rec (@$records) {
12837: my %temp = &record_sep($rec);
12838: if (! grep(/\S/, values(%temp))) { next; }
12839: if (%temp) {
12840: $samples[$got]=\%temp;
12841: $got++;
12842: if ($got == $toget) { last; }
12843: }
12844: }
12845: return \@samples;
12846: }
12847:
1.144 matthew 12848: ######################################################
12849: ######################################################
12850:
1.56 matthew 12851: =pod
12852:
1.648 raeburn 12853: =item * &csv_print_samples($r,$records)
1.41 ng 12854:
12855: Prints a table of sample values from each column uploaded $r is an
12856: Apache Request ref, $records is an arrayref from
12857: &Apache::loncommon::upfile_record_sep
12858:
12859: =cut
12860:
1.144 matthew 12861: ######################################################
12862: ######################################################
1.31 albertel 12863: sub csv_print_samples {
12864: my ($r,$records) = @_;
1.662 bisitz 12865: my $samples = &get_samples($records,5);
1.301 albertel 12866:
1.594 raeburn 12867: $r->print(&mt('Samples').'<br />'.&start_data_table().
12868: &start_data_table_header_row());
1.356 albertel 12869: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12870: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12871: $r->print(&end_data_table_header_row());
1.301 albertel 12872: foreach my $hash (@$samples) {
1.594 raeburn 12873: $r->print(&start_data_table_row());
1.356 albertel 12874: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12875: $r->print('<td>');
1.356 albertel 12876: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12877: $r->print('</td>');
12878: }
1.594 raeburn 12879: $r->print(&end_data_table_row());
1.31 albertel 12880: }
1.594 raeburn 12881: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12882: }
12883:
1.144 matthew 12884: ######################################################
12885: ######################################################
12886:
1.56 matthew 12887: =pod
12888:
1.648 raeburn 12889: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12890:
12891: Prints a table to create associations between values and table columns.
1.144 matthew 12892:
1.41 ng 12893: $r is an Apache Request ref,
12894: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12895: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12896:
12897: =cut
12898:
1.144 matthew 12899: ######################################################
12900: ######################################################
1.31 albertel 12901: sub csv_print_select_table {
12902: my ($r,$records,$d) = @_;
1.301 albertel 12903: my $i=0;
12904: my $samples = &get_samples($records,1);
1.144 matthew 12905: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12906: &start_data_table().&start_data_table_header_row().
1.144 matthew 12907: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12908: '<th>'.&mt('Column').'</th>'.
12909: &end_data_table_header_row()."\n");
1.356 albertel 12910: foreach my $array_ref (@$d) {
12911: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12912: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12913:
1.875 bisitz 12914: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12915: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12916: $r->print('<option value="none"></option>');
1.356 albertel 12917: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12918: $r->print('<option value="'.$sample.'"'.
12919: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12920: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12921: }
1.594 raeburn 12922: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12923: $i++;
12924: }
1.594 raeburn 12925: $r->print(&end_data_table());
1.31 albertel 12926: $i--;
12927: return $i;
12928: }
1.56 matthew 12929:
1.144 matthew 12930: ######################################################
12931: ######################################################
12932:
1.56 matthew 12933: =pod
1.31 albertel 12934:
1.648 raeburn 12935: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12936:
12937: Prints a table of sample values from the upload and can make associate samples to internal names.
12938:
12939: $r is an Apache Request ref,
12940: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12941: $d is an array of 2 element arrays (internal name, displayed name)
12942:
12943: =cut
12944:
1.144 matthew 12945: ######################################################
12946: ######################################################
1.31 albertel 12947: sub csv_samples_select_table {
12948: my ($r,$records,$d) = @_;
12949: my $i=0;
1.144 matthew 12950: #
1.662 bisitz 12951: my $max_samples = 5;
12952: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12953: $r->print(&start_data_table().
12954: &start_data_table_header_row().'<th>'.
12955: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12956: &end_data_table_header_row());
1.301 albertel 12957:
12958: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12959: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12960: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12961: foreach my $option (@$d) {
12962: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12963: $r->print('<option value="'.$value.'"'.
1.253 albertel 12964: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12965: $display.'</option>');
1.31 albertel 12966: }
12967: $r->print('</select></td><td>');
1.662 bisitz 12968: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12969: if (defined($samples->[$line]{$key})) {
12970: $r->print($samples->[$line]{$key}."<br />\n");
12971: }
12972: }
1.594 raeburn 12973: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12974: $i++;
12975: }
1.594 raeburn 12976: $r->print(&end_data_table());
1.31 albertel 12977: $i--;
12978: return($i);
1.115 matthew 12979: }
12980:
1.144 matthew 12981: ######################################################
12982: ######################################################
12983:
1.115 matthew 12984: =pod
12985:
1.648 raeburn 12986: =item * &clean_excel_name($name)
1.115 matthew 12987:
12988: Returns a replacement for $name which does not contain any illegal characters.
12989:
12990: =cut
12991:
1.144 matthew 12992: ######################################################
12993: ######################################################
1.115 matthew 12994: sub clean_excel_name {
12995: my ($name) = @_;
12996: $name =~ s/[:\*\?\/\\]//g;
12997: if (length($name) > 31) {
12998: $name = substr($name,0,31);
12999: }
13000: return $name;
1.25 albertel 13001: }
1.84 albertel 13002:
1.85 albertel 13003: =pod
13004:
1.648 raeburn 13005: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13006:
13007: Returns either 1 or undef
13008:
13009: 1 if the part is to be hidden, undef if it is to be shown
13010:
13011: Arguments are:
13012:
13013: $id the id of the part to be checked
13014: $symb, optional the symb of the resource to check
13015: $udom, optional the domain of the user to check for
13016: $uname, optional the username of the user to check for
13017:
13018: =cut
1.84 albertel 13019:
13020: sub check_if_partid_hidden {
13021: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13022: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13023: $symb,$udom,$uname);
1.141 albertel 13024: my $truth=1;
13025: #if the string starts with !, then the list is the list to show not hide
13026: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13027: my @hiddenlist=split(/,/,$hiddenparts);
13028: foreach my $checkid (@hiddenlist) {
1.141 albertel 13029: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13030: }
1.141 albertel 13031: return !$truth;
1.84 albertel 13032: }
1.127 matthew 13033:
1.138 matthew 13034:
13035: ############################################################
13036: ############################################################
13037:
13038: =pod
13039:
1.157 matthew 13040: =back
13041:
1.138 matthew 13042: =head1 cgi-bin script and graphing routines
13043:
1.157 matthew 13044: =over 4
13045:
1.648 raeburn 13046: =item * &get_cgi_id()
1.138 matthew 13047:
13048: Inputs: none
13049:
13050: Returns an id which can be used to pass environment variables
13051: to various cgi-bin scripts. These environment variables will
13052: be removed from the users environment after a given time by
13053: the routine &Apache::lonnet::transfer_profile_to_env.
13054:
13055: =cut
13056:
13057: ############################################################
13058: ############################################################
1.152 albertel 13059: my $uniq=0;
1.136 matthew 13060: sub get_cgi_id {
1.154 albertel 13061: $uniq=($uniq+1)%100000;
1.280 albertel 13062: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13063: }
13064:
1.127 matthew 13065: ############################################################
13066: ############################################################
13067:
13068: =pod
13069:
1.648 raeburn 13070: =item * &DrawBarGraph()
1.127 matthew 13071:
1.138 matthew 13072: Facilitates the plotting of data in a (stacked) bar graph.
13073: Puts plot definition data into the users environment in order for
13074: graph.png to plot it. Returns an <img> tag for the plot.
13075: The bars on the plot are labeled '1','2',...,'n'.
13076:
13077: Inputs:
13078:
13079: =over 4
13080:
13081: =item $Title: string, the title of the plot
13082:
13083: =item $xlabel: string, text describing the X-axis of the plot
13084:
13085: =item $ylabel: string, text describing the Y-axis of the plot
13086:
13087: =item $Max: scalar, the maximum Y value to use in the plot
13088: If $Max is < any data point, the graph will not be rendered.
13089:
1.140 matthew 13090: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13091: they are plotted. If undefined, default values will be used.
13092:
1.178 matthew 13093: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13094:
1.138 matthew 13095: =item @Values: An array of array references. Each array reference holds data
13096: to be plotted in a stacked bar chart.
13097:
1.239 matthew 13098: =item If the final element of @Values is a hash reference the key/value
13099: pairs will be added to the graph definition.
13100:
1.138 matthew 13101: =back
13102:
13103: Returns:
13104:
13105: An <img> tag which references graph.png and the appropriate identifying
13106: information for the plot.
13107:
1.127 matthew 13108: =cut
13109:
13110: ############################################################
13111: ############################################################
1.134 matthew 13112: sub DrawBarGraph {
1.178 matthew 13113: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13114: #
13115: if (! defined($colors)) {
13116: $colors = ['#33ff00',
13117: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13118: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13119: ];
13120: }
1.228 matthew 13121: my $extra_settings = {};
13122: if (ref($Values[-1]) eq 'HASH') {
13123: $extra_settings = pop(@Values);
13124: }
1.127 matthew 13125: #
1.136 matthew 13126: my $identifier = &get_cgi_id();
13127: my $id = 'cgi.'.$identifier;
1.129 matthew 13128: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13129: return '';
13130: }
1.225 matthew 13131: #
13132: my @Labels;
13133: if (defined($labels)) {
13134: @Labels = @$labels;
13135: } else {
13136: for (my $i=0;$i<@{$Values[0]};$i++) {
13137: push (@Labels,$i+1);
13138: }
13139: }
13140: #
1.129 matthew 13141: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13142: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13143: my %ValuesHash;
13144: my $NumSets=1;
13145: foreach my $array (@Values) {
13146: next if (! ref($array));
1.136 matthew 13147: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13148: join(',',@$array);
1.129 matthew 13149: }
1.127 matthew 13150: #
1.136 matthew 13151: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13152: if ($NumBars < 3) {
13153: $width = 120+$NumBars*32;
1.220 matthew 13154: $xskip = 1;
1.225 matthew 13155: $bar_width = 30;
13156: } elsif ($NumBars < 5) {
13157: $width = 120+$NumBars*20;
13158: $xskip = 1;
13159: $bar_width = 20;
1.220 matthew 13160: } elsif ($NumBars < 10) {
1.136 matthew 13161: $width = 120+$NumBars*15;
13162: $xskip = 1;
13163: $bar_width = 15;
13164: } elsif ($NumBars <= 25) {
13165: $width = 120+$NumBars*11;
13166: $xskip = 5;
13167: $bar_width = 8;
13168: } elsif ($NumBars <= 50) {
13169: $width = 120+$NumBars*8;
13170: $xskip = 5;
13171: $bar_width = 4;
13172: } else {
13173: $width = 120+$NumBars*8;
13174: $xskip = 5;
13175: $bar_width = 4;
13176: }
13177: #
1.137 matthew 13178: $Max = 1 if ($Max < 1);
13179: if ( int($Max) < $Max ) {
13180: $Max++;
13181: $Max = int($Max);
13182: }
1.127 matthew 13183: $Title = '' if (! defined($Title));
13184: $xlabel = '' if (! defined($xlabel));
13185: $ylabel = '' if (! defined($ylabel));
1.369 www 13186: $ValuesHash{$id.'.title'} = &escape($Title);
13187: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13188: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13189: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13190: $ValuesHash{$id.'.NumBars'} = $NumBars;
13191: $ValuesHash{$id.'.NumSets'} = $NumSets;
13192: $ValuesHash{$id.'.PlotType'} = 'bar';
13193: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13194: $ValuesHash{$id.'.height'} = $height;
13195: $ValuesHash{$id.'.width'} = $width;
13196: $ValuesHash{$id.'.xskip'} = $xskip;
13197: $ValuesHash{$id.'.bar_width'} = $bar_width;
13198: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13199: #
1.228 matthew 13200: # Deal with other parameters
13201: while (my ($key,$value) = each(%$extra_settings)) {
13202: $ValuesHash{$id.'.'.$key} = $value;
13203: }
13204: #
1.646 raeburn 13205: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13206: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13207: }
13208:
13209: ############################################################
13210: ############################################################
13211:
13212: =pod
13213:
1.648 raeburn 13214: =item * &DrawXYGraph()
1.137 matthew 13215:
1.138 matthew 13216: Facilitates the plotting of data in an XY graph.
13217: Puts plot definition data into the users environment in order for
13218: graph.png to plot it. Returns an <img> tag for the plot.
13219:
13220: Inputs:
13221:
13222: =over 4
13223:
13224: =item $Title: string, the title of the plot
13225:
13226: =item $xlabel: string, text describing the X-axis of the plot
13227:
13228: =item $ylabel: string, text describing the Y-axis of the plot
13229:
13230: =item $Max: scalar, the maximum Y value to use in the plot
13231: If $Max is < any data point, the graph will not be rendered.
13232:
13233: =item $colors: Array ref containing the hex color codes for the data to be
13234: plotted in. If undefined, default values will be used.
13235:
13236: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13237:
13238: =item $Ydata: Array ref containing Array refs.
1.185 www 13239: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13240:
13241: =item %Values: hash indicating or overriding any default values which are
13242: passed to graph.png.
13243: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13244:
13245: =back
13246:
13247: Returns:
13248:
13249: An <img> tag which references graph.png and the appropriate identifying
13250: information for the plot.
13251:
1.137 matthew 13252: =cut
13253:
13254: ############################################################
13255: ############################################################
13256: sub DrawXYGraph {
13257: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13258: #
13259: # Create the identifier for the graph
13260: my $identifier = &get_cgi_id();
13261: my $id = 'cgi.'.$identifier;
13262: #
13263: $Title = '' if (! defined($Title));
13264: $xlabel = '' if (! defined($xlabel));
13265: $ylabel = '' if (! defined($ylabel));
13266: my %ValuesHash =
13267: (
1.369 www 13268: $id.'.title' => &escape($Title),
13269: $id.'.xlabel' => &escape($xlabel),
13270: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13271: $id.'.y_max_value'=> $Max,
13272: $id.'.labels' => join(',',@$Xlabels),
13273: $id.'.PlotType' => 'XY',
13274: );
13275: #
13276: if (defined($colors) && ref($colors) eq 'ARRAY') {
13277: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13278: }
13279: #
13280: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13281: return '';
13282: }
13283: my $NumSets=1;
1.138 matthew 13284: foreach my $array (@{$Ydata}){
1.137 matthew 13285: next if (! ref($array));
13286: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13287: }
1.138 matthew 13288: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13289: #
13290: # Deal with other parameters
13291: while (my ($key,$value) = each(%Values)) {
13292: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13293: }
13294: #
1.646 raeburn 13295: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13296: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13297: }
13298:
13299: ############################################################
13300: ############################################################
13301:
13302: =pod
13303:
1.648 raeburn 13304: =item * &DrawXYYGraph()
1.138 matthew 13305:
13306: Facilitates the plotting of data in an XY graph with two Y axes.
13307: Puts plot definition data into the users environment in order for
13308: graph.png to plot it. Returns an <img> tag for the plot.
13309:
13310: Inputs:
13311:
13312: =over 4
13313:
13314: =item $Title: string, the title of the plot
13315:
13316: =item $xlabel: string, text describing the X-axis of the plot
13317:
13318: =item $ylabel: string, text describing the Y-axis of the plot
13319:
13320: =item $colors: Array ref containing the hex color codes for the data to be
13321: plotted in. If undefined, default values will be used.
13322:
13323: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13324:
13325: =item $Ydata1: The first data set
13326:
13327: =item $Min1: The minimum value of the left Y-axis
13328:
13329: =item $Max1: The maximum value of the left Y-axis
13330:
13331: =item $Ydata2: The second data set
13332:
13333: =item $Min2: The minimum value of the right Y-axis
13334:
13335: =item $Max2: The maximum value of the left Y-axis
13336:
13337: =item %Values: hash indicating or overriding any default values which are
13338: passed to graph.png.
13339: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13340:
13341: =back
13342:
13343: Returns:
13344:
13345: An <img> tag which references graph.png and the appropriate identifying
13346: information for the plot.
1.136 matthew 13347:
13348: =cut
13349:
13350: ############################################################
13351: ############################################################
1.137 matthew 13352: sub DrawXYYGraph {
13353: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13354: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13355: #
13356: # Create the identifier for the graph
13357: my $identifier = &get_cgi_id();
13358: my $id = 'cgi.'.$identifier;
13359: #
13360: $Title = '' if (! defined($Title));
13361: $xlabel = '' if (! defined($xlabel));
13362: $ylabel = '' if (! defined($ylabel));
13363: my %ValuesHash =
13364: (
1.369 www 13365: $id.'.title' => &escape($Title),
13366: $id.'.xlabel' => &escape($xlabel),
13367: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13368: $id.'.labels' => join(',',@$Xlabels),
13369: $id.'.PlotType' => 'XY',
13370: $id.'.NumSets' => 2,
1.137 matthew 13371: $id.'.two_axes' => 1,
13372: $id.'.y1_max_value' => $Max1,
13373: $id.'.y1_min_value' => $Min1,
13374: $id.'.y2_max_value' => $Max2,
13375: $id.'.y2_min_value' => $Min2,
1.136 matthew 13376: );
13377: #
1.137 matthew 13378: if (defined($colors) && ref($colors) eq 'ARRAY') {
13379: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13380: }
13381: #
13382: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13383: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13384: return '';
13385: }
13386: my $NumSets=1;
1.137 matthew 13387: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13388: next if (! ref($array));
13389: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13390: }
13391: #
13392: # Deal with other parameters
13393: while (my ($key,$value) = each(%Values)) {
13394: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13395: }
13396: #
1.646 raeburn 13397: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13398: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13399: }
13400:
13401: ############################################################
13402: ############################################################
13403:
13404: =pod
13405:
1.157 matthew 13406: =back
13407:
1.139 matthew 13408: =head1 Statistics helper routines?
13409:
13410: Bad place for them but what the hell.
13411:
1.157 matthew 13412: =over 4
13413:
1.648 raeburn 13414: =item * &chartlink()
1.139 matthew 13415:
13416: Returns a link to the chart for a specific student.
13417:
13418: Inputs:
13419:
13420: =over 4
13421:
13422: =item $linktext: The text of the link
13423:
13424: =item $sname: The students username
13425:
13426: =item $sdomain: The students domain
13427:
13428: =back
13429:
1.157 matthew 13430: =back
13431:
1.139 matthew 13432: =cut
13433:
13434: ############################################################
13435: ############################################################
13436: sub chartlink {
13437: my ($linktext, $sname, $sdomain) = @_;
13438: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13439: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13440: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13441: '">'.$linktext.'</a>';
1.153 matthew 13442: }
13443:
13444: #######################################################
13445: #######################################################
13446:
13447: =pod
13448:
13449: =head1 Course Environment Routines
1.157 matthew 13450:
13451: =over 4
1.153 matthew 13452:
1.648 raeburn 13453: =item * &restore_course_settings()
1.153 matthew 13454:
1.648 raeburn 13455: =item * &store_course_settings()
1.153 matthew 13456:
13457: Restores/Store indicated form parameters from the course environment.
13458: Will not overwrite existing values of the form parameters.
13459:
13460: Inputs:
13461: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13462:
13463: a hash ref describing the data to be stored. For example:
13464:
13465: %Save_Parameters = ('Status' => 'scalar',
13466: 'chartoutputmode' => 'scalar',
13467: 'chartoutputdata' => 'scalar',
13468: 'Section' => 'array',
1.373 raeburn 13469: 'Group' => 'array',
1.153 matthew 13470: 'StudentData' => 'array',
13471: 'Maps' => 'array');
13472:
13473: Returns: both routines return nothing
13474:
1.631 raeburn 13475: =back
13476:
1.153 matthew 13477: =cut
13478:
13479: #######################################################
13480: #######################################################
13481: sub store_course_settings {
1.496 albertel 13482: return &store_settings($env{'request.course.id'},@_);
13483: }
13484:
13485: sub store_settings {
1.153 matthew 13486: # save to the environment
13487: # appenv the same items, just to be safe
1.300 albertel 13488: my $udom = $env{'user.domain'};
13489: my $uname = $env{'user.name'};
1.496 albertel 13490: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13491: my %SaveHash;
13492: my %AppHash;
13493: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13494: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13495: my $envname = 'environment.'.$basename;
1.258 albertel 13496: if (exists($env{'form.'.$setting})) {
1.153 matthew 13497: # Save this value away
13498: if ($type eq 'scalar' &&
1.258 albertel 13499: (! exists($env{$envname}) ||
13500: $env{$envname} ne $env{'form.'.$setting})) {
13501: $SaveHash{$basename} = $env{'form.'.$setting};
13502: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13503: } elsif ($type eq 'array') {
13504: my $stored_form;
1.258 albertel 13505: if (ref($env{'form.'.$setting})) {
1.153 matthew 13506: $stored_form = join(',',
13507: map {
1.369 www 13508: &escape($_);
1.258 albertel 13509: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13510: } else {
13511: $stored_form =
1.369 www 13512: &escape($env{'form.'.$setting});
1.153 matthew 13513: }
13514: # Determine if the array contents are the same.
1.258 albertel 13515: if ($stored_form ne $env{$envname}) {
1.153 matthew 13516: $SaveHash{$basename} = $stored_form;
13517: $AppHash{$envname} = $stored_form;
13518: }
13519: }
13520: }
13521: }
13522: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13523: $udom,$uname);
1.153 matthew 13524: if ($put_result !~ /^(ok|delayed)/) {
13525: &Apache::lonnet::logthis('unable to save form parameters, '.
13526: 'got error:'.$put_result);
13527: }
13528: # Make sure these settings stick around in this session, too
1.646 raeburn 13529: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13530: return;
13531: }
13532:
13533: sub restore_course_settings {
1.499 albertel 13534: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13535: }
13536:
13537: sub restore_settings {
13538: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13539: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13540: next if (exists($env{'form.'.$setting}));
1.496 albertel 13541: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13542: '.'.$setting;
1.258 albertel 13543: if (exists($env{$envname})) {
1.153 matthew 13544: if ($type eq 'scalar') {
1.258 albertel 13545: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13546: } elsif ($type eq 'array') {
1.258 albertel 13547: $env{'form.'.$setting} = [
1.153 matthew 13548: map {
1.369 www 13549: &unescape($_);
1.258 albertel 13550: } split(',',$env{$envname})
1.153 matthew 13551: ];
13552: }
13553: }
13554: }
1.127 matthew 13555: }
13556:
1.618 raeburn 13557: #######################################################
13558: #######################################################
13559:
13560: =pod
13561:
13562: =head1 Domain E-mail Routines
13563:
13564: =over 4
13565:
1.648 raeburn 13566: =item * &build_recipient_list()
1.618 raeburn 13567:
1.1075.2.44 raeburn 13568: Build recipient lists for following types of e-mail:
1.766 raeburn 13569: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 13570: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13571: module change checking, student/employee ID conflict checks, as
13572: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13573: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13574:
13575: Inputs:
1.1075.2.44 raeburn 13576: defmail (scalar - email address of default recipient),
13577: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13578: requestsmail, updatesmail, or idconflictsmail).
13579:
1.619 raeburn 13580: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 13581:
13582: origmail (scalar - email address of recipient from loncapa.conf,
13583: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13584:
1.655 raeburn 13585: Returns: comma separated list of addresses to which to send e-mail.
13586:
13587: =back
1.618 raeburn 13588:
13589: =cut
13590:
13591: ############################################################
13592: ############################################################
13593: sub build_recipient_list {
1.619 raeburn 13594: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13595: my @recipients;
13596: my $otheremails;
13597: my %domconfig =
13598: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13599: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13600: if (exists($domconfig{'contacts'}{$mailing})) {
13601: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13602: my @contacts = ('adminemail','supportemail');
13603: foreach my $item (@contacts) {
13604: if ($domconfig{'contacts'}{$mailing}{$item}) {
13605: my $addr = $domconfig{'contacts'}{$item};
13606: if (!grep(/^\Q$addr\E$/,@recipients)) {
13607: push(@recipients,$addr);
13608: }
1.619 raeburn 13609: }
1.766 raeburn 13610: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13611: }
13612: }
1.766 raeburn 13613: } elsif ($origmail ne '') {
13614: push(@recipients,$origmail);
1.618 raeburn 13615: }
1.619 raeburn 13616: } elsif ($origmail ne '') {
13617: push(@recipients,$origmail);
1.618 raeburn 13618: }
1.688 raeburn 13619: if (defined($defmail)) {
13620: if ($defmail ne '') {
13621: push(@recipients,$defmail);
13622: }
1.618 raeburn 13623: }
13624: if ($otheremails) {
1.619 raeburn 13625: my @others;
13626: if ($otheremails =~ /,/) {
13627: @others = split(/,/,$otheremails);
1.618 raeburn 13628: } else {
1.619 raeburn 13629: push(@others,$otheremails);
13630: }
13631: foreach my $addr (@others) {
13632: if (!grep(/^\Q$addr\E$/,@recipients)) {
13633: push(@recipients,$addr);
13634: }
1.618 raeburn 13635: }
13636: }
1.619 raeburn 13637: my $recipientlist = join(',',@recipients);
1.618 raeburn 13638: return $recipientlist;
13639: }
13640:
1.127 matthew 13641: ############################################################
13642: ############################################################
1.154 albertel 13643:
1.655 raeburn 13644: =pod
13645:
13646: =head1 Course Catalog Routines
13647:
13648: =over 4
13649:
13650: =item * &gather_categories()
13651:
13652: Converts category definitions - keys of categories hash stored in
13653: coursecategories in configuration.db on the primary library server in a
13654: domain - to an array. Also generates javascript and idx hash used to
13655: generate Domain Coordinator interface for editing Course Categories.
13656:
13657: Inputs:
1.663 raeburn 13658:
1.655 raeburn 13659: categories (reference to hash of category definitions).
1.663 raeburn 13660:
1.655 raeburn 13661: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13662: categories and subcategories).
1.663 raeburn 13663:
1.655 raeburn 13664: idx (reference to hash of counters used in Domain Coordinator interface for
13665: editing Course Categories).
1.663 raeburn 13666:
1.655 raeburn 13667: jsarray (reference to array of categories used to create Javascript arrays for
13668: Domain Coordinator interface for editing Course Categories).
13669:
13670: Returns: nothing
13671:
13672: Side effects: populates cats, idx and jsarray.
13673:
13674: =cut
13675:
13676: sub gather_categories {
13677: my ($categories,$cats,$idx,$jsarray) = @_;
13678: my %counters;
13679: my $num = 0;
13680: foreach my $item (keys(%{$categories})) {
13681: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13682: if ($container eq '' && $depth == 0) {
13683: $cats->[$depth][$categories->{$item}] = $cat;
13684: } else {
13685: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13686: }
13687: my ($escitem,$tail) = split(/:/,$item,2);
13688: if ($counters{$tail} eq '') {
13689: $counters{$tail} = $num;
13690: $num ++;
13691: }
13692: if (ref($idx) eq 'HASH') {
13693: $idx->{$item} = $counters{$tail};
13694: }
13695: if (ref($jsarray) eq 'ARRAY') {
13696: push(@{$jsarray->[$counters{$tail}]},$item);
13697: }
13698: }
13699: return;
13700: }
13701:
13702: =pod
13703:
13704: =item * &extract_categories()
13705:
13706: Used to generate breadcrumb trails for course categories.
13707:
13708: Inputs:
1.663 raeburn 13709:
1.655 raeburn 13710: categories (reference to hash of category definitions).
1.663 raeburn 13711:
1.655 raeburn 13712: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13713: categories and subcategories).
1.663 raeburn 13714:
1.655 raeburn 13715: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13716:
1.655 raeburn 13717: allitems (reference to hash - key is category key
13718: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13719:
1.655 raeburn 13720: idx (reference to hash of counters used in Domain Coordinator interface for
13721: editing Course Categories).
1.663 raeburn 13722:
1.655 raeburn 13723: jsarray (reference to array of categories used to create Javascript arrays for
13724: Domain Coordinator interface for editing Course Categories).
13725:
1.665 raeburn 13726: subcats (reference to hash of arrays containing all subcategories within each
13727: category, -recursive)
13728:
1.655 raeburn 13729: Returns: nothing
13730:
13731: Side effects: populates trails and allitems hash references.
13732:
13733: =cut
13734:
13735: sub extract_categories {
1.665 raeburn 13736: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13737: if (ref($categories) eq 'HASH') {
13738: &gather_categories($categories,$cats,$idx,$jsarray);
13739: if (ref($cats->[0]) eq 'ARRAY') {
13740: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13741: my $name = $cats->[0][$i];
13742: my $item = &escape($name).'::0';
13743: my $trailstr;
13744: if ($name eq 'instcode') {
13745: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13746: } elsif ($name eq 'communities') {
13747: $trailstr = &mt('Communities');
1.655 raeburn 13748: } else {
13749: $trailstr = $name;
13750: }
13751: if ($allitems->{$item} eq '') {
13752: push(@{$trails},$trailstr);
13753: $allitems->{$item} = scalar(@{$trails})-1;
13754: }
13755: my @parents = ($name);
13756: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13757: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13758: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13759: if (ref($subcats) eq 'HASH') {
13760: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13761: }
13762: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13763: }
13764: } else {
13765: if (ref($subcats) eq 'HASH') {
13766: $subcats->{$item} = [];
1.655 raeburn 13767: }
13768: }
13769: }
13770: }
13771: }
13772: return;
13773: }
13774:
13775: =pod
13776:
1.1075.2.56 raeburn 13777: =item * &recurse_categories()
1.655 raeburn 13778:
13779: Recursively used to generate breadcrumb trails for course categories.
13780:
13781: Inputs:
1.663 raeburn 13782:
1.655 raeburn 13783: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13784: categories and subcategories).
1.663 raeburn 13785:
1.655 raeburn 13786: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13787:
13788: category (current course category, for which breadcrumb trail is being generated).
13789:
13790: trails (reference to array of breadcrumb trails for each category).
13791:
1.655 raeburn 13792: allitems (reference to hash - key is category key
13793: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13794:
1.655 raeburn 13795: parents (array containing containers directories for current category,
13796: back to top level).
13797:
13798: Returns: nothing
13799:
13800: Side effects: populates trails and allitems hash references
13801:
13802: =cut
13803:
13804: sub recurse_categories {
1.665 raeburn 13805: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13806: my $shallower = $depth - 1;
13807: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13808: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13809: my $name = $cats->[$depth]{$category}[$k];
13810: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13811: my $trailstr = join(' -> ',(@{$parents},$category));
13812: if ($allitems->{$item} eq '') {
13813: push(@{$trails},$trailstr);
13814: $allitems->{$item} = scalar(@{$trails})-1;
13815: }
13816: my $deeper = $depth+1;
13817: push(@{$parents},$category);
1.665 raeburn 13818: if (ref($subcats) eq 'HASH') {
13819: my $subcat = &escape($name).':'.$category.':'.$depth;
13820: for (my $j=@{$parents}; $j>=0; $j--) {
13821: my $higher;
13822: if ($j > 0) {
13823: $higher = &escape($parents->[$j]).':'.
13824: &escape($parents->[$j-1]).':'.$j;
13825: } else {
13826: $higher = &escape($parents->[$j]).'::'.$j;
13827: }
13828: push(@{$subcats->{$higher}},$subcat);
13829: }
13830: }
13831: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13832: $subcats);
1.655 raeburn 13833: pop(@{$parents});
13834: }
13835: } else {
13836: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13837: my $trailstr = join(' -> ',(@{$parents},$category));
13838: if ($allitems->{$item} eq '') {
13839: push(@{$trails},$trailstr);
13840: $allitems->{$item} = scalar(@{$trails})-1;
13841: }
13842: }
13843: return;
13844: }
13845:
1.663 raeburn 13846: =pod
13847:
1.1075.2.56 raeburn 13848: =item * &assign_categories_table()
1.663 raeburn 13849:
13850: Create a datatable for display of hierarchical categories in a domain,
13851: with checkboxes to allow a course to be categorized.
13852:
13853: Inputs:
13854:
13855: cathash - reference to hash of categories defined for the domain (from
13856: configuration.db)
13857:
13858: currcat - scalar with an & separated list of categories assigned to a course.
13859:
1.919 raeburn 13860: type - scalar contains course type (Course or Community).
13861:
1.663 raeburn 13862: Returns: $output (markup to be displayed)
13863:
13864: =cut
13865:
13866: sub assign_categories_table {
1.919 raeburn 13867: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13868: my $output;
13869: if (ref($cathash) eq 'HASH') {
13870: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13871: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13872: $maxdepth = scalar(@cats);
13873: if (@cats > 0) {
13874: my $itemcount = 0;
13875: if (ref($cats[0]) eq 'ARRAY') {
13876: my @currcategories;
13877: if ($currcat ne '') {
13878: @currcategories = split('&',$currcat);
13879: }
1.919 raeburn 13880: my $table;
1.663 raeburn 13881: for (my $i=0; $i<@{$cats[0]}; $i++) {
13882: my $parent = $cats[0][$i];
1.919 raeburn 13883: next if ($parent eq 'instcode');
13884: if ($type eq 'Community') {
13885: next unless ($parent eq 'communities');
13886: } else {
13887: next if ($parent eq 'communities');
13888: }
1.663 raeburn 13889: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13890: my $item = &escape($parent).'::0';
13891: my $checked = '';
13892: if (@currcategories > 0) {
13893: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13894: $checked = ' checked="checked"';
1.663 raeburn 13895: }
13896: }
1.919 raeburn 13897: my $parent_title = $parent;
13898: if ($parent eq 'communities') {
13899: $parent_title = &mt('Communities');
13900: }
13901: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13902: '<input type="checkbox" name="usecategory" value="'.
13903: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13904: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13905: my $depth = 1;
13906: push(@path,$parent);
1.919 raeburn 13907: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13908: pop(@path);
1.919 raeburn 13909: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13910: $itemcount ++;
13911: }
1.919 raeburn 13912: if ($itemcount) {
13913: $output = &Apache::loncommon::start_data_table().
13914: $table.
13915: &Apache::loncommon::end_data_table();
13916: }
1.663 raeburn 13917: }
13918: }
13919: }
13920: return $output;
13921: }
13922:
13923: =pod
13924:
1.1075.2.56 raeburn 13925: =item * &assign_category_rows()
1.663 raeburn 13926:
13927: Create a datatable row for display of nested categories in a domain,
13928: with checkboxes to allow a course to be categorized,called recursively.
13929:
13930: Inputs:
13931:
13932: itemcount - track row number for alternating colors
13933:
13934: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13935: categories and subcategories.
13936:
13937: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13938:
13939: parent - parent of current category item
13940:
13941: path - Array containing all categories back up through the hierarchy from the
13942: current category to the top level.
13943:
13944: currcategories - reference to array of current categories assigned to the course
13945:
13946: Returns: $output (markup to be displayed).
13947:
13948: =cut
13949:
13950: sub assign_category_rows {
13951: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13952: my ($text,$name,$item,$chgstr);
13953: if (ref($cats) eq 'ARRAY') {
13954: my $maxdepth = scalar(@{$cats});
13955: if (ref($cats->[$depth]) eq 'HASH') {
13956: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13957: my $numchildren = @{$cats->[$depth]{$parent}};
13958: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 13959: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13960: for (my $j=0; $j<$numchildren; $j++) {
13961: $name = $cats->[$depth]{$parent}[$j];
13962: $item = &escape($name).':'.&escape($parent).':'.$depth;
13963: my $deeper = $depth+1;
13964: my $checked = '';
13965: if (ref($currcategories) eq 'ARRAY') {
13966: if (@{$currcategories} > 0) {
13967: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13968: $checked = ' checked="checked"';
1.663 raeburn 13969: }
13970: }
13971: }
1.664 raeburn 13972: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13973: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13974: $item.'"'.$checked.' />'.$name.'</label></span>'.
13975: '<input type="hidden" name="catname" value="'.$name.'" />'.
13976: '</td><td>';
1.663 raeburn 13977: if (ref($path) eq 'ARRAY') {
13978: push(@{$path},$name);
13979: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13980: pop(@{$path});
13981: }
13982: $text .= '</td></tr>';
13983: }
13984: $text .= '</table></td>';
13985: }
13986: }
13987: }
13988: return $text;
13989: }
13990:
1.1075.2.69 raeburn 13991: =pod
13992:
13993: =back
13994:
13995: =cut
13996:
1.655 raeburn 13997: ############################################################
13998: ############################################################
13999:
14000:
1.443 albertel 14001: sub commit_customrole {
1.664 raeburn 14002: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14003: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14004: ($start?', '.&mt('starting').' '.localtime($start):'').
14005: ($end?', ending '.localtime($end):'').': <b>'.
14006: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14007: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14008: '</b><br />';
14009: return $output;
14010: }
14011:
14012: sub commit_standardrole {
1.1075.2.31 raeburn 14013: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14014: my ($output,$logmsg,$linefeed);
14015: if ($context eq 'auto') {
14016: $linefeed = "\n";
14017: } else {
14018: $linefeed = "<br />\n";
14019: }
1.443 albertel 14020: if ($three eq 'st') {
1.541 raeburn 14021: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 14022: $one,$two,$sec,$context,$credits);
1.541 raeburn 14023: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14024: ($result eq 'unknown_course') || ($result eq 'refused')) {
14025: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14026: } else {
1.541 raeburn 14027: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14028: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14029: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14030: if ($context eq 'auto') {
14031: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14032: } else {
14033: $output .= '<b>'.$result.'</b>'.$linefeed.
14034: &mt('Add to classlist').': <b>ok</b>';
14035: }
14036: $output .= $linefeed;
1.443 albertel 14037: }
14038: } else {
14039: $output = &mt('Assigning').' '.$three.' in '.$url.
14040: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14041: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14042: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14043: if ($context eq 'auto') {
14044: $output .= $result.$linefeed;
14045: } else {
14046: $output .= '<b>'.$result.'</b>'.$linefeed;
14047: }
1.443 albertel 14048: }
14049: return $output;
14050: }
14051:
14052: sub commit_studentrole {
1.1075.2.31 raeburn 14053: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
14054: $credits) = @_;
1.626 raeburn 14055: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 14056: if ($context eq 'auto') {
14057: $linefeed = "\n";
14058: } else {
14059: $linefeed = '<br />'."\n";
14060: }
1.443 albertel 14061: if (defined($one) && defined($two)) {
14062: my $cid=$one.'_'.$two;
14063: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
14064: my $secchange = 0;
14065: my $expire_role_result;
14066: my $modify_section_result;
1.628 raeburn 14067: if ($oldsec ne '-1') {
14068: if ($oldsec ne $sec) {
1.443 albertel 14069: $secchange = 1;
1.628 raeburn 14070: my $now = time;
1.443 albertel 14071: my $uurl='/'.$cid;
14072: $uurl=~s/\_/\//g;
14073: if ($oldsec) {
14074: $uurl.='/'.$oldsec;
14075: }
1.626 raeburn 14076: $oldsecurl = $uurl;
1.628 raeburn 14077: $expire_role_result =
1.652 raeburn 14078: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 14079: if ($env{'request.course.sec'} ne '') {
14080: if ($expire_role_result eq 'refused') {
14081: my @roles = ('st');
14082: my @statuses = ('previous');
14083: my @roledoms = ($one);
14084: my $withsec = 1;
14085: my %roleshash =
14086: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
14087: \@statuses,\@roles,\@roledoms,$withsec);
14088: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
14089: my ($oldstart,$oldend) =
14090: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
14091: if ($oldend > 0 && $oldend <= $now) {
14092: $expire_role_result = 'ok';
14093: }
14094: }
14095: }
14096: }
1.443 albertel 14097: $result = $expire_role_result;
14098: }
14099: }
14100: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 14101: $modify_section_result =
14102: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
14103: undef,undef,undef,$sec,
14104: $end,$start,'','',$cid,
14105: '',$context,$credits);
1.443 albertel 14106: if ($modify_section_result =~ /^ok/) {
14107: if ($secchange == 1) {
1.628 raeburn 14108: if ($sec eq '') {
14109: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14110: } else {
14111: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14112: }
1.443 albertel 14113: } elsif ($oldsec eq '-1') {
1.628 raeburn 14114: if ($sec eq '') {
14115: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14116: } else {
14117: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14118: }
1.443 albertel 14119: } else {
1.628 raeburn 14120: if ($sec eq '') {
14121: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14122: } else {
14123: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14124: }
1.443 albertel 14125: }
14126: } else {
1.628 raeburn 14127: if ($secchange) {
14128: $$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;
14129: } else {
14130: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14131: }
1.443 albertel 14132: }
14133: $result = $modify_section_result;
14134: } elsif ($secchange == 1) {
1.628 raeburn 14135: if ($oldsec eq '') {
1.1075.2.20 raeburn 14136: $$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 14137: } else {
14138: $$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;
14139: }
1.626 raeburn 14140: if ($expire_role_result eq 'refused') {
14141: my $newsecurl = '/'.$cid;
14142: $newsecurl =~ s/\_/\//g;
14143: if ($sec ne '') {
14144: $newsecurl.='/'.$sec;
14145: }
14146: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14147: if ($sec eq '') {
14148: $$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;
14149: } else {
14150: $$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;
14151: }
14152: }
14153: }
1.443 albertel 14154: }
14155: } else {
1.626 raeburn 14156: $$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 14157: $result = "error: incomplete course id\n";
14158: }
14159: return $result;
14160: }
14161:
1.1075.2.25 raeburn 14162: sub show_role_extent {
14163: my ($scope,$context,$role) = @_;
14164: $scope =~ s{^/}{};
14165: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14166: push(@courseroles,'co');
14167: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14168: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14169: $scope =~ s{/}{_};
14170: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14171: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14172: my ($audom,$auname) = split(/\//,$scope);
14173: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14174: &Apache::loncommon::plainname($auname,$audom).'</span>');
14175: } else {
14176: $scope =~ s{/$}{};
14177: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14178: &Apache::lonnet::domain($scope,'description').'</span>');
14179: }
14180: }
14181:
1.443 albertel 14182: ############################################################
14183: ############################################################
14184:
1.566 albertel 14185: sub check_clone {
1.578 raeburn 14186: my ($args,$linefeed) = @_;
1.566 albertel 14187: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14188: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14189: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14190: my $clonemsg;
14191: my $can_clone = 0;
1.944 raeburn 14192: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14193: if ($lctype ne 'community') {
14194: $lctype = 'course';
14195: }
1.566 albertel 14196: if ($clonehome eq 'no_host') {
1.944 raeburn 14197: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14198: $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'});
14199: } else {
14200: $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'});
14201: }
1.566 albertel 14202: } else {
14203: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14204: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14205: if ($clonedesc{'type'} ne 'Community') {
14206: $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'});
14207: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14208: }
14209: }
1.882 raeburn 14210: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14211: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14212: $can_clone = 1;
14213: } else {
1.1075.2.95 raeburn 14214: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 14215: $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95 raeburn 14216: if ($clonehash{'cloners'} eq '') {
14217: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
14218: if ($domdefs{'canclone'}) {
14219: unless ($domdefs{'canclone'} eq 'none') {
14220: if ($domdefs{'canclone'} eq 'domain') {
14221: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
14222: $can_clone = 1;
14223: }
14224: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14225: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
14226: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
14227: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
14228: $can_clone = 1;
14229: }
14230: }
14231: }
1.908 raeburn 14232: }
1.1075.2.95 raeburn 14233: } else {
14234: my @cloners = split(/,/,$clonehash{'cloners'});
14235: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 14236: $can_clone = 1;
1.1075.2.95 raeburn 14237: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 14238: $can_clone = 1;
1.1075.2.96 raeburn 14239: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14240: $can_clone = 1;
1.1075.2.95 raeburn 14241: }
14242: unless ($can_clone) {
1.1075.2.96 raeburn 14243: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14244: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1075.2.95 raeburn 14245: my (%gotdomdefaults,%gotcodedefaults);
14246: foreach my $cloner (@cloners) {
14247: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
14248: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
14249: my (%codedefaults,@code_order);
14250: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
14251: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
14252: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
14253: }
14254: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
14255: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
14256: }
14257: } else {
14258: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
14259: \%codedefaults,
14260: \@code_order);
14261: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
14262: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
14263: }
14264: if (@code_order > 0) {
14265: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
14266: $cloner,$clonehash{'internal.coursecode'},
14267: $args->{'crscode'})) {
14268: $can_clone = 1;
14269: last;
14270: }
14271: }
14272: }
14273: }
14274: }
1.1075.2.96 raeburn 14275: }
14276: }
14277: unless ($can_clone) {
14278: my $ccrole = 'cc';
14279: if ($args->{'crstype'} eq 'Community') {
14280: $ccrole = 'co';
14281: }
14282: my %roleshash =
14283: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14284: $args->{'ccdomain'},
14285: 'userroles',['active'],[$ccrole],
14286: [$args->{'clonedomain'}]);
14287: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
14288: $can_clone = 1;
14289: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
14290: $args->{'ccuname'},$args->{'ccdomain'})) {
14291: $can_clone = 1;
1.1075.2.95 raeburn 14292: }
14293: }
14294: unless ($can_clone) {
14295: if ($args->{'crstype'} eq 'Community') {
14296: $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'});
14297: } else {
14298: $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
1.578 raeburn 14299: }
1.566 albertel 14300: }
1.578 raeburn 14301: }
1.566 albertel 14302: }
14303: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14304: }
14305:
1.444 albertel 14306: sub construct_course {
1.1075.2.59 raeburn 14307: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14308: my $outcome;
1.541 raeburn 14309: my $linefeed = '<br />'."\n";
14310: if ($context eq 'auto') {
14311: $linefeed = "\n";
14312: }
1.566 albertel 14313:
14314: #
14315: # Are we cloning?
14316: #
14317: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14318: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14319: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14320: if ($context ne 'auto') {
1.578 raeburn 14321: if ($clonemsg ne '') {
14322: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14323: }
1.566 albertel 14324: }
14325: $outcome .= $clonemsg.$linefeed;
14326:
14327: if (!$can_clone) {
14328: return (0,$outcome);
14329: }
14330: }
14331:
1.444 albertel 14332: #
14333: # Open course
14334: #
14335: my $crstype = lc($args->{'crstype'});
14336: my %cenv=();
14337: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14338: $args->{'cdescr'},
14339: $args->{'curl'},
14340: $args->{'course_home'},
14341: $args->{'nonstandard'},
14342: $args->{'crscode'},
14343: $args->{'ccuname'}.':'.
14344: $args->{'ccdomain'},
1.882 raeburn 14345: $args->{'crstype'},
1.885 raeburn 14346: $cnum,$context,$category);
1.444 albertel 14347:
14348: # Note: The testing routines depend on this being output; see
14349: # Utils::Course. This needs to at least be output as a comment
14350: # if anyone ever decides to not show this, and Utils::Course::new
14351: # will need to be suitably modified.
1.541 raeburn 14352: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14353: if ($$courseid =~ /^error:/) {
14354: return (0,$outcome);
14355: }
14356:
1.444 albertel 14357: #
14358: # Check if created correctly
14359: #
1.479 albertel 14360: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14361: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14362: if ($crsuhome eq 'no_host') {
14363: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14364: return (0,$outcome);
14365: }
1.541 raeburn 14366: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14367:
1.444 albertel 14368: #
1.566 albertel 14369: # Do the cloning
14370: #
14371: if ($can_clone && $cloneid) {
14372: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14373: if ($context ne 'auto') {
14374: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14375: }
14376: $outcome .= $clonemsg.$linefeed;
14377: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14378: # Copy all files
1.637 www 14379: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14380: # Restore URL
1.566 albertel 14381: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14382: # Restore title
1.566 albertel 14383: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14384: # Restore creation date, creator and creation context.
14385: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14386: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14387: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14388: # Mark as cloned
1.566 albertel 14389: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14390: # Need to clone grading mode
14391: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14392: $cenv{'grading'}=$newenv{'grading'};
14393: # Do not clone these environment entries
14394: &Apache::lonnet::del('environment',
14395: ['default_enrollment_start_date',
14396: 'default_enrollment_end_date',
14397: 'question.email',
14398: 'policy.email',
14399: 'comment.email',
14400: 'pch.users.denied',
1.725 raeburn 14401: 'plc.users.denied',
14402: 'hidefromcat',
1.1075.2.36 raeburn 14403: 'checkforpriv',
1.1075.2.59 raeburn 14404: 'categories',
14405: 'internal.uniquecode'],
1.638 www 14406: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 14407: if ($args->{'textbook'}) {
14408: $cenv{'internal.textbook'} = $args->{'textbook'};
14409: }
1.444 albertel 14410: }
1.566 albertel 14411:
1.444 albertel 14412: #
14413: # Set environment (will override cloned, if existing)
14414: #
14415: my @sections = ();
14416: my @xlists = ();
14417: if ($args->{'crstype'}) {
14418: $cenv{'type'}=$args->{'crstype'};
14419: }
14420: if ($args->{'crsid'}) {
14421: $cenv{'courseid'}=$args->{'crsid'};
14422: }
14423: if ($args->{'crscode'}) {
14424: $cenv{'internal.coursecode'}=$args->{'crscode'};
14425: }
14426: if ($args->{'crsquota'} ne '') {
14427: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14428: } else {
14429: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14430: }
14431: if ($args->{'ccuname'}) {
14432: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14433: ':'.$args->{'ccdomain'};
14434: } else {
14435: $cenv{'internal.courseowner'} = $args->{'curruser'};
14436: }
1.1075.2.31 raeburn 14437: if ($args->{'defaultcredits'}) {
14438: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14439: }
1.444 albertel 14440: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14441: if ($args->{'crssections'}) {
14442: $cenv{'internal.sectionnums'} = '';
14443: if ($args->{'crssections'} =~ m/,/) {
14444: @sections = split/,/,$args->{'crssections'};
14445: } else {
14446: $sections[0] = $args->{'crssections'};
14447: }
14448: if (@sections > 0) {
14449: foreach my $item (@sections) {
14450: my ($sec,$gp) = split/:/,$item;
14451: my $class = $args->{'crscode'}.$sec;
14452: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14453: $cenv{'internal.sectionnums'} .= $item.',';
14454: unless ($addcheck eq 'ok') {
14455: push @badclasses, $class;
14456: }
14457: }
14458: $cenv{'internal.sectionnums'} =~ s/,$//;
14459: }
14460: }
14461: # do not hide course coordinator from staff listing,
14462: # even if privileged
14463: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 14464: # add course coordinator's domain to domains to check for privileged users
14465: # if different to course domain
14466: if ($$crsudom ne $args->{'ccdomain'}) {
14467: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14468: }
1.444 albertel 14469: # add crosslistings
14470: if ($args->{'crsxlist'}) {
14471: $cenv{'internal.crosslistings'}='';
14472: if ($args->{'crsxlist'} =~ m/,/) {
14473: @xlists = split/,/,$args->{'crsxlist'};
14474: } else {
14475: $xlists[0] = $args->{'crsxlist'};
14476: }
14477: if (@xlists > 0) {
14478: foreach my $item (@xlists) {
14479: my ($xl,$gp) = split/:/,$item;
14480: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14481: $cenv{'internal.crosslistings'} .= $item.',';
14482: unless ($addcheck eq 'ok') {
14483: push @badclasses, $xl;
14484: }
14485: }
14486: $cenv{'internal.crosslistings'} =~ s/,$//;
14487: }
14488: }
14489: if ($args->{'autoadds'}) {
14490: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14491: }
14492: if ($args->{'autodrops'}) {
14493: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14494: }
14495: # check for notification of enrollment changes
14496: my @notified = ();
14497: if ($args->{'notify_owner'}) {
14498: if ($args->{'ccuname'} ne '') {
14499: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14500: }
14501: }
14502: if ($args->{'notify_dc'}) {
14503: if ($uname ne '') {
1.630 raeburn 14504: push(@notified,$uname.':'.$udom);
1.444 albertel 14505: }
14506: }
14507: if (@notified > 0) {
14508: my $notifylist;
14509: if (@notified > 1) {
14510: $notifylist = join(',',@notified);
14511: } else {
14512: $notifylist = $notified[0];
14513: }
14514: $cenv{'internal.notifylist'} = $notifylist;
14515: }
14516: if (@badclasses > 0) {
14517: my %lt=&Apache::lonlocal::texthash(
14518: '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',
14519: 'dnhr' => 'does not have rights to access enrollment in these classes',
14520: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14521: );
1.541 raeburn 14522: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14523: ' ('.$lt{'adby'}.')';
14524: if ($context eq 'auto') {
14525: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14526: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14527: foreach my $item (@badclasses) {
14528: if ($context eq 'auto') {
14529: $outcome .= " - $item\n";
14530: } else {
14531: $outcome .= "<li>$item</li>\n";
14532: }
14533: }
14534: if ($context eq 'auto') {
14535: $outcome .= $linefeed;
14536: } else {
1.566 albertel 14537: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14538: }
14539: }
1.444 albertel 14540: }
14541: if ($args->{'no_end_date'}) {
14542: $args->{'endaccess'} = 0;
14543: }
14544: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14545: $cenv{'internal.autoend'}=$args->{'enrollend'};
14546: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14547: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14548: if ($args->{'showphotos'}) {
14549: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14550: }
14551: $cenv{'internal.authtype'} = $args->{'authtype'};
14552: $cenv{'internal.autharg'} = $args->{'autharg'};
14553: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14554: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14555: 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');
14556: if ($context eq 'auto') {
14557: $outcome .= $krb_msg;
14558: } else {
1.566 albertel 14559: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14560: }
14561: $outcome .= $linefeed;
1.444 albertel 14562: }
14563: }
14564: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14565: if ($args->{'setpolicy'}) {
14566: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14567: }
14568: if ($args->{'setcontent'}) {
14569: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14570: }
14571: }
14572: if ($args->{'reshome'}) {
14573: $cenv{'reshome'}=$args->{'reshome'}.'/';
14574: $cenv{'reshome'}=~s/\/+$/\//;
14575: }
14576: #
14577: # course has keyed access
14578: #
14579: if ($args->{'setkeys'}) {
14580: $cenv{'keyaccess'}='yes';
14581: }
14582: # if specified, key authority is not course, but user
14583: # only active if keyaccess is yes
14584: if ($args->{'keyauth'}) {
1.487 albertel 14585: my ($user,$domain) = split(':',$args->{'keyauth'});
14586: $user = &LONCAPA::clean_username($user);
14587: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14588: if ($user ne '' && $domain ne '') {
1.487 albertel 14589: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14590: }
14591: }
14592:
1.1075.2.59 raeburn 14593: #
14594: # generate and store uniquecode (available to course requester), if course should have one.
14595: #
14596: if ($args->{'uniquecode'}) {
14597: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14598: if ($code) {
14599: $cenv{'internal.uniquecode'} = $code;
14600: my %crsinfo =
14601: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14602: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14603: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14604: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14605: }
14606: if (ref($coderef)) {
14607: $$coderef = $code;
14608: }
14609: }
14610: }
14611:
1.444 albertel 14612: if ($args->{'disresdis'}) {
14613: $cenv{'pch.roles.denied'}='st';
14614: }
14615: if ($args->{'disablechat'}) {
14616: $cenv{'plc.roles.denied'}='st';
14617: }
14618:
14619: # Record we've not yet viewed the Course Initialization Helper for this
14620: # course
14621: $cenv{'course.helper.not.run'} = 1;
14622: #
14623: # Use new Randomseed
14624: #
14625: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14626: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14627: #
14628: # The encryption code and receipt prefix for this course
14629: #
14630: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14631: $cenv{'internal.encpref'}=100+int(9*rand(99));
14632: #
14633: # By default, use standard grading
14634: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14635:
1.541 raeburn 14636: $outcome .= $linefeed.&mt('Setting environment').': '.
14637: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14638: #
14639: # Open all assignments
14640: #
14641: if ($args->{'openall'}) {
14642: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14643: my %storecontent = ($storeunder => time,
14644: $storeunder.'.type' => 'date_start');
14645:
14646: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14647: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14648: }
14649: #
14650: # Set first page
14651: #
14652: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14653: || ($cloneid)) {
1.445 albertel 14654: use LONCAPA::map;
1.444 albertel 14655: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14656:
14657: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14658: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14659:
1.444 albertel 14660: $outcome .= ($fatal?$errtext:'read ok').' - ';
14661: my $title; my $url;
14662: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14663: $title=&mt('Syllabus');
1.444 albertel 14664: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14665: } else {
1.963 raeburn 14666: $title=&mt('Table of Contents');
1.444 albertel 14667: $url='/adm/navmaps';
14668: }
1.445 albertel 14669:
14670: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14671: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14672:
14673: if ($errtext) { $fatal=2; }
1.541 raeburn 14674: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14675: }
1.566 albertel 14676:
14677: return (1,$outcome);
1.444 albertel 14678: }
14679:
1.1075.2.59 raeburn 14680: sub make_unique_code {
14681: my ($cdom,$cnum) = @_;
14682: # get lock on uniquecodes db
14683: my $lockhash = {
14684: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14685: ':'.$env{'user.domain'},
14686: };
14687: my $tries = 0;
14688: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14689: my ($code,$error);
14690:
14691: while (($gotlock ne 'ok') && ($tries<3)) {
14692: $tries ++;
14693: sleep 1;
14694: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14695: }
14696: if ($gotlock eq 'ok') {
14697: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14698: my $gotcode;
14699: my $attempts = 0;
14700: while ((!$gotcode) && ($attempts < 100)) {
14701: $code = &generate_code();
14702: if (!exists($currcodes{$code})) {
14703: $gotcode = 1;
14704: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14705: $error = 'nostore';
14706: }
14707: }
14708: $attempts ++;
14709: }
14710: my @del_lock = ($cnum."\0".'uniquecodes');
14711: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14712: } else {
14713: $error = 'nolock';
14714: }
14715: return ($code,$error);
14716: }
14717:
14718: sub generate_code {
14719: my $code;
14720: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14721: for (my $i=0; $i<6; $i++) {
14722: my $lettnum = int (rand 2);
14723: my $item = '';
14724: if ($lettnum) {
14725: $item = $letts[int( rand(18) )];
14726: } else {
14727: $item = 1+int( rand(8) );
14728: }
14729: $code .= $item;
14730: }
14731: return $code;
14732: }
14733:
1.444 albertel 14734: ############################################################
14735: ############################################################
14736:
1.953 droeschl 14737: #SD
14738: # only Community and Course, or anything else?
1.378 raeburn 14739: sub course_type {
14740: my ($cid) = @_;
14741: if (!defined($cid)) {
14742: $cid = $env{'request.course.id'};
14743: }
1.404 albertel 14744: if (defined($env{'course.'.$cid.'.type'})) {
14745: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14746: } else {
14747: return 'Course';
1.377 raeburn 14748: }
14749: }
1.156 albertel 14750:
1.406 raeburn 14751: sub group_term {
14752: my $crstype = &course_type();
14753: my %names = (
14754: 'Course' => 'group',
1.865 raeburn 14755: 'Community' => 'group',
1.406 raeburn 14756: );
14757: return $names{$crstype};
14758: }
14759:
1.902 raeburn 14760: sub course_types {
1.1075.2.59 raeburn 14761: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14762: my %typename = (
14763: official => 'Official course',
14764: unofficial => 'Unofficial course',
14765: community => 'Community',
1.1075.2.59 raeburn 14766: textbook => 'Textbook course',
1.902 raeburn 14767: );
14768: return (\@types,\%typename);
14769: }
14770:
1.156 albertel 14771: sub icon {
14772: my ($file)=@_;
1.505 albertel 14773: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14774: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14775: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14776: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14777: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14778: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14779: $curfext.".gif") {
14780: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14781: $curfext.".gif";
14782: }
14783: }
1.249 albertel 14784: return &lonhttpdurl($iconname);
1.154 albertel 14785: }
1.84 albertel 14786:
1.575 albertel 14787: sub lonhttpdurl {
1.692 www 14788: #
14789: # Had been used for "small fry" static images on separate port 8080.
14790: # Modify here if lightweight http functionality desired again.
14791: # Currently eliminated due to increasing firewall issues.
14792: #
1.575 albertel 14793: my ($url)=@_;
1.692 www 14794: return $url;
1.215 albertel 14795: }
14796:
1.213 albertel 14797: sub connection_aborted {
14798: my ($r)=@_;
14799: $r->print(" ");$r->rflush();
14800: my $c = $r->connection;
14801: return $c->aborted();
14802: }
14803:
1.221 foxr 14804: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14805: # strings as 'strings'.
14806: sub escape_single {
1.221 foxr 14807: my ($input) = @_;
1.223 albertel 14808: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14809: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14810: return $input;
14811: }
1.223 albertel 14812:
1.222 foxr 14813: # Same as escape_single, but escape's "'s This
14814: # can be used for "strings"
14815: sub escape_double {
14816: my ($input) = @_;
14817: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14818: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14819: return $input;
14820: }
1.223 albertel 14821:
1.222 foxr 14822: # Escapes the last element of a full URL.
14823: sub escape_url {
14824: my ($url) = @_;
1.238 raeburn 14825: my @urlslices = split(/\//, $url,-1);
1.369 www 14826: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 14827: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 14828: }
1.462 albertel 14829:
1.820 raeburn 14830: sub compare_arrays {
14831: my ($arrayref1,$arrayref2) = @_;
14832: my (@difference,%count);
14833: @difference = ();
14834: %count = ();
14835: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14836: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14837: foreach my $element (keys(%count)) {
14838: if ($count{$element} == 1) {
14839: push(@difference,$element);
14840: }
14841: }
14842: }
14843: return @difference;
14844: }
14845:
1.817 bisitz 14846: # -------------------------------------------------------- Initialize user login
1.462 albertel 14847: sub init_user_environment {
1.463 albertel 14848: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14849: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14850:
14851: my $public=($username eq 'public' && $domain eq 'public');
14852:
14853: # See if old ID present, if so, remove
14854:
1.1062 raeburn 14855: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14856: my $now=time;
14857:
14858: if ($public) {
14859: my $max_public=100;
14860: my $oldest;
14861: my $oldest_time=0;
14862: for(my $next=1;$next<=$max_public;$next++) {
14863: if (-e $lonids."/publicuser_$next.id") {
14864: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14865: if ($mtime<$oldest_time || !$oldest_time) {
14866: $oldest_time=$mtime;
14867: $oldest=$next;
14868: }
14869: } else {
14870: $cookie="publicuser_$next";
14871: last;
14872: }
14873: }
14874: if (!$cookie) { $cookie="publicuser_$oldest"; }
14875: } else {
1.463 albertel 14876: # if this isn't a robot, kill any existing non-robot sessions
14877: if (!$args->{'robot'}) {
14878: opendir(DIR,$lonids);
14879: while ($filename=readdir(DIR)) {
14880: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14881: unlink($lonids.'/'.$filename);
14882: }
1.462 albertel 14883: }
1.463 albertel 14884: closedir(DIR);
1.1075.2.84 raeburn 14885: # If there is a undeleted lockfile for the user's paste buffer remove it.
14886: my $namespace = 'nohist_courseeditor';
14887: my $lockingkey = 'paste'."\0".'locked_num';
14888: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
14889: $domain,$username);
14890: if (exists($lockhash{$lockingkey})) {
14891: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
14892: unless ($delresult eq 'ok') {
14893: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
14894: }
14895: }
1.462 albertel 14896: }
14897: # Give them a new cookie
1.463 albertel 14898: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14899: : $now.$$.int(rand(10000)));
1.463 albertel 14900: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14901:
14902: # Initialize roles
14903:
1.1062 raeburn 14904: ($userroles,$firstaccenv,$timerintenv) =
14905: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14906: }
14907: # ------------------------------------ Check browser type and MathML capability
14908:
1.1075.2.77 raeburn 14909: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14910: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14911:
14912: # ------------------------------------------------------------- Get environment
14913:
14914: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14915: my ($tmp) = keys(%userenv);
14916: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14917: } else {
14918: undef(%userenv);
14919: }
14920: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14921: $form->{'interface'}=$userenv{'interface'};
14922: }
14923: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14924:
14925: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14926: foreach my $option ('interface','localpath','localres') {
14927: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14928: }
14929: # --------------------------------------------------------- Write first profile
14930:
14931: {
14932: my %initial_env =
14933: ("user.name" => $username,
14934: "user.domain" => $domain,
14935: "user.home" => $authhost,
14936: "browser.type" => $clientbrowser,
14937: "browser.version" => $clientversion,
14938: "browser.mathml" => $clientmathml,
14939: "browser.unicode" => $clientunicode,
14940: "browser.os" => $clientos,
1.1075.2.42 raeburn 14941: "browser.mobile" => $clientmobile,
14942: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 14943: "browser.osversion" => $clientosversion,
1.462 albertel 14944: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14945: "request.course.fn" => '',
14946: "request.course.uri" => '',
14947: "request.course.sec" => '',
14948: "request.role" => 'cm',
14949: "request.role.adv" => $env{'user.adv'},
14950: "request.host" => $ENV{'REMOTE_ADDR'},);
14951:
14952: if ($form->{'localpath'}) {
14953: $initial_env{"browser.localpath"} = $form->{'localpath'};
14954: $initial_env{"browser.localres"} = $form->{'localres'};
14955: }
14956:
14957: if ($form->{'interface'}) {
14958: $form->{'interface'}=~s/\W//gs;
14959: $initial_env{"browser.interface"} = $form->{'interface'};
14960: $env{'browser.interface'}=$form->{'interface'};
14961: }
14962:
1.1075.2.54 raeburn 14963: if ($form->{'iptoken'}) {
14964: my $lonhost = $r->dir_config('lonHostID');
14965: $initial_env{"user.noloadbalance"} = $lonhost;
14966: $env{'user.noloadbalance'} = $lonhost;
14967: }
14968:
1.981 raeburn 14969: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14970: my %domdef;
14971: unless ($domain eq 'public') {
14972: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14973: }
1.980 raeburn 14974:
1.1075.2.7 raeburn 14975: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14976: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14977: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14978: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14979: }
14980:
1.1075.2.59 raeburn 14981: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14982: $userenv{'canrequest.'.$crstype} =
14983: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14984: 'reload','requestcourses',
14985: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14986: }
14987:
1.1075.2.14 raeburn 14988: $userenv{'canrequest.author'} =
14989: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14990: 'reload','requestauthor',
14991: \%userenv,\%domdef,\%is_adv);
14992: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14993: $domain,$username);
14994: my $reqstatus = $reqauthor{'author_status'};
14995: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14996: if (ref($reqauthor{'author'}) eq 'HASH') {
14997: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14998: $reqauthor{'author'}{'timestamp'};
14999: }
15000: }
15001:
1.462 albertel 15002: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15003:
1.462 albertel 15004: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15005: &GDBM_WRCREAT(),0640)) {
15006: &_add_to_env(\%disk_env,\%initial_env);
15007: &_add_to_env(\%disk_env,\%userenv,'environment.');
15008: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15009: if (ref($firstaccenv) eq 'HASH') {
15010: &_add_to_env(\%disk_env,$firstaccenv);
15011: }
15012: if (ref($timerintenv) eq 'HASH') {
15013: &_add_to_env(\%disk_env,$timerintenv);
15014: }
1.463 albertel 15015: if (ref($args->{'extra_env'})) {
15016: &_add_to_env(\%disk_env,$args->{'extra_env'});
15017: }
1.462 albertel 15018: untie(%disk_env);
15019: } else {
1.705 tempelho 15020: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
15021: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 15022: return 'error: '.$!;
15023: }
15024: }
15025: $env{'request.role'}='cm';
15026: $env{'request.role.adv'}=$env{'user.adv'};
15027: $env{'browser.type'}=$clientbrowser;
15028:
15029: return $cookie;
15030:
15031: }
15032:
15033: sub _add_to_env {
15034: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 15035: if (ref($env_data) eq 'HASH') {
15036: while (my ($key,$value) = each(%$env_data)) {
15037: $idf->{$prefix.$key} = $value;
15038: $env{$prefix.$key} = $value;
15039: }
1.462 albertel 15040: }
15041: }
15042:
1.685 tempelho 15043: # --- Get the symbolic name of a problem and the url
15044: sub get_symb {
15045: my ($request,$silent) = @_;
1.726 raeburn 15046: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 15047: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
15048: if ($symb eq '') {
15049: if (!$silent) {
1.1071 raeburn 15050: if (ref($request)) {
15051: $request->print("Unable to handle ambiguous references:$url:.");
15052: }
1.685 tempelho 15053: return ();
15054: }
15055: }
15056: &Apache::lonenc::check_decrypt(\$symb);
15057: return ($symb);
15058: }
15059:
15060: # --------------------------------------------------------------Get annotation
15061:
15062: sub get_annotation {
15063: my ($symb,$enc) = @_;
15064:
15065: my $key = $symb;
15066: if (!$enc) {
15067: $key =
15068: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
15069: }
15070: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
15071: return $annotation{$key};
15072: }
15073:
15074: sub clean_symb {
1.731 raeburn 15075: my ($symb,$delete_enc) = @_;
1.685 tempelho 15076:
15077: &Apache::lonenc::check_decrypt(\$symb);
15078: my $enc = $env{'request.enc'};
1.731 raeburn 15079: if ($delete_enc) {
1.730 raeburn 15080: delete($env{'request.enc'});
15081: }
1.685 tempelho 15082:
15083: return ($symb,$enc);
15084: }
1.462 albertel 15085:
1.1075.2.69 raeburn 15086: ############################################################
15087: ############################################################
15088:
15089: =pod
15090:
15091: =head1 Routines for building display used to search for courses
15092:
15093:
15094: =over 4
15095:
15096: =item * &build_filters()
15097:
15098: Create markup for a table used to set filters to use when selecting
15099: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
15100: and quotacheck.pl
15101:
15102:
15103: Inputs:
15104:
15105: filterlist - anonymous array of fields to include as potential filters
15106:
15107: crstype - course type
15108:
15109: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
15110: to pop-open a course selector (will contain "extra element").
15111:
15112: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
15113:
15114: filter - anonymous hash of criteria and their values
15115:
15116: action - form action
15117:
15118: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
15119:
15120: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
15121:
15122: cloneruname - username of owner of new course who wants to clone
15123:
15124: clonerudom - domain of owner of new course who wants to clone
15125:
15126: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
15127:
15128: codetitlesref - reference to array of titles of components in institutional codes (official courses)
15129:
15130: codedom - domain
15131:
15132: formname - value of form element named "form".
15133:
15134: fixeddom - domain, if fixed.
15135:
15136: prevphase - value to assign to form element named "phase" when going back to the previous screen
15137:
15138: cnameelement - name of form element in form on opener page which will receive title of selected course
15139:
15140: cnumelement - name of form element in form on opener page which will receive courseID of selected course
15141:
15142: cdomelement - name of form element in form on opener page which will receive domain of selected course
15143:
15144: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
15145:
15146: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
15147:
15148: clonewarning - warning message about missing information for intended course owner when DC creates a course
15149:
15150:
15151: Returns: $output - HTML for display of search criteria, and hidden form elements.
15152:
15153:
15154: Side Effects: None
15155:
15156: =cut
15157:
15158: # ---------------------------------------------- search for courses based on last activity etc.
15159:
15160: sub build_filters {
15161: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
15162: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
15163: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
15164: $cnameelement,$cnumelement,$cdomelement,$setroles,
15165: $clonetext,$clonewarning) = @_;
15166: my ($list,$jscript);
15167: my $onchange = 'javascript:updateFilters(this)';
15168: my ($domainselectform,$sincefilterform,$createdfilterform,
15169: $ownerdomselectform,$persondomselectform,$instcodeform,
15170: $typeselectform,$instcodetitle);
15171: if ($formname eq '') {
15172: $formname = $caller;
15173: }
15174: foreach my $item (@{$filterlist}) {
15175: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
15176: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
15177: if ($item eq 'domainfilter') {
15178: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
15179: } elsif ($item eq 'coursefilter') {
15180: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
15181: } elsif ($item eq 'ownerfilter') {
15182: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15183: } elsif ($item eq 'ownerdomfilter') {
15184: $filter->{'ownerdomfilter'} =
15185: &LONCAPA::clean_domain($filter->{$item});
15186: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
15187: 'ownerdomfilter',1);
15188: } elsif ($item eq 'personfilter') {
15189: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15190: } elsif ($item eq 'persondomfilter') {
15191: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15192: 'persondomfilter',1);
15193: } else {
15194: $filter->{$item} =~ s/\W//g;
15195: }
15196: if (!$filter->{$item}) {
15197: $filter->{$item} = '';
15198: }
15199: }
15200: if ($item eq 'domainfilter') {
15201: my $allow_blank = 1;
15202: if ($formname eq 'portform') {
15203: $allow_blank=0;
15204: } elsif ($formname eq 'studentform') {
15205: $allow_blank=0;
15206: }
15207: if ($fixeddom) {
15208: $domainselectform = '<input type="hidden" name="domainfilter"'.
15209: ' value="'.$codedom.'" />'.
15210: &Apache::lonnet::domain($codedom,'description');
15211: } else {
15212: $domainselectform = &select_dom_form($filter->{$item},
15213: 'domainfilter',
15214: $allow_blank,'',$onchange);
15215: }
15216: } else {
15217: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15218: }
15219: }
15220:
15221: # last course activity filter and selection
15222: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15223:
15224: # course created filter and selection
15225: if (exists($filter->{'createdfilter'})) {
15226: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15227: }
15228:
15229: my %lt = &Apache::lonlocal::texthash(
15230: 'cac' => "$crstype Activity",
15231: 'ccr' => "$crstype Created",
15232: 'cde' => "$crstype Title",
15233: 'cdo' => "$crstype Domain",
15234: 'ins' => 'Institutional Code',
15235: 'inc' => 'Institutional Categorization',
15236: 'cow' => "$crstype Owner/Co-owner",
15237: 'cop' => "$crstype Personnel Includes",
15238: 'cog' => 'Type',
15239: );
15240:
15241: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15242: my $typeval = 'Course';
15243: if ($crstype eq 'Community') {
15244: $typeval = 'Community';
15245: }
15246: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15247: } else {
15248: $typeselectform = '<select name="type" size="1"';
15249: if ($onchange) {
15250: $typeselectform .= ' onchange="'.$onchange.'"';
15251: }
15252: $typeselectform .= '>'."\n";
15253: foreach my $posstype ('Course','Community') {
15254: $typeselectform.='<option value="'.$posstype.'"'.
15255: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
15256: }
15257: $typeselectform.="</select>";
15258: }
15259:
15260: my ($cloneableonlyform,$cloneabletitle);
15261: if (exists($filter->{'cloneableonly'})) {
15262: my $cloneableon = '';
15263: my $cloneableoff = ' checked="checked"';
15264: if ($filter->{'cloneableonly'}) {
15265: $cloneableon = $cloneableoff;
15266: $cloneableoff = '';
15267: }
15268: $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>';
15269: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 15270: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 15271: } else {
15272: $cloneabletitle = &mt('Cloneable by you');
15273: }
15274: }
15275: my $officialjs;
15276: if ($crstype eq 'Course') {
15277: if (exists($filter->{'instcodefilter'})) {
15278: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15279: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15280: if ($codedom) {
15281: $officialjs = 1;
15282: ($instcodeform,$jscript,$$numtitlesref) =
15283: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15284: $officialjs,$codetitlesref);
15285: if ($jscript) {
15286: $jscript = '<script type="text/javascript">'."\n".
15287: '// <![CDATA['."\n".
15288: $jscript."\n".
15289: '// ]]>'."\n".
15290: '</script>'."\n";
15291: }
15292: }
15293: if ($instcodeform eq '') {
15294: $instcodeform =
15295: '<input type="text" name="instcodefilter" size="10" value="'.
15296: $list->{'instcodefilter'}.'" />';
15297: $instcodetitle = $lt{'ins'};
15298: } else {
15299: $instcodetitle = $lt{'inc'};
15300: }
15301: if ($fixeddom) {
15302: $instcodetitle .= '<br />('.$codedom.')';
15303: }
15304: }
15305: }
15306: my $output = qq|
15307: <form method="post" name="filterpicker" action="$action">
15308: <input type="hidden" name="form" value="$formname" />
15309: |;
15310: if ($formname eq 'modifycourse') {
15311: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15312: '<input type="hidden" name="prevphase" value="'.
15313: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 15314: } elsif ($formname eq 'quotacheck') {
15315: $output .= qq|
15316: <input type="hidden" name="sortby" value="" />
15317: <input type="hidden" name="sortorder" value="" />
15318: |;
15319: } else {
1.1075.2.69 raeburn 15320: my $name_input;
15321: if ($cnameelement ne '') {
15322: $name_input = '<input type="hidden" name="cnameelement" value="'.
15323: $cnameelement.'" />';
15324: }
15325: $output .= qq|
15326: <input type="hidden" name="cnumelement" value="$cnumelement" />
15327: <input type="hidden" name="cdomelement" value="$cdomelement" />
15328: $name_input
15329: $roleelement
15330: $multelement
15331: $typeelement
15332: |;
15333: if ($formname eq 'portform') {
15334: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15335: }
15336: }
15337: if ($fixeddom) {
15338: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15339: }
15340: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15341: if ($sincefilterform) {
15342: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15343: .$sincefilterform
15344: .&Apache::lonhtmlcommon::row_closure();
15345: }
15346: if ($createdfilterform) {
15347: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15348: .$createdfilterform
15349: .&Apache::lonhtmlcommon::row_closure();
15350: }
15351: if ($domainselectform) {
15352: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15353: .$domainselectform
15354: .&Apache::lonhtmlcommon::row_closure();
15355: }
15356: if ($typeselectform) {
15357: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15358: $output .= $typeselectform;
15359: } else {
15360: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15361: .$typeselectform
15362: .&Apache::lonhtmlcommon::row_closure();
15363: }
15364: }
15365: if ($instcodeform) {
15366: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15367: .$instcodeform
15368: .&Apache::lonhtmlcommon::row_closure();
15369: }
15370: if (exists($filter->{'ownerfilter'})) {
15371: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15372: '<table><tr><td>'.&mt('Username').'<br />'.
15373: '<input type="text" name="ownerfilter" size="20" value="'.
15374: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15375: $ownerdomselectform.'</td></tr></table>'.
15376: &Apache::lonhtmlcommon::row_closure();
15377: }
15378: if (exists($filter->{'personfilter'})) {
15379: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15380: '<table><tr><td>'.&mt('Username').'<br />'.
15381: '<input type="text" name="personfilter" size="20" value="'.
15382: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15383: $persondomselectform.'</td></tr></table>'.
15384: &Apache::lonhtmlcommon::row_closure();
15385: }
15386: if (exists($filter->{'coursefilter'})) {
15387: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15388: .'<input type="text" name="coursefilter" size="25" value="'
15389: .$list->{'coursefilter'}.'" />'
15390: .&Apache::lonhtmlcommon::row_closure();
15391: }
15392: if ($cloneableonlyform) {
15393: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15394: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15395: }
15396: if (exists($filter->{'descriptfilter'})) {
15397: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15398: .'<input type="text" name="descriptfilter" size="40" value="'
15399: .$list->{'descriptfilter'}.'" />'
15400: .&Apache::lonhtmlcommon::row_closure(1);
15401: }
15402: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15403: '<input type="hidden" name="updater" value="" />'."\n".
15404: '<input type="submit" name="gosearch" value="'.
15405: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15406: return $jscript.$clonewarning.$output;
15407: }
15408:
15409: =pod
15410:
15411: =item * &timebased_select_form()
15412:
15413: Create markup for a dropdown list used to select a time-based
15414: filter e.g., Course Activity, Course Created, when searching for courses
15415: or communities
15416:
15417: Inputs:
15418:
15419: item - name of form element (sincefilter or createdfilter)
15420:
15421: filter - anonymous hash of criteria and their values
15422:
15423: Returns: HTML for a select box contained a blank, then six time selections,
15424: with value set in incoming form variables currently selected.
15425:
15426: Side Effects: None
15427:
15428: =cut
15429:
15430: sub timebased_select_form {
15431: my ($item,$filter) = @_;
15432: if (ref($filter) eq 'HASH') {
15433: $filter->{$item} =~ s/[^\d-]//g;
15434: if (!$filter->{$item}) { $filter->{$item}=-1; }
15435: return &select_form(
15436: $filter->{$item},
15437: $item,
15438: { '-1' => '',
15439: '86400' => &mt('today'),
15440: '604800' => &mt('last week'),
15441: '2592000' => &mt('last month'),
15442: '7776000' => &mt('last three months'),
15443: '15552000' => &mt('last six months'),
15444: '31104000' => &mt('last year'),
15445: 'select_form_order' =>
15446: ['-1','86400','604800','2592000','7776000',
15447: '15552000','31104000']});
15448: }
15449: }
15450:
15451: =pod
15452:
15453: =item * &js_changer()
15454:
15455: Create script tag containing Javascript used to submit course search form
15456: when course type or domain is changed, and also to hide 'Searching ...' on
15457: page load completion for page showing search result.
15458:
15459: Inputs: None
15460:
15461: Returns: markup containing updateFilters() and hideSearching() javascript functions.
15462:
15463: Side Effects: None
15464:
15465: =cut
15466:
15467: sub js_changer {
15468: return <<ENDJS;
15469: <script type="text/javascript">
15470: // <![CDATA[
15471: function updateFilters(caller) {
15472: if (typeof(caller) != "undefined") {
15473: document.filterpicker.updater.value = caller.name;
15474: }
15475: document.filterpicker.submit();
15476: }
15477:
15478: function hideSearching() {
15479: if (document.getElementById('searching')) {
15480: document.getElementById('searching').style.display = 'none';
15481: }
15482: return;
15483: }
15484:
15485: // ]]>
15486: </script>
15487:
15488: ENDJS
15489: }
15490:
15491: =pod
15492:
15493: =item * &search_courses()
15494:
15495: Process selected filters form course search form and pass to lonnet::courseiddump
15496: to retrieve a hash for which keys are courseIDs which match the selected filters.
15497:
15498: Inputs:
15499:
15500: dom - domain being searched
15501:
15502: type - course type ('Course' or 'Community' or '.' if any).
15503:
15504: filter - anonymous hash of criteria and their values
15505:
15506: numtitles - for institutional codes - number of categories
15507:
15508: cloneruname - optional username of new course owner
15509:
15510: clonerudom - optional domain of new course owner
15511:
1.1075.2.95 raeburn 15512: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69 raeburn 15513: (used when DC is using course creation form)
15514:
15515: codetitles - reference to array of titles of components in institutional codes (official courses).
15516:
1.1075.2.95 raeburn 15517: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
15518: (and so can clone automatically)
15519:
15520: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
15521:
15522: reqinstcode - institutional code of new course, where search_courses is used to identify potential
15523: courses to clone
1.1075.2.69 raeburn 15524:
15525: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15526:
15527:
15528: Side Effects: None
15529:
15530: =cut
15531:
15532:
15533: sub search_courses {
1.1075.2.95 raeburn 15534: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
15535: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69 raeburn 15536: my (%courses,%showcourses,$cloner);
15537: if (($filter->{'ownerfilter'} ne '') ||
15538: ($filter->{'ownerdomfilter'} ne '')) {
15539: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15540: $filter->{'ownerdomfilter'};
15541: }
15542: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15543: if (!$filter->{$item}) {
15544: $filter->{$item}='.';
15545: }
15546: }
15547: my $now = time;
15548: my $timefilter =
15549: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15550: my ($createdbefore,$createdafter);
15551: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15552: $createdbefore = $now;
15553: $createdafter = $now-$filter->{'createdfilter'};
15554: }
15555: my ($instcodefilter,$regexpok);
15556: if ($numtitles) {
15557: if ($env{'form.official'} eq 'on') {
15558: $instcodefilter =
15559: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15560: $regexpok = 1;
15561: } elsif ($env{'form.official'} eq 'off') {
15562: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15563: unless ($instcodefilter eq '') {
15564: $regexpok = -1;
15565: }
15566: }
15567: } else {
15568: $instcodefilter = $filter->{'instcodefilter'};
15569: }
15570: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15571: if ($type eq '') { $type = '.'; }
15572:
15573: if (($clonerudom ne '') && ($cloneruname ne '')) {
15574: $cloner = $cloneruname.':'.$clonerudom;
15575: }
15576: %courses = &Apache::lonnet::courseiddump($dom,
15577: $filter->{'descriptfilter'},
15578: $timefilter,
15579: $instcodefilter,
15580: $filter->{'combownerfilter'},
15581: $filter->{'coursefilter'},
15582: undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95 raeburn 15583: undef,undef,$cloner,$cc_clone,
1.1075.2.69 raeburn 15584: $filter->{'cloneableonly'},
15585: $createdbefore,$createdafter,undef,
1.1075.2.95 raeburn 15586: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69 raeburn 15587: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15588: my $ccrole;
15589: if ($type eq 'Community') {
15590: $ccrole = 'co';
15591: } else {
15592: $ccrole = 'cc';
15593: }
15594: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15595: $filter->{'persondomfilter'},
15596: 'userroles',undef,
15597: [$ccrole,'in','ad','ep','ta','cr'],
15598: $dom);
15599: foreach my $role (keys(%rolehash)) {
15600: my ($cnum,$cdom,$courserole) = split(':',$role);
15601: my $cid = $cdom.'_'.$cnum;
15602: if (exists($courses{$cid})) {
15603: if (ref($courses{$cid}) eq 'HASH') {
15604: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15605: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15606: push (@{$courses{$cid}{roles}},$courserole);
15607: }
15608: } else {
15609: $courses{$cid}{roles} = [$courserole];
15610: }
15611: $showcourses{$cid} = $courses{$cid};
15612: }
15613: }
15614: }
15615: %courses = %showcourses;
15616: }
15617: return %courses;
15618: }
15619:
15620: =pod
15621:
15622: =back
15623:
1.1075.2.88 raeburn 15624: =head1 Routines for version requirements for current course.
15625:
15626: =over 4
15627:
15628: =item * &check_release_required()
15629:
15630: Compares required LON-CAPA version with version on server, and
15631: if required version is newer looks for a server with the required version.
15632:
15633: Looks first at servers in user's owen domain; if none suitable, looks at
15634: servers in course's domain are permitted to host sessions for user's domain.
15635:
15636: Inputs:
15637:
15638: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15639:
15640: $courseid - Course ID of current course
15641:
15642: $rolecode - User's current role in course (for switchserver query string).
15643:
15644: $required - LON-CAPA version needed by course (format: Major.Minor).
15645:
15646:
15647: Returns:
15648:
15649: $switchserver - query string tp append to /adm/switchserver call (if
15650: current server's LON-CAPA version is too old.
15651:
15652: $warning - Message is displayed if no suitable server could be found.
15653:
15654: =cut
15655:
15656: sub check_release_required {
15657: my ($loncaparev,$courseid,$rolecode,$required) = @_;
15658: my ($switchserver,$warning);
15659: if ($required ne '') {
15660: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
15661: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15662: if ($reqdmajor ne '' && $reqdminor ne '') {
15663: my $otherserver;
15664: if (($major eq '' && $minor eq '') ||
15665: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
15666: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
15667: my $switchlcrev =
15668: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
15669: $userdomserver);
15670: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15671: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
15672: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
15673: my $cdom = $env{'course.'.$courseid.'.domain'};
15674: if ($cdom ne $env{'user.domain'}) {
15675: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
15676: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
15677: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15678: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
15679: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
15680: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
15681: my $canhost =
15682: &Apache::lonnet::can_host_session($env{'user.domain'},
15683: $coursedomserver,
15684: $remoterev,
15685: $udomdefaults{'remotesessions'},
15686: $defdomdefaults{'hostedsessions'});
15687:
15688: if ($canhost) {
15689: $otherserver = $coursedomserver;
15690: } else {
15691: $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.");
15692: }
15693: } else {
15694: $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).");
15695: }
15696: } else {
15697: $otherserver = $userdomserver;
15698: }
15699: }
15700: if ($otherserver ne '') {
15701: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
15702: }
15703: }
15704: }
15705: return ($switchserver,$warning);
15706: }
15707:
15708: =pod
15709:
15710: =item * &check_release_result()
15711:
15712: Inputs:
15713:
15714: $switchwarning - Warning message if no suitable server found to host session.
15715:
15716: $switchserver - query string to append to /adm/switchserver containing lonHostID
15717: and current role.
15718:
15719: Returns: HTML to display with information about requirement to switch server.
15720: Either displaying warning with link to Roles/Courses screen or
15721: display link to switchserver.
15722:
1.1075.2.69 raeburn 15723: =cut
15724:
1.1075.2.88 raeburn 15725: sub check_release_result {
15726: my ($switchwarning,$switchserver) = @_;
15727: my $output = &start_page('Selected course unavailable on this server').
15728: '<p class="LC_warning">';
15729: if ($switchwarning) {
15730: $output .= $switchwarning.'<br /><a href="/adm/roles">';
15731: if (&show_course()) {
15732: $output .= &mt('Display courses');
15733: } else {
15734: $output .= &mt('Display roles');
15735: }
15736: $output .= '</a>';
15737: } elsif ($switchserver) {
15738: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
15739: '<br />'.
15740: '<a href="/adm/switchserver?'.$switchserver.'">'.
15741: &mt('Switch Server').
15742: '</a>';
15743: }
15744: $output .= '</p>'.&end_page();
15745: return $output;
15746: }
15747:
15748: =pod
15749:
15750: =item * &needs_coursereinit()
15751:
15752: Determine if course contents stored for user's session needs to be
15753: refreshed, because content has changed since "Big Hash" last tied.
15754:
15755: Check for change is made if time last checked is more than 10 minutes ago
15756: (by default).
15757:
15758: Inputs:
15759:
15760: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15761:
15762: $interval (optional) - Time which may elapse (in s) between last check for content
15763: change in current course. (default: 600 s).
15764:
15765: Returns: an array; first element is:
15766:
15767: =over 4
15768:
15769: 'switch' - if content updates mean user's session
15770: needs to be switched to a server running a newer LON-CAPA version
15771:
15772: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
15773: on current server hosting user's session
15774:
15775: '' - if no action required.
15776:
15777: =back
15778:
15779: If first item element is 'switch':
15780:
15781: second item is $switchwarning - Warning message if no suitable server found to host session.
15782:
15783: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
15784: and current role.
15785:
15786: otherwise: no other elements returned.
15787:
15788: =back
15789:
15790: =cut
15791:
15792: sub needs_coursereinit {
15793: my ($loncaparev,$interval) = @_;
15794: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
15795: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
15796: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
15797: my $now = time;
15798: if ($interval eq '') {
15799: $interval = 600;
15800: }
15801: if (($now-$env{'request.course.timechecked'})>$interval) {
15802: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
15803: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
15804: if ($lastchange > $env{'request.course.tied'}) {
15805: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15806: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
15807: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
15808: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
15809: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
15810: $curr_reqd_hash{'internal.releaserequired'}});
15811: my ($switchserver,$switchwarning) =
15812: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
15813: $curr_reqd_hash{'internal.releaserequired'});
15814: if ($switchwarning ne '' || $switchserver ne '') {
15815: return ('switch',$switchwarning,$switchserver);
15816: }
15817: }
15818: }
15819: return ('update');
15820: }
15821: }
15822: return ();
15823: }
1.1075.2.69 raeburn 15824:
1.1075.2.11 raeburn 15825: sub update_content_constraints {
15826: my ($cdom,$cnum,$chome,$cid) = @_;
15827: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15828: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15829: my %checkresponsetypes;
15830: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15831: my ($item,$name,$value) = split(/:/,$key);
15832: if ($item eq 'resourcetag') {
15833: if ($name eq 'responsetype') {
15834: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15835: }
15836: }
15837: }
15838: my $navmap = Apache::lonnavmaps::navmap->new();
15839: if (defined($navmap)) {
15840: my %allresponses;
15841: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15842: my %responses = $res->responseTypes();
15843: foreach my $key (keys(%responses)) {
15844: next unless(exists($checkresponsetypes{$key}));
15845: $allresponses{$key} += $responses{$key};
15846: }
15847: }
15848: foreach my $key (keys(%allresponses)) {
15849: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15850: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15851: ($reqdmajor,$reqdminor) = ($major,$minor);
15852: }
15853: }
15854: undef($navmap);
15855: }
15856: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15857: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15858: }
15859: return;
15860: }
15861:
1.1075.2.27 raeburn 15862: sub allmaps_incourse {
15863: my ($cdom,$cnum,$chome,$cid) = @_;
15864: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15865: $cid = $env{'request.course.id'};
15866: $cdom = $env{'course.'.$cid.'.domain'};
15867: $cnum = $env{'course.'.$cid.'.num'};
15868: $chome = $env{'course.'.$cid.'.home'};
15869: }
15870: my %allmaps = ();
15871: my $lastchange =
15872: &Apache::lonnet::get_coursechange($cdom,$cnum);
15873: if ($lastchange > $env{'request.course.tied'}) {
15874: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15875: unless ($ferr) {
15876: &update_content_constraints($cdom,$cnum,$chome,$cid);
15877: }
15878: }
15879: my $navmap = Apache::lonnavmaps::navmap->new();
15880: if (defined($navmap)) {
15881: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15882: $allmaps{$res->src()} = 1;
15883: }
15884: }
15885: return \%allmaps;
15886: }
15887:
1.1075.2.11 raeburn 15888: sub parse_supplemental_title {
15889: my ($title) = @_;
15890:
15891: my ($foldertitle,$renametitle);
15892: if ($title =~ /&&&/) {
15893: $title = &HTML::Entites::decode($title);
15894: }
15895: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15896: $renametitle=$4;
15897: my ($time,$uname,$udom) = ($1,$2,$3);
15898: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15899: my $name = &plainname($uname,$udom);
15900: $name = &HTML::Entities::encode($name,'"<>&\'');
15901: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15902: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15903: $name.': <br />'.$foldertitle;
15904: }
15905: if (wantarray) {
15906: return ($title,$foldertitle,$renametitle);
15907: }
15908: return $title;
15909: }
15910:
1.1075.2.43 raeburn 15911: sub recurse_supplemental {
15912: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15913: if ($suppmap) {
15914: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15915: if ($fatal) {
15916: $errors ++;
15917: } else {
15918: if ($#LONCAPA::map::resources > 0) {
15919: foreach my $res (@LONCAPA::map::resources) {
15920: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15921: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 15922: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15923: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 15924: } else {
15925: $numfiles ++;
15926: }
15927: }
15928: }
15929: }
15930: }
15931: }
15932: return ($numfiles,$errors);
15933: }
15934:
1.1075.2.18 raeburn 15935: sub symb_to_docspath {
15936: my ($symb) = @_;
15937: return unless ($symb);
15938: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15939: if ($resurl=~/\.(sequence|page)$/) {
15940: $mapurl=$resurl;
15941: } elsif ($resurl eq 'adm/navmaps') {
15942: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15943: }
15944: my $mapresobj;
15945: my $navmap = Apache::lonnavmaps::navmap->new();
15946: if (ref($navmap)) {
15947: $mapresobj = $navmap->getResourceByUrl($mapurl);
15948: }
15949: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15950: my $type=$2;
15951: my $path;
15952: if (ref($mapresobj)) {
15953: my $pcslist = $mapresobj->map_hierarchy();
15954: if ($pcslist ne '') {
15955: foreach my $pc (split(/,/,$pcslist)) {
15956: next if ($pc <= 1);
15957: my $res = $navmap->getByMapPc($pc);
15958: if (ref($res)) {
15959: my $thisurl = $res->src();
15960: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15961: my $thistitle = $res->title();
15962: $path .= '&'.
15963: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 15964: &escape($thistitle).
1.1075.2.18 raeburn 15965: ':'.$res->randompick().
15966: ':'.$res->randomout().
15967: ':'.$res->encrypted().
15968: ':'.$res->randomorder().
15969: ':'.$res->is_page();
15970: }
15971: }
15972: }
15973: $path =~ s/^\&//;
15974: my $maptitle = $mapresobj->title();
15975: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15976: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15977: }
15978: $path .= (($path ne '')? '&' : '').
15979: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15980: &escape($maptitle).
1.1075.2.18 raeburn 15981: ':'.$mapresobj->randompick().
15982: ':'.$mapresobj->randomout().
15983: ':'.$mapresobj->encrypted().
15984: ':'.$mapresobj->randomorder().
15985: ':'.$mapresobj->is_page();
15986: } else {
15987: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15988: my $ispage = (($type eq 'page')? 1 : '');
15989: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15990: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15991: }
15992: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15993: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 15994: }
15995: unless ($mapurl eq 'default') {
15996: $path = 'default&'.
1.1075.2.46 raeburn 15997: &escape('Main Content').
1.1075.2.18 raeburn 15998: ':::::&'.$path;
15999: }
16000: return $path;
16001: }
16002:
1.1075.2.14 raeburn 16003: sub captcha_display {
16004: my ($context,$lonhost) = @_;
16005: my ($output,$error);
16006: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
16007: if ($captcha eq 'original') {
16008: $output = &create_captcha();
16009: unless ($output) {
16010: $error = 'captcha';
16011: }
16012: } elsif ($captcha eq 'recaptcha') {
16013: $output = &create_recaptcha($pubkey);
16014: unless ($output) {
16015: $error = 'recaptcha';
16016: }
16017: }
1.1075.2.66 raeburn 16018: return ($output,$error,$captcha);
1.1075.2.14 raeburn 16019: }
16020:
16021: sub captcha_response {
16022: my ($context,$lonhost) = @_;
16023: my ($captcha_chk,$captcha_error);
16024: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
16025: if ($captcha eq 'original') {
16026: ($captcha_chk,$captcha_error) = &check_captcha();
16027: } elsif ($captcha eq 'recaptcha') {
16028: $captcha_chk = &check_recaptcha($privkey);
16029: } else {
16030: $captcha_chk = 1;
16031: }
16032: return ($captcha_chk,$captcha_error);
16033: }
16034:
16035: sub get_captcha_config {
16036: my ($context,$lonhost) = @_;
16037: my ($captcha,$pubkey,$privkey,$hashtocheck);
16038: my $hostname = &Apache::lonnet::hostname($lonhost);
16039: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
16040: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16041: if ($context eq 'usercreation') {
16042: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
16043: if (ref($domconfig{$context}) eq 'HASH') {
16044: $hashtocheck = $domconfig{$context}{'cancreate'};
16045: if (ref($hashtocheck) eq 'HASH') {
16046: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
16047: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
16048: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
16049: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
16050: }
16051: if ($privkey && $pubkey) {
16052: $captcha = 'recaptcha';
16053: } else {
16054: $captcha = 'original';
16055: }
16056: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
16057: $captcha = 'original';
16058: }
16059: }
16060: } else {
16061: $captcha = 'captcha';
16062: }
16063: } elsif ($context eq 'login') {
16064: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
16065: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
16066: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
16067: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
16068: if ($privkey && $pubkey) {
16069: $captcha = 'recaptcha';
16070: } else {
16071: $captcha = 'original';
16072: }
16073: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
16074: $captcha = 'original';
16075: }
16076: }
16077: return ($captcha,$pubkey,$privkey);
16078: }
16079:
16080: sub create_captcha {
16081: my %captcha_params = &captcha_settings();
16082: my ($output,$maxtries,$tries) = ('',10,0);
16083: while ($tries < $maxtries) {
16084: $tries ++;
16085: my $captcha = Authen::Captcha->new (
16086: output_folder => $captcha_params{'output_dir'},
16087: data_folder => $captcha_params{'db_dir'},
16088: );
16089: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
16090:
16091: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
16092: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
16093: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.66 raeburn 16094: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
16095: '<br />'.
16096: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 16097: last;
16098: }
16099: }
16100: return $output;
16101: }
16102:
16103: sub captcha_settings {
16104: my %captcha_params = (
16105: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
16106: www_output_dir => "/captchaspool",
16107: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
16108: numchars => '5',
16109: );
16110: return %captcha_params;
16111: }
16112:
16113: sub check_captcha {
16114: my ($captcha_chk,$captcha_error);
16115: my $code = $env{'form.code'};
16116: my $md5sum = $env{'form.crypt'};
16117: my %captcha_params = &captcha_settings();
16118: my $captcha = Authen::Captcha->new(
16119: output_folder => $captcha_params{'output_dir'},
16120: data_folder => $captcha_params{'db_dir'},
16121: );
1.1075.2.26 raeburn 16122: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 16123: my %captcha_hash = (
16124: 0 => 'Code not checked (file error)',
16125: -1 => 'Failed: code expired',
16126: -2 => 'Failed: invalid code (not in database)',
16127: -3 => 'Failed: invalid code (code does not match crypt)',
16128: );
16129: if ($captcha_chk != 1) {
16130: $captcha_error = $captcha_hash{$captcha_chk}
16131: }
16132: return ($captcha_chk,$captcha_error);
16133: }
16134:
16135: sub create_recaptcha {
16136: my ($pubkey) = @_;
1.1075.2.51 raeburn 16137: my $use_ssl;
16138: if ($ENV{'SERVER_PORT'} == 443) {
16139: $use_ssl = 1;
16140: }
1.1075.2.14 raeburn 16141: my $captcha = Captcha::reCAPTCHA->new;
16142: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51 raeburn 16143: $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.92 raeburn 16144: &mt('If the text is hard to read, [_1] will replace them.',
1.1075.2.39 raeburn 16145: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14 raeburn 16146: '<br /><br />';
16147: }
16148:
16149: sub check_recaptcha {
16150: my ($privkey) = @_;
16151: my $captcha_chk;
16152: my $captcha = Captcha::reCAPTCHA->new;
16153: my $captcha_result =
16154: $captcha->check_answer(
16155: $privkey,
16156: $ENV{'REMOTE_ADDR'},
16157: $env{'form.recaptcha_challenge_field'},
16158: $env{'form.recaptcha_response_field'},
16159: );
16160: if ($captcha_result->{is_valid}) {
16161: $captcha_chk = 1;
16162: }
16163: return $captcha_chk;
16164: }
16165:
1.1075.2.64 raeburn 16166: sub emailusername_info {
1.1075.2.67 raeburn 16167: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64 raeburn 16168: my %titles = &Apache::lonlocal::texthash (
16169: lastname => 'Last Name',
16170: firstname => 'First Name',
16171: institution => 'School/college/university',
16172: location => "School's city, state/province, country",
16173: web => "School's web address",
16174: officialemail => 'E-mail address at institution (if different)',
16175: );
16176: return (\@fields,\%titles);
16177: }
16178:
1.1075.2.56 raeburn 16179: sub cleanup_html {
16180: my ($incoming) = @_;
16181: my $outgoing;
16182: if ($incoming ne '') {
16183: $outgoing = $incoming;
16184: $outgoing =~ s/;/;/g;
16185: $outgoing =~ s/\#/#/g;
16186: $outgoing =~ s/\&/&/g;
16187: $outgoing =~ s/</</g;
16188: $outgoing =~ s/>/>/g;
16189: $outgoing =~ s/\(/(/g;
16190: $outgoing =~ s/\)/)/g;
16191: $outgoing =~ s/"/"/g;
16192: $outgoing =~ s/'/'/g;
16193: $outgoing =~ s/\$/$/g;
16194: $outgoing =~ s{/}{/}g;
16195: $outgoing =~ s/=/=/g;
16196: $outgoing =~ s/\\/\/g
16197: }
16198: return $outgoing;
16199: }
16200:
1.1075.2.74 raeburn 16201: # Checks for critical messages and returns a redirect url if one exists.
16202: # $interval indicates how often to check for messages.
16203: sub critical_redirect {
16204: my ($interval) = @_;
16205: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16206: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16207: $env{'user.name'});
16208: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
16209: my $redirecturl;
16210: if ($what[0]) {
16211: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16212: $redirecturl='/adm/email?critical=display';
16213: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16214: return (1, $url);
16215: }
16216: }
16217: }
16218: return ();
16219: }
16220:
1.1075.2.64 raeburn 16221: # Use:
16222: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16223: #
16224: ##################################################
16225: # password associated functions #
16226: ##################################################
16227: sub des_keys {
16228: # Make a new key for DES encryption.
16229: # Each key has two parts which are returned separately.
16230: # Please note: Each key must be passed through the &hex function
16231: # before it is output to the web browser. The hex versions cannot
16232: # be used to decrypt.
16233: my @hexstr=('0','1','2','3','4','5','6','7',
16234: '8','9','a','b','c','d','e','f');
16235: my $lkey='';
16236: for (0..7) {
16237: $lkey.=$hexstr[rand(15)];
16238: }
16239: my $ukey='';
16240: for (0..7) {
16241: $ukey.=$hexstr[rand(15)];
16242: }
16243: return ($lkey,$ukey);
16244: }
16245:
16246: sub des_decrypt {
16247: my ($key,$cyphertext) = @_;
16248: my $keybin=pack("H16",$key);
16249: my $cypher;
16250: if ($Crypt::DES::VERSION>=2.03) {
16251: $cypher=new Crypt::DES $keybin;
16252: } else {
16253: $cypher=new DES $keybin;
16254: }
16255: my $plaintext=
16256: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
16257: $plaintext.=
16258: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
16259: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
16260: return $plaintext;
16261: }
16262:
1.112 bowersj2 16263: 1;
16264: __END__;
1.41 ng 16265:
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