Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.104
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.104! raeburn 4: # $Id: loncommon.pm,v 1.1075.2.103 2016/08/06 20:15:00 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.1075.2.102 raeburn 75: use DateTime::Locale;
1.1075.2.94 raeburn 76: use Encode();
1.1075.2.14 raeburn 77: use Authen::Captcha;
78: use Captcha::reCAPTCHA;
1.1075.2.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: }
1.1075.2.102 raeburn 968: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 969: my (@possibles,%locale_names);
1.1075.2.102 raeburn 970: my @locales = DateTime::Locale->ids();
971: foreach my $id (@locales) {
972: if ($id ne '') {
973: my ($en_terr,$native_terr);
974: my $loc = DateTime::Locale->load($id);
975: if (ref($loc)) {
976: $en_terr = $loc->name();
977: $native_terr = $loc->native_name();
1.687 raeburn 978: if (grep(/^en$/,@languages) || !@languages) {
979: if ($en_terr ne '') {
980: $locale_names{$id} = '('.$en_terr.')';
981: } elsif ($native_terr ne '') {
982: $locale_names{$id} = $native_terr;
983: }
984: } else {
985: if ($native_terr ne '') {
986: $locale_names{$id} = $native_terr.' ';
987: } elsif ($en_terr ne '') {
988: $locale_names{$id} = '('.$en_terr.')';
989: }
990: }
1.1075.2.94 raeburn 991: $locale_names{$id} = Encode::encode('UTF-8',$locale_names{$id});
1.1075.2.102 raeburn 992: push(@possibles,$id);
1.687 raeburn 993: }
994: }
995: }
996: foreach my $item (sort(@possibles)) {
997: $output.= '<option value="'.$item.'"';
998: if ($item eq $selected) {
999: $output.=' selected="selected"';
1000: }
1001: $output.=">$item";
1002: if ($locale_names{$item} ne '') {
1.1075.2.94 raeburn 1003: $output.=' '.$locale_names{$item};
1.687 raeburn 1004: }
1005: $output.="</option>\n";
1006: }
1007: $output.="</select>";
1008: return $output;
1009: }
1010:
1.792 raeburn 1011: sub select_language {
1012: my ($name,$selected,$includeempty) = @_;
1013: my %langchoices;
1014: if ($includeempty) {
1.1075.2.32 raeburn 1015: %langchoices = ('' => 'No language preference');
1.792 raeburn 1016: }
1017: foreach my $id (&languageids()) {
1018: my $code = &supportedlanguagecode($id);
1019: if ($code) {
1020: $langchoices{$code} = &plainlanguagedescription($id);
1021: }
1022: }
1.1075.2.32 raeburn 1023: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1024: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1025: }
1026:
1.42 matthew 1027: =pod
1.36 matthew 1028:
1.648 raeburn 1029: =item * &linked_select_forms(...)
1.36 matthew 1030:
1031: linked_select_forms returns a string containing a <script></script> block
1032: and html for two <select> menus. The select menus will be linked in that
1033: changing the value of the first menu will result in new values being placed
1034: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1035: order unless a defined order is provided.
1.36 matthew 1036:
1037: linked_select_forms takes the following ordered inputs:
1038:
1039: =over 4
1040:
1.112 bowersj2 1041: =item * $formname, the name of the <form> tag
1.36 matthew 1042:
1.112 bowersj2 1043: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1044:
1.112 bowersj2 1045: =item * $firstdefault, the default value for the first menu
1.36 matthew 1046:
1.112 bowersj2 1047: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1048:
1.112 bowersj2 1049: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1050:
1.112 bowersj2 1051: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1052:
1.609 raeburn 1053: =item * $menuorder, the order of values in the first menu
1054:
1.1075.2.31 raeburn 1055: =item * $onchangefirst, additional javascript call to execute for an onchange
1056: event for the first <select> tag
1057:
1058: =item * $onchangesecond, additional javascript call to execute for an onchange
1059: event for the second <select> tag
1060:
1.41 ng 1061: =back
1062:
1.36 matthew 1063: Below is an example of such a hash. Only the 'text', 'default', and
1064: 'select2' keys must appear as stated. keys(%menu) are the possible
1065: values for the first select menu. The text that coincides with the
1.41 ng 1066: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1067: and text for the second menu are given in the hash pointed to by
1068: $menu{$choice1}->{'select2'}.
1069:
1.112 bowersj2 1070: my %menu = ( A1 => { text =>"Choice A1" ,
1071: default => "B3",
1072: select2 => {
1073: B1 => "Choice B1",
1074: B2 => "Choice B2",
1075: B3 => "Choice B3",
1076: B4 => "Choice B4"
1.609 raeburn 1077: },
1078: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1079: },
1080: A2 => { text =>"Choice A2" ,
1081: default => "C2",
1082: select2 => {
1083: C1 => "Choice C1",
1084: C2 => "Choice C2",
1085: C3 => "Choice C3"
1.609 raeburn 1086: },
1087: order => ['C2','C1','C3'],
1.112 bowersj2 1088: },
1089: A3 => { text =>"Choice A3" ,
1090: default => "D6",
1091: select2 => {
1092: D1 => "Choice D1",
1093: D2 => "Choice D2",
1094: D3 => "Choice D3",
1095: D4 => "Choice D4",
1096: D5 => "Choice D5",
1097: D6 => "Choice D6",
1098: D7 => "Choice D7"
1.609 raeburn 1099: },
1100: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1101: }
1102: );
1.36 matthew 1103:
1104: =cut
1105:
1106: sub linked_select_forms {
1107: my ($formname,
1108: $middletext,
1109: $firstdefault,
1110: $firstselectname,
1111: $secondselectname,
1.609 raeburn 1112: $hashref,
1113: $menuorder,
1.1075.2.31 raeburn 1114: $onchangefirst,
1115: $onchangesecond
1.36 matthew 1116: ) = @_;
1117: my $second = "document.$formname.$secondselectname";
1118: my $first = "document.$formname.$firstselectname";
1119: # output the javascript to do the changing
1120: my $result = '';
1.776 bisitz 1121: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1122: $result.="// <![CDATA[\n";
1.36 matthew 1123: $result.="var select2data = new Object();\n";
1124: $" = '","';
1125: my $debug = '';
1126: foreach my $s1 (sort(keys(%$hashref))) {
1127: $result.="select2data.d_$s1 = new Object();\n";
1128: $result.="select2data.d_$s1.def = new String('".
1129: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1130: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1131: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1132: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1133: @s2values = @{$hashref->{$s1}->{'order'}};
1134: }
1.36 matthew 1135: $result.="\"@s2values\");\n";
1136: $result.="select2data.d_$s1.texts = new Array(";
1137: my @s2texts;
1138: foreach my $value (@s2values) {
1139: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1140: }
1141: $result.="\"@s2texts\");\n";
1142: }
1143: $"=' ';
1144: $result.= <<"END";
1145:
1146: function select1_changed() {
1147: // Determine new choice
1148: var newvalue = "d_" + $first.value;
1149: // update select2
1150: var values = select2data[newvalue].values;
1151: var texts = select2data[newvalue].texts;
1152: var select2def = select2data[newvalue].def;
1153: var i;
1154: // out with the old
1155: for (i = 0; i < $second.options.length; i++) {
1156: $second.options[i] = null;
1157: }
1158: // in with the nuclear
1159: for (i=0;i<values.length; i++) {
1160: $second.options[i] = new Option(values[i]);
1.143 matthew 1161: $second.options[i].value = values[i];
1.36 matthew 1162: $second.options[i].text = texts[i];
1163: if (values[i] == select2def) {
1164: $second.options[i].selected = true;
1165: }
1166: }
1167: }
1.824 bisitz 1168: // ]]>
1.36 matthew 1169: </script>
1170: END
1171: # output the initial values for the selection lists
1.1075.2.31 raeburn 1172: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1173: my @order = sort(keys(%{$hashref}));
1174: if (ref($menuorder) eq 'ARRAY') {
1175: @order = @{$menuorder};
1176: }
1177: foreach my $value (@order) {
1.36 matthew 1178: $result.=" <option value=\"$value\" ";
1.253 albertel 1179: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1180: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1181: }
1182: $result .= "</select>\n";
1183: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1184: $result .= $middletext;
1.1075.2.31 raeburn 1185: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1186: if ($onchangesecond) {
1187: $result .= ' onchange="'.$onchangesecond.'"';
1188: }
1189: $result .= ">\n";
1.36 matthew 1190: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1191:
1192: my @secondorder = sort(keys(%select2));
1193: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1194: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1195: }
1196: foreach my $value (@secondorder) {
1.36 matthew 1197: $result.=" <option value=\"$value\" ";
1.253 albertel 1198: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1199: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1200: }
1201: $result .= "</select>\n";
1202: # return $debug;
1203: return $result;
1204: } # end of sub linked_select_forms {
1205:
1.45 matthew 1206: =pod
1.44 bowersj2 1207:
1.973 raeburn 1208: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1209:
1.112 bowersj2 1210: Returns a string corresponding to an HTML link to the given help
1211: $topic, where $topic corresponds to the name of a .tex file in
1212: /home/httpd/html/adm/help/tex, with underscores replaced by
1213: spaces.
1214:
1215: $text will optionally be linked to the same topic, allowing you to
1216: link text in addition to the graphic. If you do not want to link
1217: text, but wish to specify one of the later parameters, pass an
1218: empty string.
1219:
1220: $stayOnPage is a value that will be interpreted as a boolean. If true,
1221: the link will not open a new window. If false, the link will open
1222: a new window using Javascript. (Default is false.)
1223:
1224: $width and $height are optional numerical parameters that will
1225: override the width and height of the popped up window, which may
1.973 raeburn 1226: be useful for certain help topics with big pictures included.
1227:
1228: $imgid is the id of the img tag used for the help icon. This may be
1229: used in a javascript call to switch the image src. See
1230: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1231:
1232: =cut
1233:
1234: sub help_open_topic {
1.973 raeburn 1235: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1236: $text = "" if (not defined $text);
1.44 bowersj2 1237: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1238: $width = 500 if (not defined $width);
1.44 bowersj2 1239: $height = 400 if (not defined $height);
1240: my $filename = $topic;
1241: $filename =~ s/ /_/g;
1242:
1.48 bowersj2 1243: my $template = "";
1244: my $link;
1.572 banghart 1245:
1.159 www 1246: $topic=~s/\W/\_/g;
1.44 bowersj2 1247:
1.572 banghart 1248: if (!$stayOnPage) {
1.1075.2.50 raeburn 1249: if ($env{'browser.mobile'}) {
1250: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1251: } else {
1252: $link = "javascript:void(open('/adm/help/${filename}.hlp', 'Help_for_$topic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1253: }
1.1037 www 1254: } elsif ($stayOnPage eq 'popup') {
1255: $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 1256: } else {
1.48 bowersj2 1257: $link = "/adm/help/${filename}.hlp";
1258: }
1259:
1260: # Add the text
1.755 neumanie 1261: if ($text ne "") {
1.763 bisitz 1262: $template.='<span class="LC_help_open_topic">'
1263: .'<a target="_top" href="'.$link.'">'
1264: .$text.'</a>';
1.48 bowersj2 1265: }
1266:
1.763 bisitz 1267: # (Always) Add the graphic
1.179 matthew 1268: my $title = &mt('Online Help');
1.667 raeburn 1269: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1270: if ($imgid ne '') {
1271: $imgid = ' id="'.$imgid.'"';
1272: }
1.763 bisitz 1273: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1274: .'<img src="'.$helpicon.'" border="0"'
1275: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1276: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1277: .' /></a>';
1278: if ($text ne "") {
1279: $template.='</span>';
1280: }
1.44 bowersj2 1281: return $template;
1282:
1.106 bowersj2 1283: }
1284:
1285: # This is a quicky function for Latex cheatsheet editing, since it
1286: # appears in at least four places
1287: sub helpLatexCheatsheet {
1.1037 www 1288: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1289: my $out;
1.106 bowersj2 1290: my $addOther = '';
1.732 raeburn 1291: if ($topic) {
1.1037 www 1292: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1293: }
1294: $out = '<span>' # Start cheatsheet
1295: .$addOther
1296: .'<span>'
1.1037 www 1297: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1298: .'</span> <span>'
1.1037 www 1299: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1300: .'</span>';
1.732 raeburn 1301: unless ($not_author) {
1.763 bisitz 1302: $out .= ' <span>'
1.1037 www 1303: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1304: .'</span> <span>'
1.1075.2.78 raeburn 1305: .&help_open_topic('Authoring_Multilingual_Problems',&mt('Languages'),$stayOnPage,undef,600)
1.1075.2.71 raeburn 1306: .'</span>';
1.732 raeburn 1307: }
1.763 bisitz 1308: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1309: return $out;
1.172 www 1310: }
1311:
1.430 albertel 1312: sub general_help {
1313: my $helptopic='Student_Intro';
1314: if ($env{'request.role'}=~/^(ca|au)/) {
1315: $helptopic='Authoring_Intro';
1.907 raeburn 1316: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1317: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1318: } elsif ($env{'request.role'}=~/^dc/) {
1319: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1320: }
1321: return $helptopic;
1322: }
1323:
1324: sub update_help_link {
1325: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1326: my $origurl = $ENV{'REQUEST_URI'};
1327: $origurl=~s|^/~|/priv/|;
1328: my $timestamp = time;
1329: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1330: $$datum = &escape($$datum);
1331: }
1332:
1333: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1334: my $output .= <<"ENDOUTPUT";
1335: <script type="text/javascript">
1.824 bisitz 1336: // <![CDATA[
1.430 albertel 1337: banner_link = '$banner_link';
1.824 bisitz 1338: // ]]>
1.430 albertel 1339: </script>
1340: ENDOUTPUT
1341: return $output;
1342: }
1343:
1344: # now just updates the help link and generates a blue icon
1.193 raeburn 1345: sub help_open_menu {
1.430 albertel 1346: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1347: = @_;
1.949 droeschl 1348: $stayOnPage = 1;
1.430 albertel 1349: my $output;
1350: if ($component_help) {
1351: if (!$text) {
1352: $output=&help_open_topic($component_help,undef,$stayOnPage,
1353: $width,$height);
1354: } else {
1355: my $help_text;
1356: $help_text=&unescape($topic);
1357: $output='<table><tr><td>'.
1358: &help_open_topic($component_help,$help_text,$stayOnPage,
1359: $width,$height).'</td></tr></table>';
1360: }
1361: }
1362: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1363: return $output.$banner_link;
1364: }
1365:
1366: sub top_nav_help {
1367: my ($text) = @_;
1.436 albertel 1368: $text = &mt($text);
1.1075.2.60 raeburn 1369: my $stay_on_page;
1370: unless ($env{'environment.remote'} eq 'on') {
1371: $stay_on_page = 1;
1372: }
1.1075.2.61 raeburn 1373: my ($link,$banner_link);
1374: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1375: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1376: : "javascript:helpMenu('open')";
1377: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1378: }
1.201 raeburn 1379: my $title = &mt('Get help');
1.1075.2.61 raeburn 1380: if ($link) {
1381: return <<"END";
1.436 albertel 1382: $banner_link
1.1075.2.56 raeburn 1383: <a href="$link" title="$title">$text</a>
1.436 albertel 1384: END
1.1075.2.61 raeburn 1385: } else {
1386: return ' '.$text.' ';
1387: }
1.436 albertel 1388: }
1389:
1390: sub help_menu_js {
1.1075.2.52 raeburn 1391: my ($httphost) = @_;
1.949 droeschl 1392: my $stayOnPage = 1;
1.436 albertel 1393: my $width = 620;
1394: my $height = 600;
1.430 albertel 1395: my $helptopic=&general_help();
1.1075.2.52 raeburn 1396: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1397: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1398: my $start_page =
1399: &Apache::loncommon::start_page('Help Menu', undef,
1400: {'frameset' => 1,
1401: 'js_ready' => 1,
1.1075.2.52 raeburn 1402: 'use_absolute' => $httphost,
1.331 albertel 1403: 'add_entries' => {
1404: 'border' => '0',
1.579 raeburn 1405: 'rows' => "110,*",},});
1.331 albertel 1406: my $end_page =
1407: &Apache::loncommon::end_page({'frameset' => 1,
1408: 'js_ready' => 1,});
1409:
1.436 albertel 1410: my $template .= <<"ENDTEMPLATE";
1411: <script type="text/javascript">
1.877 bisitz 1412: // <![CDATA[
1.253 albertel 1413: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1414: var banner_link = '';
1.243 raeburn 1415: function helpMenu(target) {
1416: var caller = this;
1417: if (target == 'open') {
1418: var newWindow = null;
1419: try {
1.262 albertel 1420: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1421: }
1422: catch(error) {
1423: writeHelp(caller);
1424: return;
1425: }
1426: if (newWindow) {
1427: caller = newWindow;
1428: }
1.193 raeburn 1429: }
1.243 raeburn 1430: writeHelp(caller);
1431: return;
1432: }
1433: function writeHelp(caller) {
1.1075.2.61 raeburn 1434: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1435: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1436: caller.document.close();
1437: caller.focus();
1.193 raeburn 1438: }
1.877 bisitz 1439: // END LON-CAPA Internal -->
1.253 albertel 1440: // ]]>
1.436 albertel 1441: </script>
1.193 raeburn 1442: ENDTEMPLATE
1443: return $template;
1444: }
1445:
1.172 www 1446: sub help_open_bug {
1447: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1448: unless ($env{'user.adv'}) { return ''; }
1.172 www 1449: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1450: $text = "" if (not defined $text);
1451: $stayOnPage=1;
1.184 albertel 1452: $width = 600 if (not defined $width);
1453: $height = 600 if (not defined $height);
1.172 www 1454:
1455: $topic=~s/\W+/\+/g;
1456: my $link='';
1457: my $template='';
1.379 albertel 1458: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1459: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1460: if (!$stayOnPage)
1461: {
1462: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1463: }
1464: else
1465: {
1466: $link = $url;
1467: }
1468: # Add the text
1469: if ($text ne "")
1470: {
1471: $template .=
1472: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1473: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1474: }
1475:
1476: # Add the graphic
1.179 matthew 1477: my $title = &mt('Report a Bug');
1.215 albertel 1478: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1479: $template .= <<"ENDTEMPLATE";
1.436 albertel 1480: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1481: ENDTEMPLATE
1482: if ($text ne '') { $template.='</td></tr></table>' };
1483: return $template;
1484:
1485: }
1486:
1487: sub help_open_faq {
1488: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1489: unless ($env{'user.adv'}) { return ''; }
1.172 www 1490: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1491: $text = "" if (not defined $text);
1492: $stayOnPage=1;
1493: $width = 350 if (not defined $width);
1494: $height = 400 if (not defined $height);
1495:
1496: $topic=~s/\W+/\+/g;
1497: my $link='';
1498: my $template='';
1499: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1500: if (!$stayOnPage)
1501: {
1502: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1503: }
1504: else
1505: {
1506: $link = $url;
1507: }
1508:
1509: # Add the text
1510: if ($text ne "")
1511: {
1512: $template .=
1.173 www 1513: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1514: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1515: }
1516:
1517: # Add the graphic
1.179 matthew 1518: my $title = &mt('View the FAQ');
1.215 albertel 1519: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1520: $template .= <<"ENDTEMPLATE";
1.436 albertel 1521: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1522: ENDTEMPLATE
1523: if ($text ne '') { $template.='</td></tr></table>' };
1524: return $template;
1525:
1.44 bowersj2 1526: }
1.37 matthew 1527:
1.180 matthew 1528: ###############################################################
1529: ###############################################################
1530:
1.45 matthew 1531: =pod
1532:
1.648 raeburn 1533: =item * &change_content_javascript():
1.256 matthew 1534:
1535: This and the next function allow you to create small sections of an
1536: otherwise static HTML page that you can update on the fly with
1537: Javascript, even in Netscape 4.
1538:
1539: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1540: must be written to the HTML page once. It will prove the Javascript
1541: function "change(name, content)". Calling the change function with the
1542: name of the section
1543: you want to update, matching the name passed to C<changable_area>, and
1544: the new content you want to put in there, will put the content into
1545: that area.
1546:
1547: B<Note>: Netscape 4 only reserves enough space for the changable area
1548: to contain room for the original contents. You need to "make space"
1549: for whatever changes you wish to make, and be B<sure> to check your
1550: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1551: it's adequate for updating a one-line status display, but little more.
1552: This script will set the space to 100% width, so you only need to
1553: worry about height in Netscape 4.
1554:
1555: Modern browsers are much less limiting, and if you can commit to the
1556: user not using Netscape 4, this feature may be used freely with
1557: pretty much any HTML.
1558:
1559: =cut
1560:
1561: sub change_content_javascript {
1562: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1563: if ($env{'browser.type'} eq 'netscape' &&
1564: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1565: return (<<NETSCAPE4);
1566: function change(name, content) {
1567: doc = document.layers[name+"___escape"].layers[0].document;
1568: doc.open();
1569: doc.write(content);
1570: doc.close();
1571: }
1572: NETSCAPE4
1573: } else {
1574: # Otherwise, we need to use semi-standards-compliant code
1575: # (technically, "innerHTML" isn't standard but the equivalent
1576: # is really scary, and every useful browser supports it
1577: return (<<DOMBASED);
1578: function change(name, content) {
1579: element = document.getElementById(name);
1580: element.innerHTML = content;
1581: }
1582: DOMBASED
1583: }
1584: }
1585:
1586: =pod
1587:
1.648 raeburn 1588: =item * &changable_area($name,$origContent):
1.256 matthew 1589:
1590: This provides a "changable area" that can be modified on the fly via
1591: the Javascript code provided in C<change_content_javascript>. $name is
1592: the name you will use to reference the area later; do not repeat the
1593: same name on a given HTML page more then once. $origContent is what
1594: the area will originally contain, which can be left blank.
1595:
1596: =cut
1597:
1598: sub changable_area {
1599: my ($name, $origContent) = @_;
1600:
1.258 albertel 1601: if ($env{'browser.type'} eq 'netscape' &&
1602: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1603: # If this is netscape 4, we need to use the Layer tag
1604: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1605: } else {
1606: return "<span id='$name'>$origContent</span>";
1607: }
1608: }
1609:
1610: =pod
1611:
1.648 raeburn 1612: =item * &viewport_geometry_js
1.590 raeburn 1613:
1614: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1615:
1616: =cut
1617:
1618:
1619: sub viewport_geometry_js {
1620: return <<"GEOMETRY";
1621: var Geometry = {};
1622: function init_geometry() {
1623: if (Geometry.init) { return };
1624: Geometry.init=1;
1625: if (window.innerHeight) {
1626: Geometry.getViewportHeight = function() { return window.innerHeight; };
1627: Geometry.getViewportWidth = function() { return window.innerWidth; };
1628: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1629: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1630: }
1631: else if (document.documentElement && document.documentElement.clientHeight) {
1632: Geometry.getViewportHeight =
1633: function() { return document.documentElement.clientHeight; };
1634: Geometry.getViewportWidth =
1635: function() { return document.documentElement.clientWidth; };
1636:
1637: Geometry.getHorizontalScroll =
1638: function() { return document.documentElement.scrollLeft; };
1639: Geometry.getVerticalScroll =
1640: function() { return document.documentElement.scrollTop; };
1641: }
1642: else if (document.body.clientHeight) {
1643: Geometry.getViewportHeight =
1644: function() { return document.body.clientHeight; };
1645: Geometry.getViewportWidth =
1646: function() { return document.body.clientWidth; };
1647: Geometry.getHorizontalScroll =
1648: function() { return document.body.scrollLeft; };
1649: Geometry.getVerticalScroll =
1650: function() { return document.body.scrollTop; };
1651: }
1652: }
1653:
1654: GEOMETRY
1655: }
1656:
1657: =pod
1658:
1.648 raeburn 1659: =item * &viewport_size_js()
1.590 raeburn 1660:
1661: 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.
1662:
1663: =cut
1664:
1665: sub viewport_size_js {
1666: my $geometry = &viewport_geometry_js();
1667: return <<"DIMS";
1668:
1669: $geometry
1670:
1671: function getViewportDims(width,height) {
1672: init_geometry();
1673: width.value = Geometry.getViewportWidth();
1674: height.value = Geometry.getViewportHeight();
1675: return;
1676: }
1677:
1678: DIMS
1679: }
1680:
1681: =pod
1682:
1.648 raeburn 1683: =item * &resize_textarea_js()
1.565 albertel 1684:
1685: emits the needed javascript to resize a textarea to be as big as possible
1686:
1687: creates a function resize_textrea that takes two IDs first should be
1688: the id of the element to resize, second should be the id of a div that
1689: surrounds everything that comes after the textarea, this routine needs
1690: to be attached to the <body> for the onload and onresize events.
1691:
1.648 raeburn 1692: =back
1.565 albertel 1693:
1694: =cut
1695:
1696: sub resize_textarea_js {
1.590 raeburn 1697: my $geometry = &viewport_geometry_js();
1.565 albertel 1698: return <<"RESIZE";
1699: <script type="text/javascript">
1.824 bisitz 1700: // <![CDATA[
1.590 raeburn 1701: $geometry
1.565 albertel 1702:
1.588 albertel 1703: function getX(element) {
1704: var x = 0;
1705: while (element) {
1706: x += element.offsetLeft;
1707: element = element.offsetParent;
1708: }
1709: return x;
1710: }
1711: function getY(element) {
1712: var y = 0;
1713: while (element) {
1714: y += element.offsetTop;
1715: element = element.offsetParent;
1716: }
1717: return y;
1718: }
1719:
1720:
1.565 albertel 1721: function resize_textarea(textarea_id,bottom_id) {
1722: init_geometry();
1723: var textarea = document.getElementById(textarea_id);
1724: //alert(textarea);
1725:
1.588 albertel 1726: var textarea_top = getY(textarea);
1.565 albertel 1727: var textarea_height = textarea.offsetHeight;
1728: var bottom = document.getElementById(bottom_id);
1.588 albertel 1729: var bottom_top = getY(bottom);
1.565 albertel 1730: var bottom_height = bottom.offsetHeight;
1731: var window_height = Geometry.getViewportHeight();
1.588 albertel 1732: var fudge = 23;
1.565 albertel 1733: var new_height = window_height-fudge-textarea_top-bottom_height;
1734: if (new_height < 300) {
1735: new_height = 300;
1736: }
1737: textarea.style.height=new_height+'px';
1738: }
1.824 bisitz 1739: // ]]>
1.565 albertel 1740: </script>
1741: RESIZE
1742:
1743: }
1744:
1745: =pod
1746:
1.256 matthew 1747: =head1 Excel and CSV file utility routines
1748:
1749: =cut
1750:
1751: ###############################################################
1752: ###############################################################
1753:
1754: =pod
1755:
1.1075.2.56 raeburn 1756: =over 4
1757:
1.648 raeburn 1758: =item * &csv_translate($text)
1.37 matthew 1759:
1.185 www 1760: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1761: format.
1762:
1763: =cut
1764:
1.180 matthew 1765: ###############################################################
1766: ###############################################################
1.37 matthew 1767: sub csv_translate {
1768: my $text = shift;
1769: $text =~ s/\"/\"\"/g;
1.209 albertel 1770: $text =~ s/\n/ /g;
1.37 matthew 1771: return $text;
1772: }
1.180 matthew 1773:
1774: ###############################################################
1775: ###############################################################
1776:
1777: =pod
1778:
1.648 raeburn 1779: =item * &define_excel_formats()
1.180 matthew 1780:
1781: Define some commonly used Excel cell formats.
1782:
1783: Currently supported formats:
1784:
1785: =over 4
1786:
1787: =item header
1788:
1789: =item bold
1790:
1791: =item h1
1792:
1793: =item h2
1794:
1795: =item h3
1796:
1.256 matthew 1797: =item h4
1798:
1799: =item i
1800:
1.180 matthew 1801: =item date
1802:
1803: =back
1804:
1805: Inputs: $workbook
1806:
1807: Returns: $format, a hash reference.
1808:
1.1057 foxr 1809:
1.180 matthew 1810: =cut
1811:
1812: ###############################################################
1813: ###############################################################
1814: sub define_excel_formats {
1815: my ($workbook) = @_;
1816: my $format;
1817: $format->{'header'} = $workbook->add_format(bold => 1,
1818: bottom => 1,
1819: align => 'center');
1820: $format->{'bold'} = $workbook->add_format(bold=>1);
1821: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1822: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1823: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1824: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1825: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1826: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1827: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1828: return $format;
1829: }
1830:
1831: ###############################################################
1832: ###############################################################
1.113 bowersj2 1833:
1834: =pod
1835:
1.648 raeburn 1836: =item * &create_workbook()
1.255 matthew 1837:
1838: Create an Excel worksheet. If it fails, output message on the
1839: request object and return undefs.
1840:
1841: Inputs: Apache request object
1842:
1843: Returns (undef) on failure,
1844: Excel worksheet object, scalar with filename, and formats
1845: from &Apache::loncommon::define_excel_formats on success
1846:
1847: =cut
1848:
1849: ###############################################################
1850: ###############################################################
1851: sub create_workbook {
1852: my ($r) = @_;
1853: #
1854: # Create the excel spreadsheet
1855: my $filename = '/prtspool/'.
1.258 albertel 1856: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1857: time.'_'.rand(1000000000).'.xls';
1858: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1859: if (! defined($workbook)) {
1860: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1861: $r->print(
1862: '<p class="LC_error">'
1863: .&mt('Problems occurred in creating the new Excel file.')
1864: .' '.&mt('This error has been logged.')
1865: .' '.&mt('Please alert your LON-CAPA administrator.')
1866: .'</p>'
1867: );
1.255 matthew 1868: return (undef);
1869: }
1870: #
1.1014 foxr 1871: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1872: #
1873: my $format = &Apache::loncommon::define_excel_formats($workbook);
1874: return ($workbook,$filename,$format);
1875: }
1876:
1877: ###############################################################
1878: ###############################################################
1879:
1880: =pod
1881:
1.648 raeburn 1882: =item * &create_text_file()
1.113 bowersj2 1883:
1.542 raeburn 1884: Create a file to write to and eventually make available to the user.
1.256 matthew 1885: If file creation fails, outputs an error message on the request object and
1886: return undefs.
1.113 bowersj2 1887:
1.256 matthew 1888: Inputs: Apache request object, and file suffix
1.113 bowersj2 1889:
1.256 matthew 1890: Returns (undef) on failure,
1891: Filehandle and filename on success.
1.113 bowersj2 1892:
1893: =cut
1894:
1.256 matthew 1895: ###############################################################
1896: ###############################################################
1897: sub create_text_file {
1898: my ($r,$suffix) = @_;
1899: if (! defined($suffix)) { $suffix = 'txt'; };
1900: my $fh;
1901: my $filename = '/prtspool/'.
1.258 albertel 1902: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1903: time.'_'.rand(1000000000).'.'.$suffix;
1904: $fh = Apache::File->new('>/home/httpd'.$filename);
1905: if (! defined($fh)) {
1906: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1907: $r->print(
1908: '<p class="LC_error">'
1909: .&mt('Problems occurred in creating the output file.')
1910: .' '.&mt('This error has been logged.')
1911: .' '.&mt('Please alert your LON-CAPA administrator.')
1912: .'</p>'
1913: );
1.113 bowersj2 1914: }
1.256 matthew 1915: return ($fh,$filename)
1.113 bowersj2 1916: }
1917:
1918:
1.256 matthew 1919: =pod
1.113 bowersj2 1920:
1921: =back
1922:
1923: =cut
1.37 matthew 1924:
1925: ###############################################################
1.33 matthew 1926: ## Home server <option> list generating code ##
1927: ###############################################################
1.35 matthew 1928:
1.169 www 1929: # ------------------------------------------
1930:
1931: sub domain_select {
1932: my ($name,$value,$multiple)=@_;
1933: my %domains=map {
1.514 albertel 1934: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1935: } &Apache::lonnet::all_domains();
1.169 www 1936: if ($multiple) {
1937: $domains{''}=&mt('Any domain');
1.550 albertel 1938: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1939: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1940: } else {
1.550 albertel 1941: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1942: return &select_form($name,$value,\%domains);
1.169 www 1943: }
1944: }
1945:
1.282 albertel 1946: #-------------------------------------------
1947:
1948: =pod
1949:
1.519 raeburn 1950: =head1 Routines for form select boxes
1951:
1952: =over 4
1953:
1.648 raeburn 1954: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1955:
1956: Returns a string containing a <select> element int multiple mode
1957:
1958:
1959: Args:
1960: $name - name of the <select> element
1.506 raeburn 1961: $value - scalar or array ref of values that should already be selected
1.282 albertel 1962: $size - number of rows long the select element is
1.283 albertel 1963: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1964: (shown text should already have been &mt())
1.506 raeburn 1965: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1966:
1.282 albertel 1967: =cut
1968:
1969: #-------------------------------------------
1.169 www 1970: sub multiple_select_form {
1.284 albertel 1971: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1972: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1973: my $output='';
1.191 matthew 1974: if (! defined($size)) {
1975: $size = 4;
1.283 albertel 1976: if (scalar(keys(%$hash))<4) {
1977: $size = scalar(keys(%$hash));
1.191 matthew 1978: }
1979: }
1.734 bisitz 1980: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1981: my @order;
1.506 raeburn 1982: if (ref($order) eq 'ARRAY') {
1983: @order = @{$order};
1984: } else {
1985: @order = sort(keys(%$hash));
1.501 banghart 1986: }
1987: if (exists($$hash{'select_form_order'})) {
1988: @order = @{$$hash{'select_form_order'}};
1989: }
1990:
1.284 albertel 1991: foreach my $key (@order) {
1.356 albertel 1992: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 1993: $output.='selected="selected" ' if ($selected{$key});
1994: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 1995: }
1996: $output.="</select>\n";
1997: return $output;
1998: }
1999:
1.88 www 2000: #-------------------------------------------
2001:
2002: =pod
2003:
1.970 raeburn 2004: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 2005:
2006: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2007: allow a user to select options from a ref to a hash containing:
2008: option_name => displayed text. An optional $onchange can include
2009: a javascript onchange item, e.g., onchange="this.form.submit();"
2010:
1.88 www 2011: See lonrights.pm for an example invocation and use.
2012:
2013: =cut
2014:
2015: #-------------------------------------------
2016: sub select_form {
1.970 raeburn 2017: my ($def,$name,$hashref,$onchange) = @_;
2018: return unless (ref($hashref) eq 'HASH');
2019: if ($onchange) {
2020: $onchange = ' onchange="'.$onchange.'"';
2021: }
2022: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2023: my @keys;
1.970 raeburn 2024: if (exists($hashref->{'select_form_order'})) {
2025: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2026: } else {
1.970 raeburn 2027: @keys=sort(keys(%{$hashref}));
1.128 albertel 2028: }
1.356 albertel 2029: foreach my $key (@keys) {
2030: $selectform.=
2031: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2032: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2033: ">".$hashref->{$key}."</option>\n";
1.88 www 2034: }
2035: $selectform.="</select>";
2036: return $selectform;
2037: }
2038:
1.475 www 2039: # For display filters
2040:
2041: sub display_filter {
1.1074 raeburn 2042: my ($context) = @_;
1.475 www 2043: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2044: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2045: my $phraseinput = 'hidden';
2046: my $includeinput = 'hidden';
2047: my ($checked,$includetypestext);
2048: if ($env{'form.displayfilter'} eq 'containing') {
2049: $phraseinput = 'text';
2050: if ($context eq 'parmslog') {
2051: $includeinput = 'checkbox';
2052: if ($env{'form.includetypes'}) {
2053: $checked = ' checked="checked"';
2054: }
2055: $includetypestext = &mt('Include parameter types');
2056: }
2057: } else {
2058: $includetypestext = ' ';
2059: }
2060: my ($additional,$secondid,$thirdid);
2061: if ($context eq 'parmslog') {
2062: $additional =
2063: '<label><input type="'.$includeinput.'" name="includetypes"'.
2064: $checked.' name="includetypes" value="1" id="includetypes" />'.
2065: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2066: '</label>';
2067: $secondid = 'includetypes';
2068: $thirdid = 'includetypestext';
2069: }
2070: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2071: '$secondid','$thirdid')";
2072: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2073: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2074: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2075: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2076: &mt('Filter: [_1]',
1.477 www 2077: &select_form($env{'form.displayfilter'},
2078: 'displayfilter',
1.970 raeburn 2079: {'currentfolder' => 'Current folder/page',
1.477 www 2080: 'containing' => 'Containing phrase',
1.1074 raeburn 2081: 'none' => 'None'},$onchange)).' '.
2082: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2083: &HTML::Entities::encode($env{'form.containingphrase'}).
2084: '" />'.$additional;
2085: }
2086:
2087: sub display_filter_js {
2088: my $includetext = &mt('Include parameter types');
2089: return <<"ENDJS";
2090:
2091: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2092: var firstType = 'hidden';
2093: if (setter.options[setter.selectedIndex].value == 'containing') {
2094: firstType = 'text';
2095: }
2096: firstObject = document.getElementById(firstid);
2097: if (typeof(firstObject) == 'object') {
2098: if (firstObject.type != firstType) {
2099: changeInputType(firstObject,firstType);
2100: }
2101: }
2102: if (context == 'parmslog') {
2103: var secondType = 'hidden';
2104: if (firstType == 'text') {
2105: secondType = 'checkbox';
2106: }
2107: secondObject = document.getElementById(secondid);
2108: if (typeof(secondObject) == 'object') {
2109: if (secondObject.type != secondType) {
2110: changeInputType(secondObject,secondType);
2111: }
2112: }
2113: var textItem = document.getElementById(thirdid);
2114: var currtext = textItem.innerHTML;
2115: var newtext;
2116: if (firstType == 'text') {
2117: newtext = '$includetext';
2118: } else {
2119: newtext = ' ';
2120: }
2121: if (currtext != newtext) {
2122: textItem.innerHTML = newtext;
2123: }
2124: }
2125: return;
2126: }
2127:
2128: function changeInputType(oldObject,newType) {
2129: var newObject = document.createElement('input');
2130: newObject.type = newType;
2131: if (oldObject.size) {
2132: newObject.size = oldObject.size;
2133: }
2134: if (oldObject.value) {
2135: newObject.value = oldObject.value;
2136: }
2137: if (oldObject.name) {
2138: newObject.name = oldObject.name;
2139: }
2140: if (oldObject.id) {
2141: newObject.id = oldObject.id;
2142: }
2143: oldObject.parentNode.replaceChild(newObject,oldObject);
2144: return;
2145: }
2146:
2147: ENDJS
1.475 www 2148: }
2149:
1.167 www 2150: sub gradeleveldescription {
2151: my $gradelevel=shift;
2152: my %gradelevels=(0 => 'Not specified',
2153: 1 => 'Grade 1',
2154: 2 => 'Grade 2',
2155: 3 => 'Grade 3',
2156: 4 => 'Grade 4',
2157: 5 => 'Grade 5',
2158: 6 => 'Grade 6',
2159: 7 => 'Grade 7',
2160: 8 => 'Grade 8',
2161: 9 => 'Grade 9',
2162: 10 => 'Grade 10',
2163: 11 => 'Grade 11',
2164: 12 => 'Grade 12',
2165: 13 => 'Grade 13',
2166: 14 => '100 Level',
2167: 15 => '200 Level',
2168: 16 => '300 Level',
2169: 17 => '400 Level',
2170: 18 => 'Graduate Level');
2171: return &mt($gradelevels{$gradelevel});
2172: }
2173:
1.163 www 2174: sub select_level_form {
2175: my ($deflevel,$name)=@_;
2176: unless ($deflevel) { $deflevel=0; }
1.167 www 2177: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2178: for (my $i=0; $i<=18; $i++) {
2179: $selectform.="<option value=\"$i\" ".
1.253 albertel 2180: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2181: ">".&gradeleveldescription($i)."</option>\n";
2182: }
2183: $selectform.="</select>";
2184: return $selectform;
1.163 www 2185: }
1.167 www 2186:
1.35 matthew 2187: #-------------------------------------------
2188:
1.45 matthew 2189: =pod
2190:
1.1075.2.42 raeburn 2191: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2192:
2193: Returns a string containing a <select name='$name' size='1'> form to
2194: allow a user to select the domain to preform an operation in.
2195: See loncreateuser.pm for an example invocation and use.
2196:
1.90 www 2197: If the $includeempty flag is set, it also includes an empty choice ("no domain
2198: selected");
2199:
1.743 raeburn 2200: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2201:
1.910 raeburn 2202: 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.
2203:
1.1075.2.36 raeburn 2204: The optional $incdoms is a reference to an array of domains which will be the only available options.
2205:
2206: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2207:
1.35 matthew 2208: =cut
2209:
2210: #-------------------------------------------
1.34 matthew 2211: sub select_dom_form {
1.1075.2.36 raeburn 2212: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2213: if ($onchange) {
1.874 raeburn 2214: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2215: }
1.1075.2.36 raeburn 2216: my (@domains,%exclude);
1.910 raeburn 2217: if (ref($incdoms) eq 'ARRAY') {
2218: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2219: } else {
2220: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2221: }
1.90 www 2222: if ($includeempty) { @domains=('',@domains); }
1.1075.2.36 raeburn 2223: if (ref($excdoms) eq 'ARRAY') {
2224: map { $exclude{$_} = 1; } @{$excdoms};
2225: }
1.743 raeburn 2226: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2227: foreach my $dom (@domains) {
1.1075.2.36 raeburn 2228: next if ($exclude{$dom});
1.356 albertel 2229: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2230: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2231: if ($showdomdesc) {
2232: if ($dom ne '') {
2233: my $domdesc = &Apache::lonnet::domain($dom,'description');
2234: if ($domdesc ne '') {
2235: $selectdomain .= ' ('.$domdesc.')';
2236: }
2237: }
2238: }
2239: $selectdomain .= "</option>\n";
1.34 matthew 2240: }
2241: $selectdomain.="</select>";
2242: return $selectdomain;
2243: }
2244:
1.35 matthew 2245: #-------------------------------------------
2246:
1.45 matthew 2247: =pod
2248:
1.648 raeburn 2249: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2250:
1.586 raeburn 2251: input: 4 arguments (two required, two optional) -
2252: $domain - domain of new user
2253: $name - name of form element
2254: $default - Value of 'default' causes a default item to be first
2255: option, and selected by default.
2256: $hide - Value of 'hide' causes hiding of the name of the server,
2257: if 1 server found, or default, if 0 found.
1.594 raeburn 2258: output: returns 2 items:
1.586 raeburn 2259: (a) form element which contains either:
2260: (i) <select name="$name">
2261: <option value="$hostid1">$hostid $servers{$hostid}</option>
2262: <option value="$hostid2">$hostid $servers{$hostid}</option>
2263: </select>
2264: form item if there are multiple library servers in $domain, or
2265: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2266: if there is only one library server in $domain.
2267:
2268: (b) number of library servers found.
2269:
2270: See loncreateuser.pm for example of use.
1.35 matthew 2271:
2272: =cut
2273:
2274: #-------------------------------------------
1.586 raeburn 2275: sub home_server_form_item {
2276: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2277: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2278: my $result;
2279: my $numlib = keys(%servers);
2280: if ($numlib > 1) {
2281: $result .= '<select name="'.$name.'" />'."\n";
2282: if ($default) {
1.804 bisitz 2283: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2284: '</option>'."\n";
2285: }
2286: foreach my $hostid (sort(keys(%servers))) {
2287: $result.= '<option value="'.$hostid.'">'.
2288: $hostid.' '.$servers{$hostid}."</option>\n";
2289: }
2290: $result .= '</select>'."\n";
2291: } elsif ($numlib == 1) {
2292: my $hostid;
2293: foreach my $item (keys(%servers)) {
2294: $hostid = $item;
2295: }
2296: $result .= '<input type="hidden" name="'.$name.'" value="'.
2297: $hostid.'" />';
2298: if (!$hide) {
2299: $result .= $hostid.' '.$servers{$hostid};
2300: }
2301: $result .= "\n";
2302: } elsif ($default) {
2303: $result .= '<input type="hidden" name="'.$name.
2304: '" value="default" />';
2305: if (!$hide) {
2306: $result .= &mt('default');
2307: }
2308: $result .= "\n";
1.33 matthew 2309: }
1.586 raeburn 2310: return ($result,$numlib);
1.33 matthew 2311: }
1.112 bowersj2 2312:
2313: =pod
2314:
1.534 albertel 2315: =back
2316:
1.112 bowersj2 2317: =cut
1.87 matthew 2318:
2319: ###############################################################
1.112 bowersj2 2320: ## Decoding User Agent ##
1.87 matthew 2321: ###############################################################
2322:
2323: =pod
2324:
1.112 bowersj2 2325: =head1 Decoding the User Agent
2326:
2327: =over 4
2328:
2329: =item * &decode_user_agent()
1.87 matthew 2330:
2331: Inputs: $r
2332:
2333: Outputs:
2334:
2335: =over 4
2336:
1.112 bowersj2 2337: =item * $httpbrowser
1.87 matthew 2338:
1.112 bowersj2 2339: =item * $clientbrowser
1.87 matthew 2340:
1.112 bowersj2 2341: =item * $clientversion
1.87 matthew 2342:
1.112 bowersj2 2343: =item * $clientmathml
1.87 matthew 2344:
1.112 bowersj2 2345: =item * $clientunicode
1.87 matthew 2346:
1.112 bowersj2 2347: =item * $clientos
1.87 matthew 2348:
1.1075.2.42 raeburn 2349: =item * $clientmobile
2350:
2351: =item * $clientinfo
2352:
1.1075.2.77 raeburn 2353: =item * $clientosversion
2354:
1.87 matthew 2355: =back
2356:
1.157 matthew 2357: =back
2358:
1.87 matthew 2359: =cut
2360:
2361: ###############################################################
2362: ###############################################################
2363: sub decode_user_agent {
1.247 albertel 2364: my ($r)=@_;
1.87 matthew 2365: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2366: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2367: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2368: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2369: my $clientbrowser='unknown';
2370: my $clientversion='0';
2371: my $clientmathml='';
2372: my $clientunicode='0';
1.1075.2.42 raeburn 2373: my $clientmobile=0;
1.1075.2.77 raeburn 2374: my $clientosversion='';
1.87 matthew 2375: for (my $i=0;$i<=$#browsertype;$i++) {
1.1075.2.76 raeburn 2376: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2377: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2378: $clientbrowser=$bname;
2379: $httpbrowser=~/$vreg/i;
2380: $clientversion=$1;
2381: $clientmathml=($clientversion>=$minv);
2382: $clientunicode=($clientversion>=$univ);
2383: }
2384: }
2385: my $clientos='unknown';
1.1075.2.42 raeburn 2386: my $clientinfo;
1.87 matthew 2387: if (($httpbrowser=~/linux/i) ||
2388: ($httpbrowser=~/unix/i) ||
2389: ($httpbrowser=~/ux/i) ||
2390: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2391: if (($httpbrowser=~/vax/i) ||
2392: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2393: if ($httpbrowser=~/next/i) { $clientos='next'; }
2394: if (($httpbrowser=~/mac/i) ||
2395: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1075.2.77 raeburn 2396: if ($httpbrowser=~/win/i) {
2397: $clientos='win';
2398: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2399: $clientosversion = $1;
2400: }
2401: }
1.87 matthew 2402: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1075.2.42 raeburn 2403: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2404: $clientmobile=lc($1);
2405: }
2406: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2407: $clientinfo = 'firefox-'.$1;
2408: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2409: $clientinfo = 'chromeframe-'.$1;
2410: }
1.87 matthew 2411: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1075.2.77 raeburn 2412: $clientunicode,$clientos,$clientmobile,$clientinfo,
2413: $clientosversion);
1.87 matthew 2414: }
2415:
1.32 matthew 2416: ###############################################################
2417: ## Authentication changing form generation subroutines ##
2418: ###############################################################
2419: ##
2420: ## All of the authform_xxxxxxx subroutines take their inputs in a
2421: ## hash, and have reasonable default values.
2422: ##
2423: ## formname = the name given in the <form> tag.
1.35 matthew 2424: #-------------------------------------------
2425:
1.45 matthew 2426: =pod
2427:
1.112 bowersj2 2428: =head1 Authentication Routines
2429:
2430: =over 4
2431:
1.648 raeburn 2432: =item * &authform_xxxxxx()
1.35 matthew 2433:
2434: The authform_xxxxxx subroutines provide javascript and html forms which
2435: handle some of the conveniences required for authentication forms.
2436: This is not an optimal method, but it works.
2437:
2438: =over 4
2439:
1.112 bowersj2 2440: =item * authform_header
1.35 matthew 2441:
1.112 bowersj2 2442: =item * authform_authorwarning
1.35 matthew 2443:
1.112 bowersj2 2444: =item * authform_nochange
1.35 matthew 2445:
1.112 bowersj2 2446: =item * authform_kerberos
1.35 matthew 2447:
1.112 bowersj2 2448: =item * authform_internal
1.35 matthew 2449:
1.112 bowersj2 2450: =item * authform_filesystem
1.35 matthew 2451:
2452: =back
2453:
1.648 raeburn 2454: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2455:
1.35 matthew 2456: =cut
2457:
2458: #-------------------------------------------
1.32 matthew 2459: sub authform_header{
2460: my %in = (
2461: formname => 'cu',
1.80 albertel 2462: kerb_def_dom => '',
1.32 matthew 2463: @_,
2464: );
2465: $in{'formname'} = 'document.' . $in{'formname'};
2466: my $result='';
1.80 albertel 2467:
2468: #---------------------------------------------- Code for upper case translation
2469: my $Javascript_toUpperCase;
2470: unless ($in{kerb_def_dom}) {
2471: $Javascript_toUpperCase =<<"END";
2472: switch (choice) {
2473: case 'krb': currentform.elements[choicearg].value =
2474: currentform.elements[choicearg].value.toUpperCase();
2475: break;
2476: default:
2477: }
2478: END
2479: } else {
2480: $Javascript_toUpperCase = "";
2481: }
2482:
1.165 raeburn 2483: my $radioval = "'nochange'";
1.591 raeburn 2484: if (defined($in{'curr_authtype'})) {
2485: if ($in{'curr_authtype'} ne '') {
2486: $radioval = "'".$in{'curr_authtype'}."arg'";
2487: }
1.174 matthew 2488: }
1.165 raeburn 2489: my $argfield = 'null';
1.591 raeburn 2490: if (defined($in{'mode'})) {
1.165 raeburn 2491: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2492: if (defined($in{'curr_autharg'})) {
2493: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2494: $argfield = "'$in{'curr_autharg'}'";
2495: }
2496: }
2497: }
2498: }
2499:
1.32 matthew 2500: $result.=<<"END";
2501: var current = new Object();
1.165 raeburn 2502: current.radiovalue = $radioval;
2503: current.argfield = $argfield;
1.32 matthew 2504:
2505: function changed_radio(choice,currentform) {
2506: var choicearg = choice + 'arg';
2507: // If a radio button in changed, we need to change the argfield
2508: if (current.radiovalue != choice) {
2509: current.radiovalue = choice;
2510: if (current.argfield != null) {
2511: currentform.elements[current.argfield].value = '';
2512: }
2513: if (choice == 'nochange') {
2514: current.argfield = null;
2515: } else {
2516: current.argfield = choicearg;
2517: switch(choice) {
2518: case 'krb':
2519: currentform.elements[current.argfield].value =
2520: "$in{'kerb_def_dom'}";
2521: break;
2522: default:
2523: break;
2524: }
2525: }
2526: }
2527: return;
2528: }
1.22 www 2529:
1.32 matthew 2530: function changed_text(choice,currentform) {
2531: var choicearg = choice + 'arg';
2532: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2533: $Javascript_toUpperCase
1.32 matthew 2534: // clear old field
2535: if ((current.argfield != choicearg) && (current.argfield != null)) {
2536: currentform.elements[current.argfield].value = '';
2537: }
2538: current.argfield = choicearg;
2539: }
2540: set_auth_radio_buttons(choice,currentform);
2541: return;
1.20 www 2542: }
1.32 matthew 2543:
2544: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2545: var numauthchoices = currentform.login.length;
2546: if (typeof numauthchoices == "undefined") {
2547: return;
2548: }
1.32 matthew 2549: var i=0;
1.986 raeburn 2550: while (i < numauthchoices) {
1.32 matthew 2551: if (currentform.login[i].value == newvalue) { break; }
2552: i++;
2553: }
1.986 raeburn 2554: if (i == numauthchoices) {
1.32 matthew 2555: return;
2556: }
2557: current.radiovalue = newvalue;
2558: currentform.login[i].checked = true;
2559: return;
2560: }
2561: END
2562: return $result;
2563: }
2564:
1.1075.2.20 raeburn 2565: sub authform_authorwarning {
1.32 matthew 2566: my $result='';
1.144 matthew 2567: $result='<i>'.
2568: &mt('As a general rule, only authors or co-authors should be '.
2569: 'filesystem authenticated '.
2570: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2571: return $result;
2572: }
2573:
1.1075.2.20 raeburn 2574: sub authform_nochange {
1.32 matthew 2575: my %in = (
2576: formname => 'document.cu',
2577: kerb_def_dom => 'MSU.EDU',
2578: @_,
2579: );
1.1075.2.20 raeburn 2580: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2581: my $result;
1.1075.2.20 raeburn 2582: if (!$authnum) {
2583: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2584: } else {
2585: $result = '<label>'.&mt('[_1] Do not change login data',
2586: '<input type="radio" name="login" value="nochange" '.
2587: 'checked="checked" onclick="'.
1.281 albertel 2588: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2589: '</label>';
1.586 raeburn 2590: }
1.32 matthew 2591: return $result;
2592: }
2593:
1.591 raeburn 2594: sub authform_kerberos {
1.32 matthew 2595: my %in = (
2596: formname => 'document.cu',
2597: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2598: kerb_def_auth => 'krb4',
1.32 matthew 2599: @_,
2600: );
1.586 raeburn 2601: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2602: $autharg,$jscall);
1.1075.2.20 raeburn 2603: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2604: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2605: $check5 = ' checked="checked"';
1.80 albertel 2606: } else {
1.772 bisitz 2607: $check4 = ' checked="checked"';
1.80 albertel 2608: }
1.165 raeburn 2609: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2610: if (defined($in{'curr_authtype'})) {
2611: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2612: $krbcheck = ' checked="checked"';
1.623 raeburn 2613: if (defined($in{'mode'})) {
2614: if ($in{'mode'} eq 'modifyuser') {
2615: $krbcheck = '';
2616: }
2617: }
1.591 raeburn 2618: if (defined($in{'curr_kerb_ver'})) {
2619: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2620: $check5 = ' checked="checked"';
1.591 raeburn 2621: $check4 = '';
2622: } else {
1.772 bisitz 2623: $check4 = ' checked="checked"';
1.591 raeburn 2624: $check5 = '';
2625: }
1.586 raeburn 2626: }
1.591 raeburn 2627: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2628: $krbarg = $in{'curr_autharg'};
2629: }
1.586 raeburn 2630: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2631: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2632: $result =
2633: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2634: $in{'curr_autharg'},$krbver);
2635: } else {
2636: $result =
2637: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2638: }
2639: return $result;
2640: }
2641: }
2642: } else {
2643: if ($authnum == 1) {
1.784 bisitz 2644: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2645: }
2646: }
1.586 raeburn 2647: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2648: return;
1.587 raeburn 2649: } elsif ($authtype eq '') {
1.591 raeburn 2650: if (defined($in{'mode'})) {
1.587 raeburn 2651: if ($in{'mode'} eq 'modifycourse') {
2652: if ($authnum == 1) {
1.1075.2.20 raeburn 2653: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2654: }
2655: }
2656: }
1.586 raeburn 2657: }
2658: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2659: if ($authtype eq '') {
2660: $authtype = '<input type="radio" name="login" value="krb" '.
2661: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2662: $krbcheck.' />';
2663: }
2664: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1075.2.20 raeburn 2665: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2666: $in{'curr_authtype'} eq 'krb5') ||
1.1075.2.20 raeburn 2667: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2668: $in{'curr_authtype'} eq 'krb4')) {
2669: $result .= &mt
1.144 matthew 2670: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2671: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2672: '<label>'.$authtype,
1.281 albertel 2673: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2674: 'value="'.$krbarg.'" '.
1.144 matthew 2675: 'onchange="'.$jscall.'" />',
1.281 albertel 2676: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2677: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2678: '</label>');
1.586 raeburn 2679: } elsif ($can_assign{'krb4'}) {
2680: $result .= &mt
2681: ('[_1] Kerberos authenticated with domain [_2] '.
2682: '[_3] Version 4 [_4]',
2683: '<label>'.$authtype,
2684: '</label><input type="text" size="10" name="krbarg" '.
2685: 'value="'.$krbarg.'" '.
2686: 'onchange="'.$jscall.'" />',
2687: '<label><input type="hidden" name="krbver" value="4" />',
2688: '</label>');
2689: } elsif ($can_assign{'krb5'}) {
2690: $result .= &mt
2691: ('[_1] Kerberos authenticated with domain [_2] '.
2692: '[_3] Version 5 [_4]',
2693: '<label>'.$authtype,
2694: '</label><input type="text" size="10" name="krbarg" '.
2695: 'value="'.$krbarg.'" '.
2696: 'onchange="'.$jscall.'" />',
2697: '<label><input type="hidden" name="krbver" value="5" />',
2698: '</label>');
2699: }
1.32 matthew 2700: return $result;
2701: }
2702:
1.1075.2.20 raeburn 2703: sub authform_internal {
1.586 raeburn 2704: my %in = (
1.32 matthew 2705: formname => 'document.cu',
2706: kerb_def_dom => 'MSU.EDU',
2707: @_,
2708: );
1.586 raeburn 2709: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2710: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2711: if (defined($in{'curr_authtype'})) {
2712: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2713: if ($can_assign{'int'}) {
1.772 bisitz 2714: $intcheck = 'checked="checked" ';
1.623 raeburn 2715: if (defined($in{'mode'})) {
2716: if ($in{'mode'} eq 'modifyuser') {
2717: $intcheck = '';
2718: }
2719: }
1.591 raeburn 2720: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2721: $intarg = $in{'curr_autharg'};
2722: }
2723: } else {
2724: $result = &mt('Currently internally authenticated.');
2725: return $result;
1.165 raeburn 2726: }
2727: }
1.586 raeburn 2728: } else {
2729: if ($authnum == 1) {
1.784 bisitz 2730: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2731: }
2732: }
2733: if (!$can_assign{'int'}) {
2734: return;
1.587 raeburn 2735: } elsif ($authtype eq '') {
1.591 raeburn 2736: if (defined($in{'mode'})) {
1.587 raeburn 2737: if ($in{'mode'} eq 'modifycourse') {
2738: if ($authnum == 1) {
1.1075.2.20 raeburn 2739: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2740: }
2741: }
2742: }
1.165 raeburn 2743: }
1.586 raeburn 2744: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2745: if ($authtype eq '') {
2746: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2747: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2748: }
1.605 bisitz 2749: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2750: $intarg.'" onchange="'.$jscall.'" />';
2751: $result = &mt
1.144 matthew 2752: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2753: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2754: $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 2755: return $result;
2756: }
2757:
1.1075.2.20 raeburn 2758: sub authform_local {
1.32 matthew 2759: my %in = (
2760: formname => 'document.cu',
2761: kerb_def_dom => 'MSU.EDU',
2762: @_,
2763: );
1.586 raeburn 2764: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2765: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2766: if (defined($in{'curr_authtype'})) {
2767: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2768: if ($can_assign{'loc'}) {
1.772 bisitz 2769: $loccheck = 'checked="checked" ';
1.623 raeburn 2770: if (defined($in{'mode'})) {
2771: if ($in{'mode'} eq 'modifyuser') {
2772: $loccheck = '';
2773: }
2774: }
1.591 raeburn 2775: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2776: $locarg = $in{'curr_autharg'};
2777: }
2778: } else {
2779: $result = &mt('Currently using local (institutional) authentication.');
2780: return $result;
1.165 raeburn 2781: }
2782: }
1.586 raeburn 2783: } else {
2784: if ($authnum == 1) {
1.784 bisitz 2785: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2786: }
2787: }
2788: if (!$can_assign{'loc'}) {
2789: return;
1.587 raeburn 2790: } elsif ($authtype eq '') {
1.591 raeburn 2791: if (defined($in{'mode'})) {
1.587 raeburn 2792: if ($in{'mode'} eq 'modifycourse') {
2793: if ($authnum == 1) {
1.1075.2.20 raeburn 2794: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 2795: }
2796: }
2797: }
1.165 raeburn 2798: }
1.586 raeburn 2799: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2800: if ($authtype eq '') {
2801: $authtype = '<input type="radio" name="login" value="loc" '.
2802: $loccheck.' onchange="'.$jscall.'" onclick="'.
2803: $jscall.'" />';
2804: }
2805: $autharg = '<input type="text" size="10" name="locarg" value="'.
2806: $locarg.'" onchange="'.$jscall.'" />';
2807: $result = &mt('[_1] Local Authentication with argument [_2]',
2808: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2809: return $result;
2810: }
2811:
1.1075.2.20 raeburn 2812: sub authform_filesystem {
1.32 matthew 2813: my %in = (
2814: formname => 'document.cu',
2815: kerb_def_dom => 'MSU.EDU',
2816: @_,
2817: );
1.586 raeburn 2818: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1075.2.20 raeburn 2819: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2820: if (defined($in{'curr_authtype'})) {
2821: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2822: if ($can_assign{'fsys'}) {
1.772 bisitz 2823: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2824: if (defined($in{'mode'})) {
2825: if ($in{'mode'} eq 'modifyuser') {
2826: $fsyscheck = '';
2827: }
2828: }
1.586 raeburn 2829: } else {
2830: $result = &mt('Currently Filesystem Authenticated.');
2831: return $result;
2832: }
2833: }
2834: } else {
2835: if ($authnum == 1) {
1.784 bisitz 2836: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2837: }
2838: }
2839: if (!$can_assign{'fsys'}) {
2840: return;
1.587 raeburn 2841: } elsif ($authtype eq '') {
1.591 raeburn 2842: if (defined($in{'mode'})) {
1.587 raeburn 2843: if ($in{'mode'} eq 'modifycourse') {
2844: if ($authnum == 1) {
1.1075.2.20 raeburn 2845: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 2846: }
2847: }
2848: }
1.586 raeburn 2849: }
2850: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2851: if ($authtype eq '') {
2852: $authtype = '<input type="radio" name="login" value="fsys" '.
2853: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2854: $jscall.'" />';
2855: }
2856: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2857: ' onchange="'.$jscall.'" />';
2858: $result = &mt
1.144 matthew 2859: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2860: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2861: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2862: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2863: 'onchange="'.$jscall.'" />');
1.32 matthew 2864: return $result;
2865: }
2866:
1.586 raeburn 2867: sub get_assignable_auth {
2868: my ($dom) = @_;
2869: if ($dom eq '') {
2870: $dom = $env{'request.role.domain'};
2871: }
2872: my %can_assign = (
2873: krb4 => 1,
2874: krb5 => 1,
2875: int => 1,
2876: loc => 1,
2877: );
2878: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2879: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2880: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2881: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2882: my $context;
2883: if ($env{'request.role'} =~ /^au/) {
2884: $context = 'author';
2885: } elsif ($env{'request.role'} =~ /^dc/) {
2886: $context = 'domain';
2887: } elsif ($env{'request.course.id'}) {
2888: $context = 'course';
2889: }
2890: if ($context) {
2891: if (ref($authhash->{$context}) eq 'HASH') {
2892: %can_assign = %{$authhash->{$context}};
2893: }
2894: }
2895: }
2896: }
2897: my $authnum = 0;
2898: foreach my $key (keys(%can_assign)) {
2899: if ($can_assign{$key}) {
2900: $authnum ++;
2901: }
2902: }
2903: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2904: $authnum --;
2905: }
2906: return ($authnum,%can_assign);
2907: }
2908:
1.80 albertel 2909: ###############################################################
2910: ## Get Kerberos Defaults for Domain ##
2911: ###############################################################
2912: ##
2913: ## Returns default kerberos version and an associated argument
2914: ## as listed in file domain.tab. If not listed, provides
2915: ## appropriate default domain and kerberos version.
2916: ##
2917: #-------------------------------------------
2918:
2919: =pod
2920:
1.648 raeburn 2921: =item * &get_kerberos_defaults()
1.80 albertel 2922:
2923: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2924: version and domain. If not found, it defaults to version 4 and the
2925: domain of the server.
1.80 albertel 2926:
1.648 raeburn 2927: =over 4
2928:
1.80 albertel 2929: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2930:
1.648 raeburn 2931: =back
2932:
2933: =back
2934:
1.80 albertel 2935: =cut
2936:
2937: #-------------------------------------------
2938: sub get_kerberos_defaults {
2939: my $domain=shift;
1.641 raeburn 2940: my ($krbdef,$krbdefdom);
2941: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2942: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2943: $krbdef = $domdefaults{'auth_def'};
2944: $krbdefdom = $domdefaults{'auth_arg_def'};
2945: } else {
1.80 albertel 2946: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2947: my $krbdefdom=$1;
2948: $krbdefdom=~tr/a-z/A-Z/;
2949: $krbdef = "krb4";
2950: }
2951: return ($krbdef,$krbdefdom);
2952: }
1.112 bowersj2 2953:
1.32 matthew 2954:
1.46 matthew 2955: ###############################################################
2956: ## Thesaurus Functions ##
2957: ###############################################################
1.20 www 2958:
1.46 matthew 2959: =pod
1.20 www 2960:
1.112 bowersj2 2961: =head1 Thesaurus Functions
2962:
2963: =over 4
2964:
1.648 raeburn 2965: =item * &initialize_keywords()
1.46 matthew 2966:
2967: Initializes the package variable %Keywords if it is empty. Uses the
2968: package variable $thesaurus_db_file.
2969:
2970: =cut
2971:
2972: ###################################################
2973:
2974: sub initialize_keywords {
2975: return 1 if (scalar keys(%Keywords));
2976: # If we are here, %Keywords is empty, so fill it up
2977: # Make sure the file we need exists...
2978: if (! -e $thesaurus_db_file) {
2979: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2980: " failed because it does not exist");
2981: return 0;
2982: }
2983: # Set up the hash as a database
2984: my %thesaurus_db;
2985: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 2986: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 2987: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
2988: $thesaurus_db_file);
2989: return 0;
2990: }
2991: # Get the average number of appearances of a word.
2992: my $avecount = $thesaurus_db{'average.count'};
2993: # Put keywords (those that appear > average) into %Keywords
2994: while (my ($word,$data)=each (%thesaurus_db)) {
2995: my ($count,undef) = split /:/,$data;
2996: $Keywords{$word}++ if ($count > $avecount);
2997: }
2998: untie %thesaurus_db;
2999: # Remove special values from %Keywords.
1.356 albertel 3000: foreach my $value ('total.count','average.count') {
3001: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3002: }
1.46 matthew 3003: return 1;
3004: }
3005:
3006: ###################################################
3007:
3008: =pod
3009:
1.648 raeburn 3010: =item * &keyword($word)
1.46 matthew 3011:
3012: Returns true if $word is a keyword. A keyword is a word that appears more
3013: than the average number of times in the thesaurus database. Calls
3014: &initialize_keywords
3015:
3016: =cut
3017:
3018: ###################################################
1.20 www 3019:
3020: sub keyword {
1.46 matthew 3021: return if (!&initialize_keywords());
3022: my $word=lc(shift());
3023: $word=~s/\W//g;
3024: return exists($Keywords{$word});
1.20 www 3025: }
1.46 matthew 3026:
3027: ###############################################################
3028:
3029: =pod
1.20 www 3030:
1.648 raeburn 3031: =item * &get_related_words()
1.46 matthew 3032:
1.160 matthew 3033: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3034: an array of words. If the keyword is not in the thesaurus, an empty array
3035: will be returned. The order of the words returned is determined by the
3036: database which holds them.
3037:
3038: Uses global $thesaurus_db_file.
3039:
1.1057 foxr 3040:
1.46 matthew 3041: =cut
3042:
3043: ###############################################################
3044: sub get_related_words {
3045: my $keyword = shift;
3046: my %thesaurus_db;
3047: if (! -e $thesaurus_db_file) {
3048: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3049: "failed because the file does not exist");
3050: return ();
3051: }
3052: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3053: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3054: return ();
3055: }
3056: my @Words=();
1.429 www 3057: my $count=0;
1.46 matthew 3058: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3059: # The first element is the number of times
3060: # the word appears. We do not need it now.
1.429 www 3061: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3062: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3063: my $threshold=$mostfrequentcount/10;
3064: foreach my $possibleword (@RelatedWords) {
3065: my ($word,$wordcount)=split(/\,/,$possibleword);
3066: if ($wordcount>$threshold) {
3067: push(@Words,$word);
3068: $count++;
3069: if ($count>10) { last; }
3070: }
1.20 www 3071: }
3072: }
1.46 matthew 3073: untie %thesaurus_db;
3074: return @Words;
1.14 harris41 3075: }
1.46 matthew 3076:
1.112 bowersj2 3077: =pod
3078:
3079: =back
3080:
3081: =cut
1.61 www 3082:
3083: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3084: =pod
3085:
1.112 bowersj2 3086: =head1 User Name Functions
3087:
3088: =over 4
3089:
1.648 raeburn 3090: =item * &plainname($uname,$udom,$first)
1.81 albertel 3091:
1.112 bowersj2 3092: Takes a users logon name and returns it as a string in
1.226 albertel 3093: "first middle last generation" form
3094: if $first is set to 'lastname' then it returns it as
3095: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3096:
3097: =cut
1.61 www 3098:
1.295 www 3099:
1.81 albertel 3100: ###############################################################
1.61 www 3101: sub plainname {
1.226 albertel 3102: my ($uname,$udom,$first)=@_;
1.537 albertel 3103: return if (!defined($uname) || !defined($udom));
1.295 www 3104: my %names=&getnames($uname,$udom);
1.226 albertel 3105: my $name=&Apache::lonnet::format_name($names{'firstname'},
3106: $names{'middlename'},
3107: $names{'lastname'},
3108: $names{'generation'},$first);
3109: $name=~s/^\s+//;
1.62 www 3110: $name=~s/\s+$//;
3111: $name=~s/\s+/ /g;
1.353 albertel 3112: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3113: return $name;
1.61 www 3114: }
1.66 www 3115:
3116: # -------------------------------------------------------------------- Nickname
1.81 albertel 3117: =pod
3118:
1.648 raeburn 3119: =item * &nickname($uname,$udom)
1.81 albertel 3120:
3121: Gets a users name and returns it as a string as
3122:
3123: ""nickname""
1.66 www 3124:
1.81 albertel 3125: if the user has a nickname or
3126:
3127: "first middle last generation"
3128:
3129: if the user does not
3130:
3131: =cut
1.66 www 3132:
3133: sub nickname {
3134: my ($uname,$udom)=@_;
1.537 albertel 3135: return if (!defined($uname) || !defined($udom));
1.295 www 3136: my %names=&getnames($uname,$udom);
1.68 albertel 3137: my $name=$names{'nickname'};
1.66 www 3138: if ($name) {
3139: $name='"'.$name.'"';
3140: } else {
3141: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3142: $names{'lastname'}.' '.$names{'generation'};
3143: $name=~s/\s+$//;
3144: $name=~s/\s+/ /g;
3145: }
3146: return $name;
3147: }
3148:
1.295 www 3149: sub getnames {
3150: my ($uname,$udom)=@_;
1.537 albertel 3151: return if (!defined($uname) || !defined($udom));
1.433 albertel 3152: if ($udom eq 'public' && $uname eq 'public') {
3153: return ('lastname' => &mt('Public'));
3154: }
1.295 www 3155: my $id=$uname.':'.$udom;
3156: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3157: if ($cached) {
3158: return %{$names};
3159: } else {
3160: my %loadnames=&Apache::lonnet::get('environment',
3161: ['firstname','middlename','lastname','generation','nickname'],
3162: $udom,$uname);
3163: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3164: return %loadnames;
3165: }
3166: }
1.61 www 3167:
1.542 raeburn 3168: # -------------------------------------------------------------------- getemails
1.648 raeburn 3169:
1.542 raeburn 3170: =pod
3171:
1.648 raeburn 3172: =item * &getemails($uname,$udom)
1.542 raeburn 3173:
3174: Gets a user's email information and returns it as a hash with keys:
3175: notification, critnotification, permanentemail
3176:
3177: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3178: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3179:
1.648 raeburn 3180:
1.542 raeburn 3181: =cut
3182:
1.648 raeburn 3183:
1.466 albertel 3184: sub getemails {
3185: my ($uname,$udom)=@_;
3186: if ($udom eq 'public' && $uname eq 'public') {
3187: return;
3188: }
1.467 www 3189: if (!$udom) { $udom=$env{'user.domain'}; }
3190: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3191: my $id=$uname.':'.$udom;
3192: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3193: if ($cached) {
3194: return %{$names};
3195: } else {
3196: my %loadnames=&Apache::lonnet::get('environment',
3197: ['notification','critnotification',
3198: 'permanentemail'],
3199: $udom,$uname);
3200: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3201: return %loadnames;
3202: }
3203: }
3204:
1.551 albertel 3205: sub flush_email_cache {
3206: my ($uname,$udom)=@_;
3207: if (!$udom) { $udom =$env{'user.domain'}; }
3208: if (!$uname) { $uname=$env{'user.name'}; }
3209: return if ($udom eq 'public' && $uname eq 'public');
3210: my $id=$uname.':'.$udom;
3211: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3212: }
3213:
1.728 raeburn 3214: # -------------------------------------------------------------------- getlangs
3215:
3216: =pod
3217:
3218: =item * &getlangs($uname,$udom)
3219:
3220: Gets a user's language preference and returns it as a hash with key:
3221: language.
3222:
3223: =cut
3224:
3225:
3226: sub getlangs {
3227: my ($uname,$udom) = @_;
3228: if (!$udom) { $udom =$env{'user.domain'}; }
3229: if (!$uname) { $uname=$env{'user.name'}; }
3230: my $id=$uname.':'.$udom;
3231: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3232: if ($cached) {
3233: return %{$langs};
3234: } else {
3235: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3236: $udom,$uname);
3237: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3238: return %loadlangs;
3239: }
3240: }
3241:
3242: sub flush_langs_cache {
3243: my ($uname,$udom)=@_;
3244: if (!$udom) { $udom =$env{'user.domain'}; }
3245: if (!$uname) { $uname=$env{'user.name'}; }
3246: return if ($udom eq 'public' && $uname eq 'public');
3247: my $id=$uname.':'.$udom;
3248: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3249: }
3250:
1.61 www 3251: # ------------------------------------------------------------------ Screenname
1.81 albertel 3252:
3253: =pod
3254:
1.648 raeburn 3255: =item * &screenname($uname,$udom)
1.81 albertel 3256:
3257: Gets a users screenname and returns it as a string
3258:
3259: =cut
1.61 www 3260:
3261: sub screenname {
3262: my ($uname,$udom)=@_;
1.258 albertel 3263: if ($uname eq $env{'user.name'} &&
3264: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3265: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3266: return $names{'screenname'};
1.62 www 3267: }
3268:
1.212 albertel 3269:
1.802 bisitz 3270: # ------------------------------------------------------------- Confirm Wrapper
3271: =pod
3272:
1.1075.2.42 raeburn 3273: =item * &confirmwrapper($message)
1.802 bisitz 3274:
3275: Wrap messages about completion of operation in box
3276:
3277: =cut
3278:
3279: sub confirmwrapper {
3280: my ($message)=@_;
3281: if ($message) {
3282: return "\n".'<div class="LC_confirm_box">'."\n"
3283: .$message."\n"
3284: .'</div>'."\n";
3285: } else {
3286: return $message;
3287: }
3288: }
3289:
1.62 www 3290: # ------------------------------------------------------------- Message Wrapper
3291:
3292: sub messagewrapper {
1.369 www 3293: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3294: return
1.441 albertel 3295: '<a href="/adm/email?compose=individual&'.
3296: 'recname='.$username.'&recdom='.$domain.
3297: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3298: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3299: }
1.802 bisitz 3300:
1.74 www 3301: # --------------------------------------------------------------- Notes Wrapper
3302:
3303: sub noteswrapper {
3304: my ($link,$un,$do)=@_;
3305: return
1.896 amueller 3306: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3307: }
1.802 bisitz 3308:
1.62 www 3309: # ------------------------------------------------------------- Aboutme Wrapper
3310:
3311: sub aboutmewrapper {
1.1070 raeburn 3312: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3313: if (!defined($username) && !defined($domain)) {
3314: return;
3315: }
1.1075.2.15 raeburn 3316: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3317: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3318: }
3319:
3320: # ------------------------------------------------------------ Syllabus Wrapper
3321:
3322: sub syllabuswrapper {
1.707 bisitz 3323: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3324: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3325: }
1.14 harris41 3326:
1.802 bisitz 3327: # -----------------------------------------------------------------------------
3328:
1.208 matthew 3329: sub track_student_link {
1.887 raeburn 3330: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3331: my $link ="/adm/trackstudent?";
1.208 matthew 3332: my $title = 'View recent activity';
3333: if (defined($sname) && $sname !~ /^\s*$/ &&
3334: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3335: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3336: $title .= ' of this student';
1.268 albertel 3337: }
1.208 matthew 3338: if (defined($target) && $target !~ /^\s*$/) {
3339: $target = qq{target="$target"};
3340: } else {
3341: $target = '';
3342: }
1.268 albertel 3343: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3344: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3345: $title = &mt($title);
3346: $linktext = &mt($linktext);
1.448 albertel 3347: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3348: &help_open_topic('View_recent_activity');
1.208 matthew 3349: }
3350:
1.781 raeburn 3351: sub slot_reservations_link {
3352: my ($linktext,$sname,$sdom,$target) = @_;
3353: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3354: my $title = 'View slot reservation history';
3355: if (defined($sname) && $sname !~ /^\s*$/ &&
3356: defined($sdom) && $sdom !~ /^\s*$/) {
3357: $link .= "&uname=$sname&udom=$sdom";
3358: $title .= ' of this student';
3359: }
3360: if (defined($target) && $target !~ /^\s*$/) {
3361: $target = qq{target="$target"};
3362: } else {
3363: $target = '';
3364: }
3365: $title = &mt($title);
3366: $linktext = &mt($linktext);
3367: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3368: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3369:
3370: }
3371:
1.508 www 3372: # ===================================================== Display a student photo
3373:
3374:
1.509 albertel 3375: sub student_image_tag {
1.508 www 3376: my ($domain,$user)=@_;
3377: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3378: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3379: return '<img src="'.$imgsrc.'" align="right" />';
3380: } else {
3381: return '';
3382: }
3383: }
3384:
1.112 bowersj2 3385: =pod
3386:
3387: =back
3388:
3389: =head1 Access .tab File Data
3390:
3391: =over 4
3392:
1.648 raeburn 3393: =item * &languageids()
1.112 bowersj2 3394:
3395: returns list of all language ids
3396:
3397: =cut
3398:
1.14 harris41 3399: sub languageids {
1.16 harris41 3400: return sort(keys(%language));
1.14 harris41 3401: }
3402:
1.112 bowersj2 3403: =pod
3404:
1.648 raeburn 3405: =item * &languagedescription()
1.112 bowersj2 3406:
3407: returns description of a specified language id
3408:
3409: =cut
3410:
1.14 harris41 3411: sub languagedescription {
1.125 www 3412: my $code=shift;
3413: return ($supported_language{$code}?'* ':'').
3414: $language{$code}.
1.126 www 3415: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3416: }
3417:
1.1048 foxr 3418: =pod
3419:
3420: =item * &plainlanguagedescription
3421:
3422: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3423: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3424:
3425: =cut
3426:
1.145 www 3427: sub plainlanguagedescription {
3428: my $code=shift;
3429: return $language{$code};
3430: }
3431:
1.1048 foxr 3432: =pod
3433:
3434: =item * &supportedlanguagecode
3435:
3436: Returns the supported language code (e.g. sptutf maps to pt) given a language
3437: code.
3438:
3439: =cut
3440:
1.145 www 3441: sub supportedlanguagecode {
3442: my $code=shift;
3443: return $supported_language{$code};
1.97 www 3444: }
3445:
1.112 bowersj2 3446: =pod
3447:
1.1048 foxr 3448: =item * &latexlanguage()
3449:
3450: Given a language key code returns the correspondnig language to use
3451: to select the correct hyphenation on LaTeX printouts. This is undef if there
3452: is no supported hyphenation for the language code.
3453:
3454: =cut
3455:
3456: sub latexlanguage {
3457: my $code = shift;
3458: return $latex_language{$code};
3459: }
3460:
3461: =pod
3462:
3463: =item * &latexhyphenation()
3464:
3465: Same as above but what's supplied is the language as it might be stored
3466: in the metadata.
3467:
3468: =cut
3469:
3470: sub latexhyphenation {
3471: my $key = shift;
3472: return $latex_language_bykey{$key};
3473: }
3474:
3475: =pod
3476:
1.648 raeburn 3477: =item * ©rightids()
1.112 bowersj2 3478:
3479: returns list of all copyrights
3480:
3481: =cut
3482:
3483: sub copyrightids {
3484: return sort(keys(%cprtag));
3485: }
3486:
3487: =pod
3488:
1.648 raeburn 3489: =item * ©rightdescription()
1.112 bowersj2 3490:
3491: returns description of a specified copyright id
3492:
3493: =cut
3494:
3495: sub copyrightdescription {
1.166 www 3496: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3497: }
1.197 matthew 3498:
3499: =pod
3500:
1.648 raeburn 3501: =item * &source_copyrightids()
1.192 taceyjo1 3502:
3503: returns list of all source copyrights
3504:
3505: =cut
3506:
3507: sub source_copyrightids {
3508: return sort(keys(%scprtag));
3509: }
3510:
3511: =pod
3512:
1.648 raeburn 3513: =item * &source_copyrightdescription()
1.192 taceyjo1 3514:
3515: returns description of a specified source copyright id
3516:
3517: =cut
3518:
3519: sub source_copyrightdescription {
3520: return &mt($scprtag{shift(@_)});
3521: }
1.112 bowersj2 3522:
3523: =pod
3524:
1.648 raeburn 3525: =item * &filecategories()
1.112 bowersj2 3526:
3527: returns list of all file categories
3528:
3529: =cut
3530:
3531: sub filecategories {
3532: return sort(keys(%category_extensions));
3533: }
3534:
3535: =pod
3536:
1.648 raeburn 3537: =item * &filecategorytypes()
1.112 bowersj2 3538:
3539: returns list of file types belonging to a given file
3540: category
3541:
3542: =cut
3543:
3544: sub filecategorytypes {
1.356 albertel 3545: my ($cat) = @_;
3546: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3547: }
3548:
3549: =pod
3550:
1.648 raeburn 3551: =item * &fileembstyle()
1.112 bowersj2 3552:
3553: returns embedding style for a specified file type
3554:
3555: =cut
3556:
3557: sub fileembstyle {
3558: return $fe{lc(shift(@_))};
1.169 www 3559: }
3560:
1.351 www 3561: sub filemimetype {
3562: return $fm{lc(shift(@_))};
3563: }
3564:
1.169 www 3565:
3566: sub filecategoryselect {
3567: my ($name,$value)=@_;
1.189 matthew 3568: return &select_form($value,$name,
1.970 raeburn 3569: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3570: }
3571:
3572: =pod
3573:
1.648 raeburn 3574: =item * &filedescription()
1.112 bowersj2 3575:
3576: returns description for a specified file type
3577:
3578: =cut
3579:
3580: sub filedescription {
1.188 matthew 3581: my $file_description = $fd{lc(shift())};
3582: $file_description =~ s:([\[\]]):~$1:g;
3583: return &mt($file_description);
1.112 bowersj2 3584: }
3585:
3586: =pod
3587:
1.648 raeburn 3588: =item * &filedescriptionex()
1.112 bowersj2 3589:
3590: returns description for a specified file type with
3591: extra formatting
3592:
3593: =cut
3594:
3595: sub filedescriptionex {
3596: my $ex=shift;
1.188 matthew 3597: my $file_description = $fd{lc($ex)};
3598: $file_description =~ s:([\[\]]):~$1:g;
3599: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3600: }
3601:
3602: # End of .tab access
3603: =pod
3604:
3605: =back
3606:
3607: =cut
3608:
3609: # ------------------------------------------------------------------ File Types
3610: sub fileextensions {
3611: return sort(keys(%fe));
3612: }
3613:
1.97 www 3614: # ----------------------------------------------------------- Display Languages
3615: # returns a hash with all desired display languages
3616: #
3617:
3618: sub display_languages {
3619: my %languages=();
1.695 raeburn 3620: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3621: $languages{$lang}=1;
1.97 www 3622: }
3623: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3624: if ($env{'form.displaylanguage'}) {
1.356 albertel 3625: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3626: $languages{$lang}=1;
1.97 www 3627: }
3628: }
3629: return %languages;
1.14 harris41 3630: }
3631:
1.582 albertel 3632: sub languages {
3633: my ($possible_langs) = @_;
1.695 raeburn 3634: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3635: if (!ref($possible_langs)) {
3636: if( wantarray ) {
3637: return @preferred_langs;
3638: } else {
3639: return $preferred_langs[0];
3640: }
3641: }
3642: my %possibilities = map { $_ => 1 } (@$possible_langs);
3643: my @preferred_possibilities;
3644: foreach my $preferred_lang (@preferred_langs) {
3645: if (exists($possibilities{$preferred_lang})) {
3646: push(@preferred_possibilities, $preferred_lang);
3647: }
3648: }
3649: if( wantarray ) {
3650: return @preferred_possibilities;
3651: }
3652: return $preferred_possibilities[0];
3653: }
3654:
1.742 raeburn 3655: sub user_lang {
3656: my ($touname,$toudom,$fromcid) = @_;
3657: my @userlangs;
3658: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3659: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3660: $env{'course.'.$fromcid.'.languages'}));
3661: } else {
3662: my %langhash = &getlangs($touname,$toudom);
3663: if ($langhash{'languages'} ne '') {
3664: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3665: } else {
3666: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3667: if ($domdefs{'lang_def'} ne '') {
3668: @userlangs = ($domdefs{'lang_def'});
3669: }
3670: }
3671: }
3672: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3673: my $user_lh = Apache::localize->get_handle(@languages);
3674: return $user_lh;
3675: }
3676:
3677:
1.112 bowersj2 3678: ###############################################################
3679: ## Student Answer Attempts ##
3680: ###############################################################
3681:
3682: =pod
3683:
3684: =head1 Alternate Problem Views
3685:
3686: =over 4
3687:
1.648 raeburn 3688: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1075.2.86 raeburn 3689: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 3690:
3691: Return string with previous attempt on problem. Arguments:
3692:
3693: =over 4
3694:
3695: =item * $symb: Problem, including path
3696:
3697: =item * $username: username of the desired student
3698:
3699: =item * $domain: domain of the desired student
1.14 harris41 3700:
1.112 bowersj2 3701: =item * $course: Course ID
1.14 harris41 3702:
1.112 bowersj2 3703: =item * $getattempt: Leave blank for all attempts, otherwise put
3704: something
1.14 harris41 3705:
1.112 bowersj2 3706: =item * $regexp: if string matches this regexp, the string will be
3707: sent to $gradesub
1.14 harris41 3708:
1.112 bowersj2 3709: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3710:
1.1075.2.86 raeburn 3711: =item * $usec: section of the desired student
3712:
3713: =item * $identifier: counter for student (multiple students one problem) or
3714: problem (one student; whole sequence).
3715:
1.112 bowersj2 3716: =back
1.14 harris41 3717:
1.112 bowersj2 3718: The output string is a table containing all desired attempts, if any.
1.16 harris41 3719:
1.112 bowersj2 3720: =cut
1.1 albertel 3721:
3722: sub get_previous_attempt {
1.1075.2.86 raeburn 3723: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 3724: my $prevattempts='';
1.43 ng 3725: no strict 'refs';
1.1 albertel 3726: if ($symb) {
1.3 albertel 3727: my (%returnhash)=
3728: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3729: if ($returnhash{'version'}) {
3730: my %lasthash=();
3731: my $version;
3732: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.91 raeburn 3733: foreach my $key (reverse(sort(split(/\:/,$returnhash{$version.':keys'})))) {
3734: if ($key =~ /\.rawrndseed$/) {
3735: my ($id) = ($key =~ /^(.+)\.rawrndseed$/);
3736: $lasthash{$id.'.rndseed'} = $returnhash{$version.':'.$key};
3737: } else {
3738: $lasthash{$key}=$returnhash{$version.':'.$key};
3739: }
1.19 harris41 3740: }
1.1 albertel 3741: }
1.596 albertel 3742: $prevattempts=&start_data_table().&start_data_table_header_row();
3743: $prevattempts.='<th>'.&mt('History').'</th>';
1.1075.2.86 raeburn 3744: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 3745: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3746: foreach my $key (sort(keys(%lasthash))) {
3747: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3748: if ($#parts > 0) {
1.31 albertel 3749: my $data=$parts[-1];
1.989 raeburn 3750: next if ($data eq 'foilorder');
1.31 albertel 3751: pop(@parts);
1.1010 www 3752: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3753: if ($data eq 'type') {
3754: unless ($showsurv) {
3755: my $id = join(',',@parts);
3756: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3757: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3758: $lasthidden{$ign.'.'.$id} = 1;
3759: }
1.945 raeburn 3760: }
1.1075.2.86 raeburn 3761: if ($identifier ne '') {
3762: my $id = join(',',@parts);
3763: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
3764: $domain,$username,$usec,undef,$course) =~ /^no/) {
3765: $hidestatus{$ign.'.'.$id} = 1;
3766: }
3767: }
3768: } elsif ($data eq 'regrader') {
3769: if (($identifier ne '') && (@parts)) {
3770: my $id = join(',',@parts);
3771: $regraded{$ign.'.'.$id} = 1;
3772: }
1.1010 www 3773: }
1.31 albertel 3774: } else {
1.41 ng 3775: if ($#parts == 0) {
3776: $prevattempts.='<th>'.$parts[0].'</th>';
3777: } else {
3778: $prevattempts.='<th>'.$ign.'</th>';
3779: }
1.31 albertel 3780: }
1.16 harris41 3781: }
1.596 albertel 3782: $prevattempts.=&end_data_table_header_row();
1.40 ng 3783: if ($getattempt eq '') {
1.1075.2.86 raeburn 3784: my (%solved,%resets,%probstatus);
3785: if (($identifier ne '') && (keys(%regraded) > 0)) {
3786: for ($version=1;$version<=$returnhash{'version'};$version++) {
3787: foreach my $id (keys(%regraded)) {
3788: if (($returnhash{$version.':'.$id.'.regrader'}) &&
3789: ($returnhash{$version.':'.$id.'.tries'} eq '') &&
3790: ($returnhash{$version.':'.$id.'.award'} eq '')) {
3791: push(@{$resets{$id}},$version);
3792: }
3793: }
3794: }
3795: }
1.40 ng 3796: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1075.2.86 raeburn 3797: my (@hidden,@unsolved);
1.945 raeburn 3798: if (%typeparts) {
3799: foreach my $id (keys(%typeparts)) {
1.1075.2.86 raeburn 3800: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
3801: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 3802: push(@hidden,$id);
1.1075.2.86 raeburn 3803: } elsif ($identifier ne '') {
3804: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
3805: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
3806: ($hidestatus{$id})) {
3807: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$version\E$/,@{$resets{$id}}));
3808: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
3809: push(@{$solved{$id}},$version);
3810: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
3811: (ref($solved{$id}) eq 'ARRAY')) {
3812: my $skip;
3813: if (ref($resets{$id}) eq 'ARRAY') {
3814: foreach my $reset (@{$resets{$id}}) {
3815: if ($reset > $solved{$id}[-1]) {
3816: $skip=1;
3817: last;
3818: }
3819: }
3820: }
3821: unless ($skip) {
3822: my ($ign,$partslist) = split(/\./,$id,2);
3823: push(@unsolved,$partslist);
3824: }
3825: }
3826: }
1.945 raeburn 3827: }
3828: }
3829: }
3830: $prevattempts.=&start_data_table_row().
1.1075.2.86 raeburn 3831: '<td>'.&mt('Transaction [_1]',$version);
3832: if (@unsolved) {
3833: $prevattempts .= '<span class="LC_nobreak"><label>'.
3834: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
3835: &mt('Hide').'</label></span>';
3836: }
3837: $prevattempts .= '</td>';
1.945 raeburn 3838: if (@hidden) {
3839: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3840: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3841: my $hide;
3842: foreach my $id (@hidden) {
3843: if ($key =~ /^\Q$id\E/) {
3844: $hide = 1;
3845: last;
3846: }
3847: }
3848: if ($hide) {
3849: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3850: if (($data eq 'award') || ($data eq 'awarddetail')) {
3851: my $value = &format_previous_attempt_value($key,
3852: $returnhash{$version.':'.$key});
3853: $prevattempts.='<td>'.$value.' </td>';
3854: } else {
3855: $prevattempts.='<td> </td>';
3856: }
3857: } else {
3858: if ($key =~ /\./) {
1.1075.2.91 raeburn 3859: my $value = $returnhash{$version.':'.$key};
3860: if ($key =~ /\.rndseed$/) {
3861: my ($id) = ($key =~ /^(.+)\.rndseed$/);
3862: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
3863: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
3864: }
3865: }
3866: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
3867: ' </td>';
1.945 raeburn 3868: } else {
3869: $prevattempts.='<td> </td>';
3870: }
3871: }
3872: }
3873: } else {
3874: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3875: next if ($key =~ /\.foilorder$/);
1.1075.2.91 raeburn 3876: my $value = $returnhash{$version.':'.$key};
3877: if ($key =~ /\.rndseed$/) {
3878: my ($id) = ($key =~ /^(.+)\.rndseed$/);
3879: if (exists($returnhash{$version.':'.$id.'.rawrndseed'})) {
3880: $value = $returnhash{$version.':'.$id.'.rawrndseed'};
3881: }
3882: }
3883: $prevattempts.='<td>'.&format_previous_attempt_value($key,$value).
3884: ' </td>';
1.945 raeburn 3885: }
3886: }
3887: $prevattempts.=&end_data_table_row();
1.40 ng 3888: }
1.1 albertel 3889: }
1.945 raeburn 3890: my @currhidden = keys(%lasthidden);
1.596 albertel 3891: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3892: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3893: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3894: if (%typeparts) {
3895: my $hidden;
3896: foreach my $id (@currhidden) {
3897: if ($key =~ /^\Q$id\E/) {
3898: $hidden = 1;
3899: last;
3900: }
3901: }
3902: if ($hidden) {
3903: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3904: if (($data eq 'award') || ($data eq 'awarddetail')) {
3905: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3906: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3907: $value = &$gradesub($value);
3908: }
3909: $prevattempts.='<td>'.$value.' </td>';
3910: } else {
3911: $prevattempts.='<td> </td>';
3912: }
3913: } else {
3914: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3915: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3916: $value = &$gradesub($value);
3917: }
3918: $prevattempts.='<td>'.$value.' </td>';
3919: }
3920: } else {
3921: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3922: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3923: $value = &$gradesub($value);
3924: }
3925: $prevattempts.='<td>'.$value.' </td>';
3926: }
1.16 harris41 3927: }
1.596 albertel 3928: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3929: } else {
1.596 albertel 3930: $prevattempts=
3931: &start_data_table().&start_data_table_row().
3932: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3933: &end_data_table_row().&end_data_table();
1.1 albertel 3934: }
3935: } else {
1.596 albertel 3936: $prevattempts=
3937: &start_data_table().&start_data_table_row().
3938: '<td>'.&mt('No data.').'</td>'.
3939: &end_data_table_row().&end_data_table();
1.1 albertel 3940: }
1.10 albertel 3941: }
3942:
1.581 albertel 3943: sub format_previous_attempt_value {
3944: my ($key,$value) = @_;
1.1011 www 3945: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.581 albertel 3946: $value = &Apache::lonlocal::locallocaltime($value);
3947: } elsif (ref($value) eq 'ARRAY') {
3948: $value = '('.join(', ', @{ $value }).')';
1.988 raeburn 3949: } elsif ($key =~ /answerstring$/) {
3950: my %answers = &Apache::lonnet::str2hash($value);
3951: my @anskeys = sort(keys(%answers));
3952: if (@anskeys == 1) {
3953: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 3954: if ($answer =~ m{\0}) {
3955: $answer =~ s{\0}{,}g;
1.988 raeburn 3956: }
3957: my $tag_internal_answer_name = 'INTERNAL';
3958: if ($anskeys[0] eq $tag_internal_answer_name) {
3959: $value = $answer;
3960: } else {
3961: $value = $anskeys[0].'='.$answer;
3962: }
3963: } else {
3964: foreach my $ans (@anskeys) {
3965: my $answer = $answers{$ans};
1.1001 raeburn 3966: if ($answer =~ m{\0}) {
3967: $answer =~ s{\0}{,}g;
1.988 raeburn 3968: }
3969: $value .= $ans.'='.$answer.'<br />';;
3970: }
3971: }
1.581 albertel 3972: } else {
3973: $value = &unescape($value);
3974: }
3975: return $value;
3976: }
3977:
3978:
1.107 albertel 3979: sub relative_to_absolute {
3980: my ($url,$output)=@_;
3981: my $parser=HTML::TokeParser->new(\$output);
3982: my $token;
3983: my $thisdir=$url;
3984: my @rlinks=();
3985: while ($token=$parser->get_token) {
3986: if ($token->[0] eq 'S') {
3987: if ($token->[1] eq 'a') {
3988: if ($token->[2]->{'href'}) {
3989: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
3990: }
3991: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
3992: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
3993: } elsif ($token->[1] eq 'base') {
3994: $thisdir=$token->[2]->{'href'};
3995: }
3996: }
3997: }
3998: $thisdir=~s-/[^/]*$--;
1.356 albertel 3999: foreach my $link (@rlinks) {
1.726 raeburn 4000: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4001: ($link=~/^\//) ||
4002: ($link=~/^javascript:/i) ||
4003: ($link=~/^mailto:/i) ||
4004: ($link=~/^\#/)) {
4005: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4006: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4007: }
4008: }
4009: # -------------------------------------------------- Deal with Applet codebases
4010: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4011: return $output;
4012: }
4013:
1.112 bowersj2 4014: =pod
4015:
1.648 raeburn 4016: =item * &get_student_view()
1.112 bowersj2 4017:
4018: show a snapshot of what student was looking at
4019:
4020: =cut
4021:
1.10 albertel 4022: sub get_student_view {
1.186 albertel 4023: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4024: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4025: my (%form);
1.10 albertel 4026: my @elements=('symb','courseid','domain','username');
4027: foreach my $element (@elements) {
1.186 albertel 4028: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4029: }
1.186 albertel 4030: if (defined($moreenv)) {
4031: %form=(%form,%{$moreenv});
4032: }
1.236 albertel 4033: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4034: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4035: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4036: $userview=~s/\<body[^\>]*\>//gi;
4037: $userview=~s/\<\/body\>//gi;
4038: $userview=~s/\<html\>//gi;
4039: $userview=~s/\<\/html\>//gi;
4040: $userview=~s/\<head\>//gi;
4041: $userview=~s/\<\/head\>//gi;
4042: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4043: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4044: if (wantarray) {
4045: return ($userview,$response);
4046: } else {
4047: return $userview;
4048: }
4049: }
4050:
4051: sub get_student_view_with_retries {
4052: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4053:
4054: my $ok = 0; # True if we got a good response.
4055: my $content;
4056: my $response;
4057:
4058: # Try to get the student_view done. within the retries count:
4059:
4060: do {
4061: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4062: $ok = $response->is_success;
4063: if (!$ok) {
4064: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4065: }
4066: $retries--;
4067: } while (!$ok && ($retries > 0));
4068:
4069: if (!$ok) {
4070: $content = ''; # On error return an empty content.
4071: }
1.651 www 4072: if (wantarray) {
4073: return ($content, $response);
4074: } else {
4075: return $content;
4076: }
1.11 albertel 4077: }
4078:
1.112 bowersj2 4079: =pod
4080:
1.648 raeburn 4081: =item * &get_student_answers()
1.112 bowersj2 4082:
4083: show a snapshot of how student was answering problem
4084:
4085: =cut
4086:
1.11 albertel 4087: sub get_student_answers {
1.100 sakharuk 4088: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4089: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4090: my (%moreenv);
1.11 albertel 4091: my @elements=('symb','courseid','domain','username');
4092: foreach my $element (@elements) {
1.186 albertel 4093: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4094: }
1.186 albertel 4095: $moreenv{'grade_target'}='answer';
4096: %moreenv=(%form,%moreenv);
1.497 raeburn 4097: $feedurl = &Apache::lonnet::clutter($feedurl);
4098: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4099: return $userview;
1.1 albertel 4100: }
1.116 albertel 4101:
4102: =pod
4103:
4104: =item * &submlink()
4105:
1.242 albertel 4106: Inputs: $text $uname $udom $symb $target
1.116 albertel 4107:
4108: Returns: A link to grades.pm such as to see the SUBM view of a student
4109:
4110: =cut
4111:
4112: ###############################################
4113: sub submlink {
1.242 albertel 4114: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4115: if (!($uname && $udom)) {
4116: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4117: &Apache::lonnet::whichuser($symb);
1.116 albertel 4118: if (!$symb) { $symb=$cursymb; }
4119: }
1.254 matthew 4120: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4121: $symb=&escape($symb);
1.960 bisitz 4122: if ($target) { $target=" target=\"$target\""; }
4123: return
4124: '<a href="/adm/grades?command=submission'.
4125: '&symb='.$symb.
4126: '&student='.$uname.
4127: '&userdom='.$udom.'"'.
4128: $target.'>'.$text.'</a>';
1.242 albertel 4129: }
4130: ##############################################
4131:
4132: =pod
4133:
4134: =item * &pgrdlink()
4135:
4136: Inputs: $text $uname $udom $symb $target
4137:
4138: Returns: A link to grades.pm such as to see the PGRD view of a student
4139:
4140: =cut
4141:
4142: ###############################################
4143: sub pgrdlink {
4144: my $link=&submlink(@_);
4145: $link=~s/(&command=submission)/$1&showgrading=yes/;
4146: return $link;
4147: }
4148: ##############################################
4149:
4150: =pod
4151:
4152: =item * &pprmlink()
4153:
4154: Inputs: $text $uname $udom $symb $target
4155:
4156: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4157: student and a specific resource
1.242 albertel 4158:
4159: =cut
4160:
4161: ###############################################
4162: sub pprmlink {
4163: my ($text,$uname,$udom,$symb,$target)=@_;
4164: if (!($uname && $udom)) {
4165: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4166: &Apache::lonnet::whichuser($symb);
1.242 albertel 4167: if (!$symb) { $symb=$cursymb; }
4168: }
1.254 matthew 4169: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4170: $symb=&escape($symb);
1.242 albertel 4171: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4172: return '<a href="/adm/parmset?command=set&'.
4173: 'symb='.$symb.'&uname='.$uname.
4174: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4175: }
4176: ##############################################
1.37 matthew 4177:
1.112 bowersj2 4178: =pod
4179:
4180: =back
4181:
4182: =cut
4183:
1.37 matthew 4184: ###############################################
1.51 www 4185:
4186:
4187: sub timehash {
1.687 raeburn 4188: my ($thistime) = @_;
4189: my $timezone = &Apache::lonlocal::gettimezone();
4190: my $dt = DateTime->from_epoch(epoch => $thistime)
4191: ->set_time_zone($timezone);
4192: my $wday = $dt->day_of_week();
4193: if ($wday == 7) { $wday = 0; }
4194: return ( 'second' => $dt->second(),
4195: 'minute' => $dt->minute(),
4196: 'hour' => $dt->hour(),
4197: 'day' => $dt->day_of_month(),
4198: 'month' => $dt->month(),
4199: 'year' => $dt->year(),
4200: 'weekday' => $wday,
4201: 'dayyear' => $dt->day_of_year(),
4202: 'dlsav' => $dt->is_dst() );
1.51 www 4203: }
4204:
1.370 www 4205: sub utc_string {
4206: my ($date)=@_;
1.371 www 4207: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4208: }
4209:
1.51 www 4210: sub maketime {
4211: my %th=@_;
1.687 raeburn 4212: my ($epoch_time,$timezone,$dt);
4213: $timezone = &Apache::lonlocal::gettimezone();
4214: eval {
4215: $dt = DateTime->new( year => $th{'year'},
4216: month => $th{'month'},
4217: day => $th{'day'},
4218: hour => $th{'hour'},
4219: minute => $th{'minute'},
4220: second => $th{'second'},
4221: time_zone => $timezone,
4222: );
4223: };
4224: if (!$@) {
4225: $epoch_time = $dt->epoch;
4226: if ($epoch_time) {
4227: return $epoch_time;
4228: }
4229: }
1.51 www 4230: return POSIX::mktime(
4231: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4232: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4233: }
4234:
4235: #########################################
1.51 www 4236:
4237: sub findallcourses {
1.482 raeburn 4238: my ($roles,$uname,$udom) = @_;
1.355 albertel 4239: my %roles;
4240: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4241: my %courses;
1.51 www 4242: my $now=time;
1.482 raeburn 4243: if (!defined($uname)) {
4244: $uname = $env{'user.name'};
4245: }
4246: if (!defined($udom)) {
4247: $udom = $env{'user.domain'};
4248: }
4249: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4250: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4251: if (!%roles) {
4252: %roles = (
4253: cc => 1,
1.907 raeburn 4254: co => 1,
1.482 raeburn 4255: in => 1,
4256: ep => 1,
4257: ta => 1,
4258: cr => 1,
4259: st => 1,
4260: );
4261: }
4262: foreach my $entry (keys(%roleshash)) {
4263: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4264: if ($trole =~ /^cr/) {
4265: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4266: } else {
4267: next if (!exists($roles{$trole}));
4268: }
4269: if ($tend) {
4270: next if ($tend < $now);
4271: }
4272: if ($tstart) {
4273: next if ($tstart > $now);
4274: }
1.1058 raeburn 4275: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4276: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4277: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4278: if ($secpart eq '') {
4279: ($cnum,$role) = split(/_/,$cnumpart);
4280: $sec = 'none';
1.1058 raeburn 4281: $value .= $cnum.'/';
1.482 raeburn 4282: } else {
4283: $cnum = $cnumpart;
4284: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4285: $value .= $cnum.'/'.$sec;
4286: }
4287: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4288: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4289: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4290: }
4291: } else {
4292: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4293: }
1.482 raeburn 4294: }
4295: } else {
4296: foreach my $key (keys(%env)) {
1.483 albertel 4297: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4298: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4299: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4300: next if ($role eq 'ca' || $role eq 'aa');
4301: next if (%roles && !exists($roles{$role}));
4302: my ($starttime,$endtime)=split(/\./,$env{$key});
4303: my $active=1;
4304: if ($starttime) {
4305: if ($now<$starttime) { $active=0; }
4306: }
4307: if ($endtime) {
4308: if ($now>$endtime) { $active=0; }
4309: }
4310: if ($active) {
1.1058 raeburn 4311: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4312: if ($sec eq '') {
4313: $sec = 'none';
1.1058 raeburn 4314: } else {
4315: $value .= $sec;
4316: }
4317: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4318: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4319: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4320: }
4321: } else {
4322: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4323: }
1.474 raeburn 4324: }
4325: }
1.51 www 4326: }
4327: }
1.474 raeburn 4328: return %courses;
1.51 www 4329: }
1.37 matthew 4330:
1.54 www 4331: ###############################################
1.474 raeburn 4332:
4333: sub blockcheck {
1.1075.2.73 raeburn 4334: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4335:
1.1075.2.73 raeburn 4336: if (defined($udom) && defined($uname)) {
4337: # If uname and udom are for a course, check for blocks in the course.
4338: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4339: my ($startblock,$endblock,$triggerblock) =
4340: &get_blocks($setters,$activity,$udom,$uname,$url);
4341: return ($startblock,$endblock,$triggerblock);
4342: }
4343: } else {
1.490 raeburn 4344: $udom = $env{'user.domain'};
4345: $uname = $env{'user.name'};
4346: }
4347:
1.502 raeburn 4348: my $startblock = 0;
4349: my $endblock = 0;
1.1062 raeburn 4350: my $triggerblock = '';
1.482 raeburn 4351: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4352:
1.490 raeburn 4353: # If uname is for a user, and activity is course-specific, i.e.,
4354: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4355:
1.490 raeburn 4356: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1075.2.73 raeburn 4357: $activity eq 'groups' || $activity eq 'printout') &&
4358: ($env{'request.course.id'})) {
1.490 raeburn 4359: foreach my $key (keys(%live_courses)) {
4360: if ($key ne $env{'request.course.id'}) {
4361: delete($live_courses{$key});
4362: }
4363: }
4364: }
4365:
4366: my $otheruser = 0;
4367: my %own_courses;
4368: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4369: # Resource belongs to user other than current user.
4370: $otheruser = 1;
4371: # Gather courses for current user
4372: %own_courses =
4373: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4374: }
4375:
4376: # Gather active course roles - course coordinator, instructor,
4377: # exam proctor, ta, student, or custom role.
1.474 raeburn 4378:
4379: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4380: my ($cdom,$cnum);
4381: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4382: $cdom = $env{'course.'.$course.'.domain'};
4383: $cnum = $env{'course.'.$course.'.num'};
4384: } else {
1.490 raeburn 4385: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4386: }
4387: my $no_ownblock = 0;
4388: my $no_userblock = 0;
1.533 raeburn 4389: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4390: # Check if current user has 'evb' priv for this
4391: if (defined($own_courses{$course})) {
4392: foreach my $sec (keys(%{$own_courses{$course}})) {
4393: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4394: if ($sec ne 'none') {
4395: $checkrole .= '/'.$sec;
4396: }
4397: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4398: $no_ownblock = 1;
4399: last;
4400: }
4401: }
4402: }
4403: # if they have 'evb' priv and are currently not playing student
4404: next if (($no_ownblock) &&
4405: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4406: }
1.474 raeburn 4407: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4408: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4409: if ($sec ne 'none') {
1.482 raeburn 4410: $checkrole .= '/'.$sec;
1.474 raeburn 4411: }
1.490 raeburn 4412: if ($otheruser) {
4413: # Resource belongs to user other than current user.
4414: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4415: my (%allroles,%userroles);
4416: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4417: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4418: my ($trole,$tdom,$tnum,$tsec);
4419: if ($entry =~ /^cr/) {
4420: ($trole,$tdom,$tnum,$tsec) =
4421: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4422: } else {
4423: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4424: }
4425: my ($spec,$area,$trest);
4426: $area = '/'.$tdom.'/'.$tnum;
4427: $trest = $tnum;
4428: if ($tsec ne '') {
4429: $area .= '/'.$tsec;
4430: $trest .= '/'.$tsec;
4431: }
4432: $spec = $trole.'.'.$area;
4433: if ($trole =~ /^cr/) {
4434: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4435: $tdom,$spec,$trest,$area);
4436: } else {
4437: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4438: $tdom,$spec,$trest,$area);
4439: }
4440: }
4441: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4442: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4443: if ($1) {
4444: $no_userblock = 1;
4445: last;
4446: }
1.486 raeburn 4447: }
4448: }
1.490 raeburn 4449: } else {
4450: # Resource belongs to current user
4451: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4452: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4453: $no_ownblock = 1;
4454: last;
4455: }
1.474 raeburn 4456: }
4457: }
4458: # if they have the evb priv and are currently not playing student
1.482 raeburn 4459: next if (($no_ownblock) &&
1.491 albertel 4460: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4461: next if ($no_userblock);
1.474 raeburn 4462:
1.866 kalberla 4463: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4464: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4465:
1.1062 raeburn 4466: my ($start,$end,$trigger) =
4467: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4468: if (($start != 0) &&
4469: (($startblock == 0) || ($startblock > $start))) {
4470: $startblock = $start;
1.1062 raeburn 4471: if ($trigger ne '') {
4472: $triggerblock = $trigger;
4473: }
1.502 raeburn 4474: }
4475: if (($end != 0) &&
4476: (($endblock == 0) || ($endblock < $end))) {
4477: $endblock = $end;
1.1062 raeburn 4478: if ($trigger ne '') {
4479: $triggerblock = $trigger;
4480: }
1.502 raeburn 4481: }
1.490 raeburn 4482: }
1.1062 raeburn 4483: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4484: }
4485:
4486: sub get_blocks {
1.1062 raeburn 4487: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4488: my $startblock = 0;
4489: my $endblock = 0;
1.1062 raeburn 4490: my $triggerblock = '';
1.490 raeburn 4491: my $course = $cdom.'_'.$cnum;
4492: $setters->{$course} = {};
4493: $setters->{$course}{'staff'} = [];
4494: $setters->{$course}{'times'} = [];
1.1062 raeburn 4495: $setters->{$course}{'triggers'} = [];
4496: my (@blockers,%triggered);
4497: my $now = time;
4498: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4499: if ($activity eq 'docs') {
4500: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4501: foreach my $block (@blockers) {
4502: if ($block =~ /^firstaccess____(.+)$/) {
4503: my $item = $1;
4504: my $type = 'map';
4505: my $timersymb = $item;
4506: if ($item eq 'course') {
4507: $type = 'course';
4508: } elsif ($item =~ /___\d+___/) {
4509: $type = 'resource';
4510: } else {
4511: $timersymb = &Apache::lonnet::symbread($item);
4512: }
4513: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4514: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4515: $triggered{$block} = {
4516: start => $start,
4517: end => $end,
4518: type => $type,
4519: };
4520: }
4521: }
4522: } else {
4523: foreach my $block (keys(%commblocks)) {
4524: if ($block =~ m/^(\d+)____(\d+)$/) {
4525: my ($start,$end) = ($1,$2);
4526: if ($start <= time && $end >= time) {
4527: if (ref($commblocks{$block}) eq 'HASH') {
4528: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4529: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4530: unless(grep(/^\Q$block\E$/,@blockers)) {
4531: push(@blockers,$block);
4532: }
4533: }
4534: }
4535: }
4536: }
4537: } elsif ($block =~ /^firstaccess____(.+)$/) {
4538: my $item = $1;
4539: my $timersymb = $item;
4540: my $type = 'map';
4541: if ($item eq 'course') {
4542: $type = 'course';
4543: } elsif ($item =~ /___\d+___/) {
4544: $type = 'resource';
4545: } else {
4546: $timersymb = &Apache::lonnet::symbread($item);
4547: }
4548: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4549: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4550: if ($start && $end) {
4551: if (($start <= time) && ($end >= time)) {
4552: unless (grep(/^\Q$block\E$/,@blockers)) {
4553: push(@blockers,$block);
4554: $triggered{$block} = {
4555: start => $start,
4556: end => $end,
4557: type => $type,
4558: };
4559: }
4560: }
1.490 raeburn 4561: }
1.1062 raeburn 4562: }
4563: }
4564: }
4565: foreach my $blocker (@blockers) {
4566: my ($staff_name,$staff_dom,$title,$blocks) =
4567: &parse_block_record($commblocks{$blocker});
4568: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4569: my ($start,$end,$triggertype);
4570: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4571: ($start,$end) = ($1,$2);
4572: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4573: $start = $triggered{$blocker}{'start'};
4574: $end = $triggered{$blocker}{'end'};
4575: $triggertype = $triggered{$blocker}{'type'};
4576: }
4577: if ($start) {
4578: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4579: if ($triggertype) {
4580: push(@{$$setters{$course}{'triggers'}},$triggertype);
4581: } else {
4582: push(@{$$setters{$course}{'triggers'}},0);
4583: }
4584: if ( ($startblock == 0) || ($startblock > $start) ) {
4585: $startblock = $start;
4586: if ($triggertype) {
4587: $triggerblock = $blocker;
1.474 raeburn 4588: }
4589: }
1.1062 raeburn 4590: if ( ($endblock == 0) || ($endblock < $end) ) {
4591: $endblock = $end;
4592: if ($triggertype) {
4593: $triggerblock = $blocker;
4594: }
4595: }
1.474 raeburn 4596: }
4597: }
1.1062 raeburn 4598: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4599: }
4600:
4601: sub parse_block_record {
4602: my ($record) = @_;
4603: my ($setuname,$setudom,$title,$blocks);
4604: if (ref($record) eq 'HASH') {
4605: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4606: $title = &unescape($record->{'event'});
4607: $blocks = $record->{'blocks'};
4608: } else {
4609: my @data = split(/:/,$record,3);
4610: if (scalar(@data) eq 2) {
4611: $title = $data[1];
4612: ($setuname,$setudom) = split(/@/,$data[0]);
4613: } else {
4614: ($setuname,$setudom,$title) = @data;
4615: }
4616: $blocks = { 'com' => 'on' };
4617: }
4618: return ($setuname,$setudom,$title,$blocks);
4619: }
4620:
1.854 kalberla 4621: sub blocking_status {
1.1075.2.73 raeburn 4622: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4623: my %setters;
1.890 droeschl 4624:
1.1061 raeburn 4625: # check for active blocking
1.1062 raeburn 4626: my ($startblock,$endblock,$triggerblock) =
1.1075.2.73 raeburn 4627: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4628: my $blocked = 0;
4629: if ($startblock && $endblock) {
4630: $blocked = 1;
4631: }
1.890 droeschl 4632:
1.1061 raeburn 4633: # caller just wants to know whether a block is active
4634: if (!wantarray) { return $blocked; }
4635:
4636: # build a link to a popup window containing the details
4637: my $querystring = "?activity=$activity";
4638: # $uname and $udom decide whose portfolio the user is trying to look at
1.1075.2.97 raeburn 4639: if (($activity eq 'port') || ($activity eq 'passwd')) {
4640: $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
4641: $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
1.1062 raeburn 4642: } elsif ($activity eq 'docs') {
4643: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4644: }
1.1061 raeburn 4645:
4646: my $output .= <<'END_MYBLOCK';
4647: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4648: var options = "width=" + w + ",height=" + h + ",";
4649: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4650: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4651: var newWin = window.open(url, wdwName, options);
4652: newWin.focus();
4653: }
1.890 droeschl 4654: END_MYBLOCK
1.854 kalberla 4655:
1.1061 raeburn 4656: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4657:
1.1061 raeburn 4658: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4659: my $text = &mt('Communication Blocked');
1.1075.2.93 raeburn 4660: my $class = 'LC_comblock';
1.1062 raeburn 4661: if ($activity eq 'docs') {
4662: $text = &mt('Content Access Blocked');
1.1075.2.93 raeburn 4663: $class = '';
1.1063 raeburn 4664: } elsif ($activity eq 'printout') {
4665: $text = &mt('Printing Blocked');
1.1075.2.97 raeburn 4666: } elsif ($activity eq 'passwd') {
4667: $text = &mt('Password Changing Blocked');
1.1062 raeburn 4668: }
1.1061 raeburn 4669: $output .= <<"END_BLOCK";
1.1075.2.93 raeburn 4670: <div class='$class'>
1.869 kalberla 4671: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4672: title='$text'>
4673: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4674: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4675: title='$text'>$text</a>
1.867 kalberla 4676: </div>
4677:
4678: END_BLOCK
1.474 raeburn 4679:
1.1061 raeburn 4680: return ($blocked, $output);
1.854 kalberla 4681: }
1.490 raeburn 4682:
1.60 matthew 4683: ###############################################
4684:
1.682 raeburn 4685: sub check_ip_acc {
4686: my ($acc)=@_;
4687: &Apache::lonxml::debug("acc is $acc");
4688: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4689: return 1;
4690: }
4691: my $allowed=0;
4692: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4693:
4694: my $name;
4695: foreach my $pattern (split(',',$acc)) {
4696: $pattern =~ s/^\s*//;
4697: $pattern =~ s/\s*$//;
4698: if ($pattern =~ /\*$/) {
4699: #35.8.*
4700: $pattern=~s/\*//;
4701: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4702: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4703: #35.8.3.[34-56]
4704: my $low=$2;
4705: my $high=$3;
4706: $pattern=$1;
4707: if ($ip =~ /^\Q$pattern\E/) {
4708: my $last=(split(/\./,$ip))[3];
4709: if ($last <=$high && $last >=$low) { $allowed=1; }
4710: }
4711: } elsif ($pattern =~ /^\*/) {
4712: #*.msu.edu
4713: $pattern=~s/\*//;
4714: if (!defined($name)) {
4715: use Socket;
4716: my $netaddr=inet_aton($ip);
4717: ($name)=gethostbyaddr($netaddr,AF_INET);
4718: }
4719: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4720: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4721: #127.0.0.1
4722: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4723: } else {
4724: #some.name.com
4725: if (!defined($name)) {
4726: use Socket;
4727: my $netaddr=inet_aton($ip);
4728: ($name)=gethostbyaddr($netaddr,AF_INET);
4729: }
4730: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4731: }
4732: if ($allowed) { last; }
4733: }
4734: return $allowed;
4735: }
4736:
4737: ###############################################
4738:
1.60 matthew 4739: =pod
4740:
1.112 bowersj2 4741: =head1 Domain Template Functions
4742:
4743: =over 4
4744:
4745: =item * &determinedomain()
1.60 matthew 4746:
4747: Inputs: $domain (usually will be undef)
4748:
1.63 www 4749: Returns: Determines which domain should be used for designs
1.60 matthew 4750:
4751: =cut
1.54 www 4752:
1.60 matthew 4753: ###############################################
1.63 www 4754: sub determinedomain {
4755: my $domain=shift;
1.531 albertel 4756: if (! $domain) {
1.60 matthew 4757: # Determine domain if we have not been given one
1.893 raeburn 4758: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4759: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4760: if ($env{'request.role.domain'}) {
4761: $domain=$env{'request.role.domain'};
1.60 matthew 4762: }
4763: }
1.63 www 4764: return $domain;
4765: }
4766: ###############################################
1.517 raeburn 4767:
1.518 albertel 4768: sub devalidate_domconfig_cache {
4769: my ($udom)=@_;
4770: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4771: }
4772:
4773: # ---------------------- Get domain configuration for a domain
4774: sub get_domainconf {
4775: my ($udom) = @_;
4776: my $cachetime=1800;
4777: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4778: if (defined($cached)) { return %{$result}; }
4779:
4780: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4781: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4782: my (%designhash,%legacy);
1.518 albertel 4783: if (keys(%domconfig) > 0) {
4784: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4785: if (keys(%{$domconfig{'login'}})) {
4786: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4787: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.1075.2.87 raeburn 4788: if (($key eq 'loginvia') || ($key eq 'headtag')) {
4789: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
4790: foreach my $hostname (keys(%{$domconfig{'login'}{$key}})) {
4791: if (ref($domconfig{'login'}{$key}{$hostname}) eq 'HASH') {
4792: if ($key eq 'loginvia') {
4793: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4794: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4795: $designhash{$udom.'.login.loginvia'} = $server;
4796: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4797: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4798: } else {
4799: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
4800: }
1.948 raeburn 4801: }
1.1075.2.87 raeburn 4802: } elsif ($key eq 'headtag') {
4803: if ($domconfig{'login'}{'headtag'}{$hostname}{'url'}) {
4804: $designhash{$udom.'.login.headtag_'.$hostname} = $domconfig{'login'}{'headtag'}{$hostname}{'url'};
1.948 raeburn 4805: }
1.946 raeburn 4806: }
1.1075.2.87 raeburn 4807: if ($domconfig{'login'}{$key}{$hostname}{'exempt'}) {
4808: $designhash{$udom.'.login.'.$key.'_exempt_'.$hostname} = $domconfig{'login'}{$key}{$hostname}{'exempt'};
4809: }
1.946 raeburn 4810: }
4811: }
4812: }
4813: } else {
4814: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4815: $designhash{$udom.'.login.'.$key.'_'.$img} =
4816: $domconfig{'login'}{$key}{$img};
4817: }
1.699 raeburn 4818: }
4819: } else {
4820: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4821: }
1.632 raeburn 4822: }
4823: } else {
4824: $legacy{'login'} = 1;
1.518 albertel 4825: }
1.632 raeburn 4826: } else {
4827: $legacy{'login'} = 1;
1.518 albertel 4828: }
4829: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4830: if (keys(%{$domconfig{'rolecolors'}})) {
4831: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4832: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4833: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4834: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4835: }
1.518 albertel 4836: }
4837: }
1.632 raeburn 4838: } else {
4839: $legacy{'rolecolors'} = 1;
1.518 albertel 4840: }
1.632 raeburn 4841: } else {
4842: $legacy{'rolecolors'} = 1;
1.518 albertel 4843: }
1.948 raeburn 4844: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4845: if ($domconfig{'autoenroll'}{'co-owners'}) {
4846: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4847: }
4848: }
1.632 raeburn 4849: if (keys(%legacy) > 0) {
4850: my %legacyhash = &get_legacy_domconf($udom);
4851: foreach my $item (keys(%legacyhash)) {
4852: if ($item =~ /^\Q$udom\E\.login/) {
4853: if ($legacy{'login'}) {
4854: $designhash{$item} = $legacyhash{$item};
4855: }
4856: } else {
4857: if ($legacy{'rolecolors'}) {
4858: $designhash{$item} = $legacyhash{$item};
4859: }
1.518 albertel 4860: }
4861: }
4862: }
1.632 raeburn 4863: } else {
4864: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4865: }
4866: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4867: $cachetime);
4868: return %designhash;
4869: }
4870:
1.632 raeburn 4871: sub get_legacy_domconf {
4872: my ($udom) = @_;
4873: my %legacyhash;
4874: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4875: my $designfile = $designdir.'/'.$udom.'.tab';
4876: if (-e $designfile) {
4877: if ( open (my $fh,"<$designfile") ) {
4878: while (my $line = <$fh>) {
4879: next if ($line =~ /^\#/);
4880: chomp($line);
4881: my ($key,$val)=(split(/\=/,$line));
4882: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4883: }
4884: close($fh);
4885: }
4886: }
1.1026 raeburn 4887: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4888: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4889: }
4890: return %legacyhash;
4891: }
4892:
1.63 www 4893: =pod
4894:
1.112 bowersj2 4895: =item * &domainlogo()
1.63 www 4896:
4897: Inputs: $domain (usually will be undef)
4898:
4899: Returns: A link to a domain logo, if the domain logo exists.
4900: If the domain logo does not exist, a description of the domain.
4901:
4902: =cut
1.112 bowersj2 4903:
1.63 www 4904: ###############################################
4905: sub domainlogo {
1.517 raeburn 4906: my $domain = &determinedomain(shift);
1.518 albertel 4907: my %designhash = &get_domainconf($domain);
1.517 raeburn 4908: # See if there is a logo
4909: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4910: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4911: if ($imgsrc =~ m{^/(adm|res)/}) {
4912: if ($imgsrc =~ m{^/res/}) {
4913: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4914: &Apache::lonnet::repcopy($local_name);
4915: }
4916: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4917: }
4918: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4919: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4920: return &Apache::lonnet::domain($domain,'description');
1.59 www 4921: } else {
1.60 matthew 4922: return '';
1.59 www 4923: }
4924: }
1.63 www 4925: ##############################################
4926:
4927: =pod
4928:
1.112 bowersj2 4929: =item * &designparm()
1.63 www 4930:
4931: Inputs: $which parameter; $domain (usually will be undef)
4932:
4933: Returns: value of designparamter $which
4934:
4935: =cut
1.112 bowersj2 4936:
1.397 albertel 4937:
1.400 albertel 4938: ##############################################
1.397 albertel 4939: sub designparm {
4940: my ($which,$domain)=@_;
4941: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4942: return $env{'environment.color.'.$which};
1.96 www 4943: }
1.63 www 4944: $domain=&determinedomain($domain);
1.1016 raeburn 4945: my %domdesign;
4946: unless ($domain eq 'public') {
4947: %domdesign = &get_domainconf($domain);
4948: }
1.520 raeburn 4949: my $output;
1.517 raeburn 4950: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4951: $output = $domdesign{$domain.'.'.$which};
1.63 www 4952: } else {
1.520 raeburn 4953: $output = $defaultdesign{$which};
4954: }
4955: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 4956: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 4957: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 4958: if ($output =~ m{^/res/}) {
4959: my $local_name = &Apache::lonnet::filelocation('',$output);
4960: &Apache::lonnet::repcopy($local_name);
4961: }
1.520 raeburn 4962: $output = &lonhttpdurl($output);
4963: }
1.63 www 4964: }
1.520 raeburn 4965: return $output;
1.63 www 4966: }
1.59 www 4967:
1.822 bisitz 4968: ##############################################
4969: =pod
4970:
1.832 bisitz 4971: =item * &authorspace()
4972:
1.1028 raeburn 4973: Inputs: $url (usually will be undef).
1.832 bisitz 4974:
1.1075.2.40 raeburn 4975: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 4976: directory being viewed (or for which action is being taken).
4977: If $url is provided, and begins /priv/<domain>/<uname>
4978: the path will be that portion of the $context argument.
4979: Otherwise the path will be for the author space of the current
4980: user when the current role is author, or for that of the
4981: co-author/assistant co-author space when the current role
4982: is co-author or assistant co-author.
1.832 bisitz 4983:
4984: =cut
4985:
4986: sub authorspace {
1.1028 raeburn 4987: my ($url) = @_;
4988: if ($url ne '') {
4989: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
4990: return $1;
4991: }
4992: }
1.832 bisitz 4993: my $caname = '';
1.1024 www 4994: my $cadom = '';
1.1028 raeburn 4995: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 4996: ($cadom,$caname) =
1.832 bisitz 4997: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 4998: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 4999: $caname = $env{'user.name'};
1.1024 www 5000: $cadom = $env{'user.domain'};
1.832 bisitz 5001: }
1.1028 raeburn 5002: if (($caname ne '') && ($cadom ne '')) {
5003: return "/priv/$cadom/$caname/";
5004: }
5005: return;
1.832 bisitz 5006: }
5007:
5008: ##############################################
5009: =pod
5010:
1.822 bisitz 5011: =item * &head_subbox()
5012:
5013: Inputs: $content (contains HTML code with page functions, etc.)
5014:
5015: Returns: HTML div with $content
5016: To be included in page header
5017:
5018: =cut
5019:
5020: sub head_subbox {
5021: my ($content)=@_;
5022: my $output =
1.993 raeburn 5023: '<div class="LC_head_subbox">'
1.822 bisitz 5024: .$content
5025: .'</div>'
5026: }
5027:
5028: ##############################################
5029: =pod
5030:
5031: =item * &CSTR_pageheader()
5032:
1.1026 raeburn 5033: Input: (optional) filename from which breadcrumb trail is built.
5034: In most cases no input as needed, as $env{'request.filename'}
5035: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5036:
5037: Returns: HTML div with CSTR path and recent box
1.1075.2.40 raeburn 5038: To be included on Authoring Space pages
1.822 bisitz 5039:
5040: =cut
5041:
5042: sub CSTR_pageheader {
1.1026 raeburn 5043: my ($trailfile) = @_;
5044: if ($trailfile eq '') {
5045: $trailfile = $env{'request.filename'};
5046: }
5047:
5048: # this is for resources; directories have customtitle, and crumbs
5049: # and select recent are created in lonpubdir.pm
5050:
5051: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5052: my ($udom,$uname,$thisdisfn)=
1.1075.2.29 raeburn 5053: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5054: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5055: $formaction =~ s{/+}{/}g;
1.822 bisitz 5056:
5057: my $parentpath = '';
5058: my $lastitem = '';
5059: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5060: $parentpath = $1;
5061: $lastitem = $2;
5062: } else {
5063: $lastitem = $thisdisfn;
5064: }
1.921 bisitz 5065:
5066: my $output =
1.822 bisitz 5067: '<div>'
5068: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1075.2.40 raeburn 5069: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5070: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5071: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5072: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5073:
5074: if ($lastitem) {
5075: $output .=
5076: '<span class="LC_filename">'
5077: .$lastitem
5078: .'</span>';
5079: }
5080: $output .=
5081: '<br />'
1.822 bisitz 5082: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5083: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5084: .'</form>'
5085: .&Apache::lonmenu::constspaceform()
5086: .'</div>';
1.921 bisitz 5087:
5088: return $output;
1.822 bisitz 5089: }
5090:
1.60 matthew 5091: ###############################################
5092: ###############################################
5093:
5094: =pod
5095:
1.112 bowersj2 5096: =back
5097:
1.549 albertel 5098: =head1 HTML Helpers
1.112 bowersj2 5099:
5100: =over 4
5101:
5102: =item * &bodytag()
1.60 matthew 5103:
5104: Returns a uniform header for LON-CAPA web pages.
5105:
5106: Inputs:
5107:
1.112 bowersj2 5108: =over 4
5109:
5110: =item * $title, A title to be displayed on the page.
5111:
5112: =item * $function, the current role (can be undef).
5113:
5114: =item * $addentries, extra parameters for the <body> tag.
5115:
5116: =item * $bodyonly, if defined, only return the <body> tag.
5117:
5118: =item * $domain, if defined, force a given domain.
5119:
5120: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5121: text interface only)
1.60 matthew 5122:
1.814 bisitz 5123: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5124: navigational links
1.317 albertel 5125:
1.338 albertel 5126: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5127:
1.1075.2.12 raeburn 5128: =item * $no_inline_link, if true and in remote mode, don't show the
5129: 'Switch To Inline Menu' link
5130:
1.460 albertel 5131: =item * $args, optional argument valid values are
5132: no_auto_mt_title -> prevents &mt()ing the title arg
5133:
1.1075.2.15 raeburn 5134: =item * $advtoolsref, optional argument, ref to an array containing
5135: inlineremote items to be added in "Functions" menu below
5136: breadcrumbs.
5137:
1.112 bowersj2 5138: =back
5139:
1.60 matthew 5140: Returns: A uniform header for LON-CAPA web pages.
5141: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5142: If $bodyonly is undef or zero, an html string containing a <body> tag and
5143: other decorations will be returned.
5144:
5145: =cut
5146:
1.54 www 5147: sub bodytag {
1.831 bisitz 5148: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1075.2.15 raeburn 5149: $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_;
1.339 albertel 5150:
1.954 raeburn 5151: my $public;
5152: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5153: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5154: $public = 1;
5155: }
1.460 albertel 5156: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1075.2.52 raeburn 5157: my $httphost = $args->{'use_absolute'};
1.339 albertel 5158:
1.183 matthew 5159: $function = &get_users_function() if (!$function);
1.339 albertel 5160: my $img = &designparm($function.'.img',$domain);
5161: my $font = &designparm($function.'.font',$domain);
5162: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5163:
1.803 bisitz 5164: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5165: 'bgcolor' => $pgbg,
1.339 albertel 5166: 'text' => $font,
5167: 'alink' => &designparm($function.'.alink',$domain),
5168: 'vlink' => &designparm($function.'.vlink',$domain),
5169: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5170: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5171:
1.63 www 5172: # role and realm
1.1075.2.68 raeburn 5173: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5174: if ($realm) {
5175: $realm = '/'.$realm;
5176: }
1.378 raeburn 5177: if ($role eq 'ca') {
1.479 albertel 5178: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5179: $realm = &plainname($rname,$rdom);
1.378 raeburn 5180: }
1.55 www 5181: # realm
1.258 albertel 5182: if ($env{'request.course.id'}) {
1.378 raeburn 5183: if ($env{'request.role'} !~ /^cr/) {
5184: $role = &Apache::lonnet::plaintext($role,&course_type());
5185: }
1.898 raeburn 5186: if ($env{'request.course.sec'}) {
5187: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5188: }
1.359 albertel 5189: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5190: } else {
5191: $role = &Apache::lonnet::plaintext($role);
1.54 www 5192: }
1.433 albertel 5193:
1.359 albertel 5194: if (!$realm) { $realm=' '; }
1.330 albertel 5195:
1.438 albertel 5196: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5197:
1.101 www 5198: # construct main body tag
1.359 albertel 5199: my $bodytag = "<body $extra_body_attr>".
1.1075.2.100 raeburn 5200: &Apache::lontexconvert::init_math_support();
1.252 albertel 5201:
1.1075.2.38 raeburn 5202: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5203:
5204: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5205: return $bodytag;
1.1075.2.38 raeburn 5206: }
1.359 albertel 5207:
1.954 raeburn 5208: if ($public) {
1.433 albertel 5209: undef($role);
5210: }
1.359 albertel 5211:
1.762 bisitz 5212: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5213: #
5214: # Extra info if you are the DC
5215: my $dc_info = '';
5216: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5217: $env{'course.'.$env{'request.course.id'}.
5218: '.domain'}.'/'})) {
5219: my $cid = $env{'request.course.id'};
1.917 raeburn 5220: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5221: $dc_info =~ s/\s+$//;
1.359 albertel 5222: }
5223:
1.898 raeburn 5224: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.903 droeschl 5225:
1.1075.2.13 raeburn 5226: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5227:
1.1075.2.38 raeburn 5228:
5229:
1.1075.2.21 raeburn 5230: my $funclist;
5231: if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
1.1075.2.52 raeburn 5232: $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
1.1075.2.21 raeburn 5233: Apache::lonmenu::serverform();
5234: my $forbodytag;
5235: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5236: $forcereg,$args->{'group'},
5237: $args->{'bread_crumbs'},
5238: $advtoolsref,'',\$forbodytag);
5239: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5240: $funclist = $forbodytag;
5241: }
5242: } else {
1.903 droeschl 5243:
5244: # if ($env{'request.state'} eq 'construct') {
5245: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5246: # }
5247:
1.1075.2.38 raeburn 5248: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5249: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5250:
1.1075.2.38 raeburn 5251: my ($left,$right) = Apache::lonmenu::primary_menu();
1.1075.2.2 raeburn 5252:
1.916 droeschl 5253: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.1075.2.22 raeburn 5254: if ($dc_info) {
5255: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
1.1075.2.1 raeburn 5256: }
1.1075.2.38 raeburn 5257: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.1075.2.22 raeburn 5258: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5259: return $bodytag;
5260: }
1.894 droeschl 5261:
1.927 raeburn 5262: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1075.2.38 raeburn 5263: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5264: }
1.916 droeschl 5265:
1.1075.2.38 raeburn 5266: $bodytag .= $right;
1.852 droeschl 5267:
1.917 raeburn 5268: if ($dc_info) {
5269: $dc_info = &dc_courseid_toggle($dc_info);
5270: }
5271: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5272:
1.1075.2.61 raeburn 5273: #if directed to not display the secondary menu, don't.
5274: if ($args->{'no_secondary_menu'}) {
5275: return $bodytag;
5276: }
1.903 droeschl 5277: #don't show menus for public users
1.954 raeburn 5278: if (!$public){
1.1075.2.52 raeburn 5279: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5280: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5281: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5282: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5283: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5284: $args->{'bread_crumbs'});
5285: } elsif ($forcereg) {
1.1075.2.22 raeburn 5286: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5287: $args->{'group'});
1.1075.2.15 raeburn 5288: } else {
1.1075.2.21 raeburn 5289: my $forbodytag;
5290: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5291: $forcereg,$args->{'group'},
5292: $args->{'bread_crumbs'},
5293: $advtoolsref,'',\$forbodytag);
5294: unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
5295: $bodytag .= $forbodytag;
5296: }
1.920 raeburn 5297: }
1.903 droeschl 5298: }else{
5299: # this is to seperate menu from content when there's no secondary
5300: # menu. Especially needed for public accessible ressources.
5301: $bodytag .= '<hr style="clear:both" />';
5302: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5303: }
1.903 droeschl 5304:
1.235 raeburn 5305: return $bodytag;
1.1075.2.12 raeburn 5306: }
5307:
5308: #
5309: # Top frame rendering, Remote is up
5310: #
5311:
5312: my $imgsrc = $img;
5313: if ($img =~ /^\/adm/) {
5314: $imgsrc = &lonhttpdurl($img);
5315: }
5316: my $upperleft='<img src="'.$imgsrc.'" alt="'.$function.'" />';
5317:
1.1075.2.60 raeburn 5318: my $help=($no_inline_link?''
5319: :&Apache::loncommon::top_nav_help('Help'));
5320:
1.1075.2.12 raeburn 5321: # Explicit link to get inline menu
5322: my $menu= ($no_inline_link?''
5323: :'<a href="/adm/remote?action=collapse" target="_top">'.&mt('Switch to Inline Menu Mode').'</a>');
5324:
5325: if ($dc_info) {
5326: $dc_info = qq|<span class="LC_cusr_subheading">($dc_info)</span>|;
5327: }
5328:
1.1075.2.38 raeburn 5329: my $name = &plainname($env{'user.name'},$env{'user.domain'});
5330: unless ($public) {
5331: $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
5332: undef,'LC_menubuttons_link');
5333: }
5334:
1.1075.2.12 raeburn 5335: unless ($env{'form.inhibitmenu'}) {
5336: $bodytag .= qq|<div id="LC_nav_bar">$name $role</div>
1.1075.2.38 raeburn 5337: <ol class="LC_primary_menu LC_floatright LC_right">
1.1075.2.60 raeburn 5338: <li>$help</li>
1.1075.2.12 raeburn 5339: <li>$menu</li>
5340: </ol><div id="LC_realm"> $realm $dc_info</div>|;
5341: }
1.1075.2.13 raeburn 5342: if ($env{'request.state'} eq 'construct') {
5343: if (!$public){
5344: if ($env{'request.state'} eq 'construct') {
5345: $funclist = &Apache::lonhtmlcommon::scripttag(
1.1075.2.52 raeburn 5346: &Apache::lonmenu::utilityfunctions($httphost), 'start').
1.1075.2.13 raeburn 5347: &Apache::lonhtmlcommon::scripttag('','end').
5348: &Apache::lonmenu::innerregister($forcereg,
5349: $args->{'bread_crumbs'});
5350: }
5351: }
5352: }
1.1075.2.21 raeburn 5353: return $bodytag."\n".$funclist;
1.182 matthew 5354: }
5355:
1.917 raeburn 5356: sub dc_courseid_toggle {
5357: my ($dc_info) = @_;
1.980 raeburn 5358: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5359: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5360: &mt('(More ...)').'</a></span>'.
5361: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5362: }
5363:
1.330 albertel 5364: sub make_attr_string {
5365: my ($register,$attr_ref) = @_;
5366:
5367: if ($attr_ref && !ref($attr_ref)) {
5368: die("addentries Must be a hash ref ".
5369: join(':',caller(1))." ".
5370: join(':',caller(0))." ");
5371: }
5372:
5373: if ($register) {
1.339 albertel 5374: my ($on_load,$on_unload);
5375: foreach my $key (keys(%{$attr_ref})) {
5376: if (lc($key) eq 'onload') {
5377: $on_load.=$attr_ref->{$key}.';';
5378: delete($attr_ref->{$key});
5379:
5380: } elsif (lc($key) eq 'onunload') {
5381: $on_unload.=$attr_ref->{$key}.';';
5382: delete($attr_ref->{$key});
5383: }
5384: }
1.1075.2.12 raeburn 5385: if ($env{'environment.remote'} eq 'on') {
5386: $attr_ref->{'onload'} =
5387: &Apache::lonmenu::loadevents(). $on_load;
5388: $attr_ref->{'onunload'}=
5389: &Apache::lonmenu::unloadevents().$on_unload;
5390: } else {
5391: $attr_ref->{'onload'} = $on_load;
5392: $attr_ref->{'onunload'}= $on_unload;
5393: }
1.330 albertel 5394: }
1.339 albertel 5395:
1.330 albertel 5396: my $attr_string;
1.1075.2.56 raeburn 5397: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5398: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5399: }
5400: return $attr_string;
5401: }
5402:
5403:
1.182 matthew 5404: ###############################################
1.251 albertel 5405: ###############################################
5406:
5407: =pod
5408:
5409: =item * &endbodytag()
5410:
5411: Returns a uniform footer for LON-CAPA web pages.
5412:
1.635 raeburn 5413: Inputs: 1 - optional reference to an args hash
5414: If in the hash, key for noredirectlink has a value which evaluates to true,
5415: a 'Continue' link is not displayed if the page contains an
5416: internal redirect in the <head></head> section,
5417: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5418:
5419: =cut
5420:
5421: sub endbodytag {
1.635 raeburn 5422: my ($args) = @_;
1.1075.2.6 raeburn 5423: my $endbodytag;
5424: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5425: $endbodytag='</body>';
5426: }
1.315 albertel 5427: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5428: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5429: $endbodytag=
5430: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5431: &mt('Continue').'</a>'.
5432: $endbodytag;
5433: }
1.315 albertel 5434: }
1.251 albertel 5435: return $endbodytag;
5436: }
5437:
1.352 albertel 5438: =pod
5439:
5440: =item * &standard_css()
5441:
5442: Returns a style sheet
5443:
5444: Inputs: (all optional)
5445: domain -> force to color decorate a page for a specific
5446: domain
5447: function -> force usage of a specific rolish color scheme
5448: bgcolor -> override the default page bgcolor
5449:
5450: =cut
5451:
1.343 albertel 5452: sub standard_css {
1.345 albertel 5453: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5454: $function = &get_users_function() if (!$function);
5455: my $img = &designparm($function.'.img', $domain);
5456: my $tabbg = &designparm($function.'.tabbg', $domain);
5457: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5458: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5459: #second colour for later usage
1.345 albertel 5460: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5461: my $pgbg_or_bgcolor =
5462: $bgcolor ||
1.352 albertel 5463: &designparm($function.'.pgbg', $domain);
1.382 albertel 5464: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5465: my $alink = &designparm($function.'.alink', $domain);
5466: my $vlink = &designparm($function.'.vlink', $domain);
5467: my $link = &designparm($function.'.link', $domain);
5468:
1.602 albertel 5469: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5470: my $mono = 'monospace';
1.850 bisitz 5471: my $data_table_head = $sidebg;
5472: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5473: my $data_table_dark = '#E0E0E0';
1.470 banghart 5474: my $data_table_darker = '#CCCCCC';
1.349 albertel 5475: my $data_table_highlight = '#FFFF00';
1.352 albertel 5476: my $mail_new = '#FFBB77';
5477: my $mail_new_hover = '#DD9955';
5478: my $mail_read = '#BBBB77';
5479: my $mail_read_hover = '#999944';
5480: my $mail_replied = '#AAAA88';
5481: my $mail_replied_hover = '#888855';
5482: my $mail_other = '#99BBBB';
5483: my $mail_other_hover = '#669999';
1.391 albertel 5484: my $table_header = '#DDDDDD';
1.489 raeburn 5485: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5486: my $lg_border_color = '#C8C8C8';
1.952 onken 5487: my $button_hover = '#BF2317';
1.392 albertel 5488:
1.608 albertel 5489: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5490: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5491: : '0 3px 0 4px';
1.448 albertel 5492:
1.523 albertel 5493:
1.343 albertel 5494: return <<END;
1.947 droeschl 5495:
5496: /* needed for iframe to allow 100% height in FF */
5497: body, html {
5498: margin: 0;
5499: padding: 0 0.5%;
5500: height: 99%; /* to avoid scrollbars */
5501: }
5502:
1.795 www 5503: body {
1.911 bisitz 5504: font-family: $sans;
5505: line-height:130%;
5506: font-size:0.83em;
5507: color:$font;
1.795 www 5508: }
5509:
1.959 onken 5510: a:focus,
5511: a:focus img {
1.795 www 5512: color: red;
5513: }
1.698 harmsja 5514:
1.911 bisitz 5515: form, .inline {
5516: display: inline;
1.795 www 5517: }
1.721 harmsja 5518:
1.795 www 5519: .LC_right {
1.911 bisitz 5520: text-align:right;
1.795 www 5521: }
5522:
5523: .LC_middle {
1.911 bisitz 5524: vertical-align:middle;
1.795 www 5525: }
1.721 harmsja 5526:
1.1075.2.38 raeburn 5527: .LC_floatleft {
5528: float: left;
5529: }
5530:
5531: .LC_floatright {
5532: float: right;
5533: }
5534:
1.911 bisitz 5535: .LC_400Box {
5536: width:400px;
5537: }
1.721 harmsja 5538:
1.947 droeschl 5539: .LC_iframecontainer {
5540: width: 98%;
5541: margin: 0;
5542: position: fixed;
5543: top: 8.5em;
5544: bottom: 0;
5545: }
5546:
5547: .LC_iframecontainer iframe{
5548: border: none;
5549: width: 100%;
5550: height: 100%;
5551: }
5552:
1.778 bisitz 5553: .LC_filename {
5554: font-family: $mono;
5555: white-space:pre;
1.921 bisitz 5556: font-size: 120%;
1.778 bisitz 5557: }
5558:
5559: .LC_fileicon {
5560: border: none;
5561: height: 1.3em;
5562: vertical-align: text-bottom;
5563: margin-right: 0.3em;
5564: text-decoration:none;
5565: }
5566:
1.1008 www 5567: .LC_setting {
5568: text-decoration:underline;
5569: }
5570:
1.350 albertel 5571: .LC_error {
5572: color: red;
5573: }
1.795 www 5574:
1.1075.2.15 raeburn 5575: .LC_warning {
5576: color: darkorange;
5577: }
5578:
1.457 albertel 5579: .LC_diff_removed {
1.733 bisitz 5580: color: red;
1.394 albertel 5581: }
1.532 albertel 5582:
5583: .LC_info,
1.457 albertel 5584: .LC_success,
5585: .LC_diff_added {
1.350 albertel 5586: color: green;
5587: }
1.795 www 5588:
1.802 bisitz 5589: div.LC_confirm_box {
5590: background-color: #FAFAFA;
5591: border: 1px solid $lg_border_color;
5592: margin-right: 0;
5593: padding: 5px;
5594: }
5595:
5596: div.LC_confirm_box .LC_error img,
5597: div.LC_confirm_box .LC_success img {
5598: vertical-align: middle;
5599: }
5600:
1.440 albertel 5601: .LC_icon {
1.771 droeschl 5602: border: none;
1.790 droeschl 5603: vertical-align: middle;
1.771 droeschl 5604: }
5605:
1.543 albertel 5606: .LC_docs_spacer {
5607: width: 25px;
5608: height: 1px;
1.771 droeschl 5609: border: none;
1.543 albertel 5610: }
1.346 albertel 5611:
1.532 albertel 5612: .LC_internal_info {
1.735 bisitz 5613: color: #999999;
1.532 albertel 5614: }
5615:
1.794 www 5616: .LC_discussion {
1.1050 www 5617: background: $data_table_dark;
1.911 bisitz 5618: border: 1px solid black;
5619: margin: 2px;
1.794 www 5620: }
5621:
5622: .LC_disc_action_left {
1.1050 www 5623: background: $sidebg;
1.911 bisitz 5624: text-align: left;
1.1050 www 5625: padding: 4px;
5626: margin: 2px;
1.794 www 5627: }
5628:
5629: .LC_disc_action_right {
1.1050 www 5630: background: $sidebg;
1.911 bisitz 5631: text-align: right;
1.1050 www 5632: padding: 4px;
5633: margin: 2px;
1.794 www 5634: }
5635:
5636: .LC_disc_new_item {
1.911 bisitz 5637: background: white;
5638: border: 2px solid red;
1.1050 www 5639: margin: 4px;
5640: padding: 4px;
1.794 www 5641: }
5642:
5643: .LC_disc_old_item {
1.911 bisitz 5644: background: white;
1.1050 www 5645: margin: 4px;
5646: padding: 4px;
1.794 www 5647: }
5648:
1.458 albertel 5649: table.LC_pastsubmission {
5650: border: 1px solid black;
5651: margin: 2px;
5652: }
5653:
1.924 bisitz 5654: table#LC_menubuttons {
1.345 albertel 5655: width: 100%;
5656: background: $pgbg;
1.392 albertel 5657: border: 2px;
1.402 albertel 5658: border-collapse: separate;
1.803 bisitz 5659: padding: 0;
1.345 albertel 5660: }
1.392 albertel 5661:
1.801 tempelho 5662: table#LC_title_bar a {
5663: color: $fontmenu;
5664: }
1.836 bisitz 5665:
1.807 droeschl 5666: table#LC_title_bar {
1.819 tempelho 5667: clear: both;
1.836 bisitz 5668: display: none;
1.807 droeschl 5669: }
5670:
1.795 www 5671: table#LC_title_bar,
1.933 droeschl 5672: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5673: table#LC_title_bar.LC_with_remote {
1.359 albertel 5674: width: 100%;
1.392 albertel 5675: border-color: $pgbg;
5676: border-style: solid;
5677: border-width: $border;
1.379 albertel 5678: background: $pgbg;
1.801 tempelho 5679: color: $fontmenu;
1.392 albertel 5680: border-collapse: collapse;
1.803 bisitz 5681: padding: 0;
1.819 tempelho 5682: margin: 0;
1.359 albertel 5683: }
1.795 www 5684:
1.933 droeschl 5685: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5686: margin: 0;
5687: padding: 0;
1.933 droeschl 5688: position: relative;
5689: list-style: none;
1.913 droeschl 5690: }
1.933 droeschl 5691: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5692: display: inline;
5693: }
1.933 droeschl 5694:
5695: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5696: padding: 0;
1.933 droeschl 5697: margin: 0;
5698: float: left;
1.913 droeschl 5699: }
1.933 droeschl 5700: .LC_breadcrumb_tools_tools {
5701: padding: 0;
5702: margin: 0;
1.913 droeschl 5703: float: right;
5704: }
5705:
1.359 albertel 5706: table#LC_title_bar td {
5707: background: $tabbg;
5708: }
1.795 www 5709:
1.911 bisitz 5710: table#LC_menubuttons img {
1.803 bisitz 5711: border: none;
1.346 albertel 5712: }
1.795 www 5713:
1.842 droeschl 5714: .LC_breadcrumbs_component {
1.911 bisitz 5715: float: right;
5716: margin: 0 1em;
1.357 albertel 5717: }
1.842 droeschl 5718: .LC_breadcrumbs_component img {
1.911 bisitz 5719: vertical-align: middle;
1.777 tempelho 5720: }
1.795 www 5721:
1.383 albertel 5722: td.LC_table_cell_checkbox {
5723: text-align: center;
5724: }
1.795 www 5725:
5726: .LC_fontsize_small {
1.911 bisitz 5727: font-size: 70%;
1.705 tempelho 5728: }
5729:
1.844 bisitz 5730: #LC_breadcrumbs {
1.911 bisitz 5731: clear:both;
5732: background: $sidebg;
5733: border-bottom: 1px solid $lg_border_color;
5734: line-height: 2.5em;
1.933 droeschl 5735: overflow: hidden;
1.911 bisitz 5736: margin: 0;
5737: padding: 0;
1.995 raeburn 5738: text-align: left;
1.819 tempelho 5739: }
1.862 bisitz 5740:
1.1075.2.16 raeburn 5741: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5742: clear:both;
5743: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5744: border: 1px solid $sidebg;
1.1075.2.16 raeburn 5745: margin: 0 0 10px 0;
1.966 bisitz 5746: padding: 3px;
1.995 raeburn 5747: text-align: left;
1.822 bisitz 5748: }
5749:
1.795 www 5750: .LC_fontsize_medium {
1.911 bisitz 5751: font-size: 85%;
1.705 tempelho 5752: }
5753:
1.795 www 5754: .LC_fontsize_large {
1.911 bisitz 5755: font-size: 120%;
1.705 tempelho 5756: }
5757:
1.346 albertel 5758: .LC_menubuttons_inline_text {
5759: color: $font;
1.698 harmsja 5760: font-size: 90%;
1.701 harmsja 5761: padding-left:3px;
1.346 albertel 5762: }
5763:
1.934 droeschl 5764: .LC_menubuttons_inline_text img{
5765: vertical-align: middle;
5766: }
5767:
1.1051 www 5768: li.LC_menubuttons_inline_text img {
1.951 onken 5769: cursor:pointer;
1.1002 droeschl 5770: text-decoration: none;
1.951 onken 5771: }
5772:
1.526 www 5773: .LC_menubuttons_link {
5774: text-decoration: none;
5775: }
1.795 www 5776:
1.522 albertel 5777: .LC_menubuttons_category {
1.521 www 5778: color: $font;
1.526 www 5779: background: $pgbg;
1.521 www 5780: font-size: larger;
5781: font-weight: bold;
5782: }
5783:
1.346 albertel 5784: td.LC_menubuttons_text {
1.911 bisitz 5785: color: $font;
1.346 albertel 5786: }
1.706 harmsja 5787:
1.346 albertel 5788: .LC_current_location {
5789: background: $tabbg;
5790: }
1.795 www 5791:
1.938 bisitz 5792: table.LC_data_table {
1.347 albertel 5793: border: 1px solid #000000;
1.402 albertel 5794: border-collapse: separate;
1.426 albertel 5795: border-spacing: 1px;
1.610 albertel 5796: background: $pgbg;
1.347 albertel 5797: }
1.795 www 5798:
1.422 albertel 5799: .LC_data_table_dense {
5800: font-size: small;
5801: }
1.795 www 5802:
1.507 raeburn 5803: table.LC_nested_outer {
5804: border: 1px solid #000000;
1.589 raeburn 5805: border-collapse: collapse;
1.803 bisitz 5806: border-spacing: 0;
1.507 raeburn 5807: width: 100%;
5808: }
1.795 www 5809:
1.879 raeburn 5810: table.LC_innerpickbox,
1.507 raeburn 5811: table.LC_nested {
1.803 bisitz 5812: border: none;
1.589 raeburn 5813: border-collapse: collapse;
1.803 bisitz 5814: border-spacing: 0;
1.507 raeburn 5815: width: 100%;
5816: }
1.795 www 5817:
1.911 bisitz 5818: table.LC_data_table tr th,
5819: table.LC_calendar tr th,
1.879 raeburn 5820: table.LC_prior_tries tr th,
5821: table.LC_innerpickbox tr th {
1.349 albertel 5822: font-weight: bold;
5823: background-color: $data_table_head;
1.801 tempelho 5824: color:$fontmenu;
1.701 harmsja 5825: font-size:90%;
1.347 albertel 5826: }
1.795 www 5827:
1.879 raeburn 5828: table.LC_innerpickbox tr th,
5829: table.LC_innerpickbox tr td {
5830: vertical-align: top;
5831: }
5832:
1.711 raeburn 5833: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5834: background-color: #CCCCCC;
1.711 raeburn 5835: font-weight: bold;
5836: text-align: left;
5837: }
1.795 www 5838:
1.912 bisitz 5839: table.LC_data_table tr.LC_odd_row > td {
5840: background-color: $data_table_light;
5841: padding: 2px;
5842: vertical-align: top;
5843: }
5844:
1.809 bisitz 5845: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5846: background-color: $data_table_light;
1.912 bisitz 5847: vertical-align: top;
5848: }
5849:
5850: table.LC_data_table tr.LC_even_row > td {
5851: background-color: $data_table_dark;
1.425 albertel 5852: padding: 2px;
1.900 bisitz 5853: vertical-align: top;
1.347 albertel 5854: }
1.795 www 5855:
1.809 bisitz 5856: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5857: background-color: $data_table_dark;
1.900 bisitz 5858: vertical-align: top;
1.347 albertel 5859: }
1.795 www 5860:
1.425 albertel 5861: table.LC_data_table tr.LC_data_table_highlight td {
5862: background-color: $data_table_darker;
5863: }
1.795 www 5864:
1.639 raeburn 5865: table.LC_data_table tr td.LC_leftcol_header {
5866: background-color: $data_table_head;
5867: font-weight: bold;
5868: }
1.795 www 5869:
1.451 albertel 5870: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5871: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5872: font-weight: bold;
5873: font-style: italic;
5874: text-align: center;
5875: padding: 8px;
1.347 albertel 5876: }
1.795 www 5877:
1.1075.2.30 raeburn 5878: table.LC_data_table tr.LC_empty_row td,
5879: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5880: background-color: $sidebg;
5881: }
5882:
5883: table.LC_nested tr.LC_empty_row td {
5884: background-color: #FFFFFF;
5885: }
5886:
1.890 droeschl 5887: table.LC_caption {
5888: }
5889:
1.507 raeburn 5890: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5891: padding: 4ex
5892: }
1.795 www 5893:
1.507 raeburn 5894: table.LC_nested_outer tr th {
5895: font-weight: bold;
1.801 tempelho 5896: color:$fontmenu;
1.507 raeburn 5897: background-color: $data_table_head;
1.701 harmsja 5898: font-size: small;
1.507 raeburn 5899: border-bottom: 1px solid #000000;
5900: }
1.795 www 5901:
1.507 raeburn 5902: table.LC_nested_outer tr td.LC_subheader {
5903: background-color: $data_table_head;
5904: font-weight: bold;
5905: font-size: small;
5906: border-bottom: 1px solid #000000;
5907: text-align: right;
1.451 albertel 5908: }
1.795 www 5909:
1.507 raeburn 5910: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5911: background-color: #CCCCCC;
1.451 albertel 5912: font-weight: bold;
5913: font-size: small;
1.507 raeburn 5914: text-align: center;
5915: }
1.795 www 5916:
1.589 raeburn 5917: table.LC_nested tr.LC_info_row td.LC_left_item,
5918: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5919: text-align: left;
1.451 albertel 5920: }
1.795 www 5921:
1.507 raeburn 5922: table.LC_nested td {
1.735 bisitz 5923: background-color: #FFFFFF;
1.451 albertel 5924: font-size: small;
1.507 raeburn 5925: }
1.795 www 5926:
1.507 raeburn 5927: table.LC_nested_outer tr th.LC_right_item,
5928: table.LC_nested tr.LC_info_row td.LC_right_item,
5929: table.LC_nested tr.LC_odd_row td.LC_right_item,
5930: table.LC_nested tr td.LC_right_item {
1.451 albertel 5931: text-align: right;
5932: }
5933:
1.507 raeburn 5934: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5935: background-color: #EEEEEE;
1.451 albertel 5936: }
5937:
1.473 raeburn 5938: table.LC_createuser {
5939: }
5940:
5941: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5942: font-size: small;
1.473 raeburn 5943: }
5944:
5945: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5946: background-color: #CCCCCC;
1.473 raeburn 5947: font-weight: bold;
5948: text-align: center;
5949: }
5950:
1.349 albertel 5951: table.LC_calendar {
5952: border: 1px solid #000000;
5953: border-collapse: collapse;
1.917 raeburn 5954: width: 98%;
1.349 albertel 5955: }
1.795 www 5956:
1.349 albertel 5957: table.LC_calendar_pickdate {
5958: font-size: xx-small;
5959: }
1.795 www 5960:
1.349 albertel 5961: table.LC_calendar tr td {
5962: border: 1px solid #000000;
5963: vertical-align: top;
1.917 raeburn 5964: width: 14%;
1.349 albertel 5965: }
1.795 www 5966:
1.349 albertel 5967: table.LC_calendar tr td.LC_calendar_day_empty {
5968: background-color: $data_table_dark;
5969: }
1.795 www 5970:
1.779 bisitz 5971: table.LC_calendar tr td.LC_calendar_day_current {
5972: background-color: $data_table_highlight;
1.777 tempelho 5973: }
1.795 www 5974:
1.938 bisitz 5975: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5976: background-color: $mail_new;
5977: }
1.795 www 5978:
1.938 bisitz 5979: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5980: background-color: $mail_new_hover;
5981: }
1.795 www 5982:
1.938 bisitz 5983: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5984: background-color: $mail_read;
5985: }
1.795 www 5986:
1.938 bisitz 5987: /*
5988: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5989: background-color: $mail_read_hover;
5990: }
1.938 bisitz 5991: */
1.795 www 5992:
1.938 bisitz 5993: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5994: background-color: $mail_replied;
5995: }
1.795 www 5996:
1.938 bisitz 5997: /*
5998: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5999: background-color: $mail_replied_hover;
6000: }
1.938 bisitz 6001: */
1.795 www 6002:
1.938 bisitz 6003: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 6004: background-color: $mail_other;
6005: }
1.795 www 6006:
1.938 bisitz 6007: /*
6008: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 6009: background-color: $mail_other_hover;
6010: }
1.938 bisitz 6011: */
1.494 raeburn 6012:
1.777 tempelho 6013: table.LC_data_table tr > td.LC_browser_file,
6014: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 6015: background: #AAEE77;
1.389 albertel 6016: }
1.795 www 6017:
1.777 tempelho 6018: table.LC_data_table tr > td.LC_browser_file_locked,
6019: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 6020: background: #FFAA99;
1.387 albertel 6021: }
1.795 www 6022:
1.777 tempelho 6023: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 6024: background: #888888;
1.779 bisitz 6025: }
1.795 www 6026:
1.777 tempelho 6027: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6028: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6029: background: #F8F866;
1.777 tempelho 6030: }
1.795 www 6031:
1.696 bisitz 6032: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6033: background: #E0E8FF;
1.387 albertel 6034: }
1.696 bisitz 6035:
1.707 bisitz 6036: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6037: /* background: #77FF77; */
1.707 bisitz 6038: }
1.795 www 6039:
1.707 bisitz 6040: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6041: border-right: 8px solid #FFFF77;
1.707 bisitz 6042: }
1.795 www 6043:
1.707 bisitz 6044: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6045: border-right: 8px solid #FFAA77;
1.707 bisitz 6046: }
1.795 www 6047:
1.707 bisitz 6048: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6049: border-right: 8px solid #FF7777;
1.707 bisitz 6050: }
1.795 www 6051:
1.707 bisitz 6052: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6053: border-right: 8px solid #AAFF77;
1.707 bisitz 6054: }
1.795 www 6055:
1.707 bisitz 6056: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6057: border-right: 8px solid #11CC55;
1.707 bisitz 6058: }
6059:
1.388 albertel 6060: span.LC_current_location {
1.701 harmsja 6061: font-size:larger;
1.388 albertel 6062: background: $pgbg;
6063: }
1.387 albertel 6064:
1.1029 www 6065: span.LC_current_nav_location {
6066: font-weight:bold;
6067: background: $sidebg;
6068: }
6069:
1.395 albertel 6070: span.LC_parm_menu_item {
6071: font-size: larger;
6072: }
1.795 www 6073:
1.395 albertel 6074: span.LC_parm_scope_all {
6075: color: red;
6076: }
1.795 www 6077:
1.395 albertel 6078: span.LC_parm_scope_folder {
6079: color: green;
6080: }
1.795 www 6081:
1.395 albertel 6082: span.LC_parm_scope_resource {
6083: color: orange;
6084: }
1.795 www 6085:
1.395 albertel 6086: span.LC_parm_part {
6087: color: blue;
6088: }
1.795 www 6089:
1.911 bisitz 6090: span.LC_parm_folder,
6091: span.LC_parm_symb {
1.395 albertel 6092: font-size: x-small;
6093: font-family: $mono;
6094: color: #AAAAAA;
6095: }
6096:
1.977 bisitz 6097: ul.LC_parm_parmlist li {
6098: display: inline-block;
6099: padding: 0.3em 0.8em;
6100: vertical-align: top;
6101: width: 150px;
6102: border-top:1px solid $lg_border_color;
6103: }
6104:
1.795 www 6105: td.LC_parm_overview_level_menu,
6106: td.LC_parm_overview_map_menu,
6107: td.LC_parm_overview_parm_selectors,
6108: td.LC_parm_overview_restrictions {
1.396 albertel 6109: border: 1px solid black;
6110: border-collapse: collapse;
6111: }
1.795 www 6112:
1.396 albertel 6113: table.LC_parm_overview_restrictions td {
6114: border-width: 1px 4px 1px 4px;
6115: border-style: solid;
6116: border-color: $pgbg;
6117: text-align: center;
6118: }
1.795 www 6119:
1.396 albertel 6120: table.LC_parm_overview_restrictions th {
6121: background: $tabbg;
6122: border-width: 1px 4px 1px 4px;
6123: border-style: solid;
6124: border-color: $pgbg;
6125: }
1.795 www 6126:
1.398 albertel 6127: table#LC_helpmenu {
1.803 bisitz 6128: border: none;
1.398 albertel 6129: height: 55px;
1.803 bisitz 6130: border-spacing: 0;
1.398 albertel 6131: }
6132:
6133: table#LC_helpmenu fieldset legend {
6134: font-size: larger;
6135: }
1.795 www 6136:
1.397 albertel 6137: table#LC_helpmenu_links {
6138: width: 100%;
6139: border: 1px solid black;
6140: background: $pgbg;
1.803 bisitz 6141: padding: 0;
1.397 albertel 6142: border-spacing: 1px;
6143: }
1.795 www 6144:
1.397 albertel 6145: table#LC_helpmenu_links tr td {
6146: padding: 1px;
6147: background: $tabbg;
1.399 albertel 6148: text-align: center;
6149: font-weight: bold;
1.397 albertel 6150: }
1.396 albertel 6151:
1.795 www 6152: table#LC_helpmenu_links a:link,
6153: table#LC_helpmenu_links a:visited,
1.397 albertel 6154: table#LC_helpmenu_links a:active {
6155: text-decoration: none;
6156: color: $font;
6157: }
1.795 www 6158:
1.397 albertel 6159: table#LC_helpmenu_links a:hover {
6160: text-decoration: underline;
6161: color: $vlink;
6162: }
1.396 albertel 6163:
1.417 albertel 6164: .LC_chrt_popup_exists {
6165: border: 1px solid #339933;
6166: margin: -1px;
6167: }
1.795 www 6168:
1.417 albertel 6169: .LC_chrt_popup_up {
6170: border: 1px solid yellow;
6171: margin: -1px;
6172: }
1.795 www 6173:
1.417 albertel 6174: .LC_chrt_popup {
6175: border: 1px solid #8888FF;
6176: background: #CCCCFF;
6177: }
1.795 www 6178:
1.421 albertel 6179: table.LC_pick_box {
6180: border-collapse: separate;
6181: background: white;
6182: border: 1px solid black;
6183: border-spacing: 1px;
6184: }
1.795 www 6185:
1.421 albertel 6186: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6187: background: $sidebg;
1.421 albertel 6188: font-weight: bold;
1.900 bisitz 6189: text-align: left;
1.740 bisitz 6190: vertical-align: top;
1.421 albertel 6191: width: 184px;
6192: padding: 8px;
6193: }
1.795 www 6194:
1.579 raeburn 6195: table.LC_pick_box td.LC_pick_box_value {
6196: text-align: left;
6197: padding: 8px;
6198: }
1.795 www 6199:
1.579 raeburn 6200: table.LC_pick_box td.LC_pick_box_select {
6201: text-align: left;
6202: padding: 8px;
6203: }
1.795 www 6204:
1.424 albertel 6205: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6206: padding: 0;
1.421 albertel 6207: height: 1px;
6208: background: black;
6209: }
1.795 www 6210:
1.421 albertel 6211: table.LC_pick_box td.LC_pick_box_submit {
6212: text-align: right;
6213: }
1.795 www 6214:
1.579 raeburn 6215: table.LC_pick_box td.LC_evenrow_value {
6216: text-align: left;
6217: padding: 8px;
6218: background-color: $data_table_light;
6219: }
1.795 www 6220:
1.579 raeburn 6221: table.LC_pick_box td.LC_oddrow_value {
6222: text-align: left;
6223: padding: 8px;
6224: background-color: $data_table_light;
6225: }
1.795 www 6226:
1.579 raeburn 6227: span.LC_helpform_receipt_cat {
6228: font-weight: bold;
6229: }
1.795 www 6230:
1.424 albertel 6231: table.LC_group_priv_box {
6232: background: white;
6233: border: 1px solid black;
6234: border-spacing: 1px;
6235: }
1.795 www 6236:
1.424 albertel 6237: table.LC_group_priv_box td.LC_pick_box_title {
6238: background: $tabbg;
6239: font-weight: bold;
6240: text-align: right;
6241: width: 184px;
6242: }
1.795 www 6243:
1.424 albertel 6244: table.LC_group_priv_box td.LC_groups_fixed {
6245: background: $data_table_light;
6246: text-align: center;
6247: }
1.795 www 6248:
1.424 albertel 6249: table.LC_group_priv_box td.LC_groups_optional {
6250: background: $data_table_dark;
6251: text-align: center;
6252: }
1.795 www 6253:
1.424 albertel 6254: table.LC_group_priv_box td.LC_groups_functionality {
6255: background: $data_table_darker;
6256: text-align: center;
6257: font-weight: bold;
6258: }
1.795 www 6259:
1.424 albertel 6260: table.LC_group_priv td {
6261: text-align: left;
1.803 bisitz 6262: padding: 0;
1.424 albertel 6263: }
6264:
6265: .LC_navbuttons {
6266: margin: 2ex 0ex 2ex 0ex;
6267: }
1.795 www 6268:
1.423 albertel 6269: .LC_topic_bar {
6270: font-weight: bold;
6271: background: $tabbg;
1.918 wenzelju 6272: margin: 1em 0em 1em 2em;
1.805 bisitz 6273: padding: 3px;
1.918 wenzelju 6274: font-size: 1.2em;
1.423 albertel 6275: }
1.795 www 6276:
1.423 albertel 6277: .LC_topic_bar span {
1.918 wenzelju 6278: left: 0.5em;
6279: position: absolute;
1.423 albertel 6280: vertical-align: middle;
1.918 wenzelju 6281: font-size: 1.2em;
1.423 albertel 6282: }
1.795 www 6283:
1.423 albertel 6284: table.LC_course_group_status {
6285: margin: 20px;
6286: }
1.795 www 6287:
1.423 albertel 6288: table.LC_status_selector td {
6289: vertical-align: top;
6290: text-align: center;
1.424 albertel 6291: padding: 4px;
6292: }
1.795 www 6293:
1.599 albertel 6294: div.LC_feedback_link {
1.616 albertel 6295: clear: both;
1.829 kalberla 6296: background: $sidebg;
1.779 bisitz 6297: width: 100%;
1.829 kalberla 6298: padding-bottom: 10px;
6299: border: 1px $tabbg solid;
1.833 kalberla 6300: height: 22px;
6301: line-height: 22px;
6302: padding-top: 5px;
6303: }
6304:
6305: div.LC_feedback_link img {
6306: height: 22px;
1.867 kalberla 6307: vertical-align:middle;
1.829 kalberla 6308: }
6309:
1.911 bisitz 6310: div.LC_feedback_link a {
1.829 kalberla 6311: text-decoration: none;
1.489 raeburn 6312: }
1.795 www 6313:
1.867 kalberla 6314: div.LC_comblock {
1.911 bisitz 6315: display:inline;
1.867 kalberla 6316: color:$font;
6317: font-size:90%;
6318: }
6319:
6320: div.LC_feedback_link div.LC_comblock {
6321: padding-left:5px;
6322: }
6323:
6324: div.LC_feedback_link div.LC_comblock a {
6325: color:$font;
6326: }
6327:
1.489 raeburn 6328: span.LC_feedback_link {
1.858 bisitz 6329: /* background: $feedback_link_bg; */
1.599 albertel 6330: font-size: larger;
6331: }
1.795 www 6332:
1.599 albertel 6333: span.LC_message_link {
1.858 bisitz 6334: /* background: $feedback_link_bg; */
1.599 albertel 6335: font-size: larger;
6336: position: absolute;
6337: right: 1em;
1.489 raeburn 6338: }
1.421 albertel 6339:
1.515 albertel 6340: table.LC_prior_tries {
1.524 albertel 6341: border: 1px solid #000000;
6342: border-collapse: separate;
6343: border-spacing: 1px;
1.515 albertel 6344: }
1.523 albertel 6345:
1.515 albertel 6346: table.LC_prior_tries td {
1.524 albertel 6347: padding: 2px;
1.515 albertel 6348: }
1.523 albertel 6349:
6350: .LC_answer_correct {
1.795 www 6351: background: lightgreen;
6352: color: darkgreen;
6353: padding: 6px;
1.523 albertel 6354: }
1.795 www 6355:
1.523 albertel 6356: .LC_answer_charged_try {
1.797 www 6357: background: #FFAAAA;
1.795 www 6358: color: darkred;
6359: padding: 6px;
1.523 albertel 6360: }
1.795 www 6361:
1.779 bisitz 6362: .LC_answer_not_charged_try,
1.523 albertel 6363: .LC_answer_no_grade,
6364: .LC_answer_late {
1.795 www 6365: background: lightyellow;
1.523 albertel 6366: color: black;
1.795 www 6367: padding: 6px;
1.523 albertel 6368: }
1.795 www 6369:
1.523 albertel 6370: .LC_answer_previous {
1.795 www 6371: background: lightblue;
6372: color: darkblue;
6373: padding: 6px;
1.523 albertel 6374: }
1.795 www 6375:
1.779 bisitz 6376: .LC_answer_no_message {
1.777 tempelho 6377: background: #FFFFFF;
6378: color: black;
1.795 www 6379: padding: 6px;
1.779 bisitz 6380: }
1.795 www 6381:
1.779 bisitz 6382: .LC_answer_unknown {
6383: background: orange;
6384: color: black;
1.795 www 6385: padding: 6px;
1.777 tempelho 6386: }
1.795 www 6387:
1.529 albertel 6388: span.LC_prior_numerical,
6389: span.LC_prior_string,
6390: span.LC_prior_custom,
6391: span.LC_prior_reaction,
6392: span.LC_prior_math {
1.925 bisitz 6393: font-family: $mono;
1.523 albertel 6394: white-space: pre;
6395: }
6396:
1.525 albertel 6397: span.LC_prior_string {
1.925 bisitz 6398: font-family: $mono;
1.525 albertel 6399: white-space: pre;
6400: }
6401:
1.523 albertel 6402: table.LC_prior_option {
6403: width: 100%;
6404: border-collapse: collapse;
6405: }
1.795 www 6406:
1.911 bisitz 6407: table.LC_prior_rank,
1.795 www 6408: table.LC_prior_match {
1.528 albertel 6409: border-collapse: collapse;
6410: }
1.795 www 6411:
1.528 albertel 6412: table.LC_prior_option tr td,
6413: table.LC_prior_rank tr td,
6414: table.LC_prior_match tr td {
1.524 albertel 6415: border: 1px solid #000000;
1.515 albertel 6416: }
6417:
1.855 bisitz 6418: .LC_nobreak {
1.544 albertel 6419: white-space: nowrap;
1.519 raeburn 6420: }
6421:
1.576 raeburn 6422: span.LC_cusr_emph {
6423: font-style: italic;
6424: }
6425:
1.633 raeburn 6426: span.LC_cusr_subheading {
6427: font-weight: normal;
6428: font-size: 85%;
6429: }
6430:
1.861 bisitz 6431: div.LC_docs_entry_move {
1.859 bisitz 6432: border: 1px solid #BBBBBB;
1.545 albertel 6433: background: #DDDDDD;
1.861 bisitz 6434: width: 22px;
1.859 bisitz 6435: padding: 1px;
6436: margin: 0;
1.545 albertel 6437: }
6438:
1.861 bisitz 6439: table.LC_data_table tr > td.LC_docs_entry_commands,
6440: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6441: font-size: x-small;
6442: }
1.795 www 6443:
1.861 bisitz 6444: .LC_docs_entry_parameter {
6445: white-space: nowrap;
6446: }
6447:
1.544 albertel 6448: .LC_docs_copy {
1.545 albertel 6449: color: #000099;
1.544 albertel 6450: }
1.795 www 6451:
1.544 albertel 6452: .LC_docs_cut {
1.545 albertel 6453: color: #550044;
1.544 albertel 6454: }
1.795 www 6455:
1.544 albertel 6456: .LC_docs_rename {
1.545 albertel 6457: color: #009900;
1.544 albertel 6458: }
1.795 www 6459:
1.544 albertel 6460: .LC_docs_remove {
1.545 albertel 6461: color: #990000;
6462: }
6463:
1.547 albertel 6464: .LC_docs_reinit_warn,
6465: .LC_docs_ext_edit {
6466: font-size: x-small;
6467: }
6468:
1.545 albertel 6469: table.LC_docs_adddocs td,
6470: table.LC_docs_adddocs th {
6471: border: 1px solid #BBBBBB;
6472: padding: 4px;
6473: background: #DDDDDD;
1.543 albertel 6474: }
6475:
1.584 albertel 6476: table.LC_sty_begin {
6477: background: #BBFFBB;
6478: }
1.795 www 6479:
1.584 albertel 6480: table.LC_sty_end {
6481: background: #FFBBBB;
6482: }
6483:
1.589 raeburn 6484: table.LC_double_column {
1.803 bisitz 6485: border-width: 0;
1.589 raeburn 6486: border-collapse: collapse;
6487: width: 100%;
6488: padding: 2px;
6489: }
6490:
6491: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6492: top: 2px;
1.589 raeburn 6493: left: 2px;
6494: width: 47%;
6495: vertical-align: top;
6496: }
6497:
6498: table.LC_double_column tr td.LC_right_col {
6499: top: 2px;
1.779 bisitz 6500: right: 2px;
1.589 raeburn 6501: width: 47%;
6502: vertical-align: top;
6503: }
6504:
1.591 raeburn 6505: div.LC_left_float {
6506: float: left;
6507: padding-right: 5%;
1.597 albertel 6508: padding-bottom: 4px;
1.591 raeburn 6509: }
6510:
6511: div.LC_clear_float_header {
1.597 albertel 6512: padding-bottom: 2px;
1.591 raeburn 6513: }
6514:
6515: div.LC_clear_float_footer {
1.597 albertel 6516: padding-top: 10px;
1.591 raeburn 6517: clear: both;
6518: }
6519:
1.597 albertel 6520: div.LC_grade_show_user {
1.941 bisitz 6521: /* border-left: 5px solid $sidebg; */
6522: border-top: 5px solid #000000;
6523: margin: 50px 0 0 0;
1.936 bisitz 6524: padding: 15px 0 5px 10px;
1.597 albertel 6525: }
1.795 www 6526:
1.936 bisitz 6527: div.LC_grade_show_user_odd_row {
1.941 bisitz 6528: /* border-left: 5px solid #000000; */
6529: }
6530:
6531: div.LC_grade_show_user div.LC_Box {
6532: margin-right: 50px;
1.597 albertel 6533: }
6534:
6535: div.LC_grade_submissions,
6536: div.LC_grade_message_center,
1.936 bisitz 6537: div.LC_grade_info_links {
1.597 albertel 6538: margin: 5px;
6539: width: 99%;
6540: background: #FFFFFF;
6541: }
1.795 www 6542:
1.597 albertel 6543: div.LC_grade_submissions_header,
1.936 bisitz 6544: div.LC_grade_message_center_header {
1.705 tempelho 6545: font-weight: bold;
6546: font-size: large;
1.597 albertel 6547: }
1.795 www 6548:
1.597 albertel 6549: div.LC_grade_submissions_body,
1.936 bisitz 6550: div.LC_grade_message_center_body {
1.597 albertel 6551: border: 1px solid black;
6552: width: 99%;
6553: background: #FFFFFF;
6554: }
1.795 www 6555:
1.613 albertel 6556: table.LC_scantron_action {
6557: width: 100%;
6558: }
1.795 www 6559:
1.613 albertel 6560: table.LC_scantron_action tr th {
1.698 harmsja 6561: font-weight:bold;
6562: font-style:normal;
1.613 albertel 6563: }
1.795 www 6564:
1.779 bisitz 6565: .LC_edit_problem_header,
1.614 albertel 6566: div.LC_edit_problem_footer {
1.705 tempelho 6567: font-weight: normal;
6568: font-size: medium;
1.602 albertel 6569: margin: 2px;
1.1060 bisitz 6570: background-color: $sidebg;
1.600 albertel 6571: }
1.795 www 6572:
1.600 albertel 6573: div.LC_edit_problem_header,
1.602 albertel 6574: div.LC_edit_problem_header div,
1.614 albertel 6575: div.LC_edit_problem_footer,
6576: div.LC_edit_problem_footer div,
1.602 albertel 6577: div.LC_edit_problem_editxml_header,
6578: div.LC_edit_problem_editxml_header div {
1.600 albertel 6579: margin-top: 5px;
6580: }
1.795 www 6581:
1.600 albertel 6582: div.LC_edit_problem_header_title {
1.705 tempelho 6583: font-weight: bold;
6584: font-size: larger;
1.602 albertel 6585: background: $tabbg;
6586: padding: 3px;
1.1060 bisitz 6587: margin: 0 0 5px 0;
1.602 albertel 6588: }
1.795 www 6589:
1.602 albertel 6590: table.LC_edit_problem_header_title {
6591: width: 100%;
1.600 albertel 6592: background: $tabbg;
1.602 albertel 6593: }
6594:
6595: div.LC_edit_problem_discards {
6596: float: left;
6597: padding-bottom: 5px;
6598: }
1.795 www 6599:
1.602 albertel 6600: div.LC_edit_problem_saves {
6601: float: right;
6602: padding-bottom: 5px;
1.600 albertel 6603: }
1.795 www 6604:
1.1075.2.34 raeburn 6605: .LC_edit_opt {
6606: padding-left: 1em;
6607: white-space: nowrap;
6608: }
6609:
1.1075.2.57 raeburn 6610: .LC_edit_problem_latexhelper{
6611: text-align: right;
6612: }
6613:
6614: #LC_edit_problem_colorful div{
6615: margin-left: 40px;
6616: }
6617:
1.911 bisitz 6618: img.stift {
1.803 bisitz 6619: border-width: 0;
6620: vertical-align: middle;
1.677 riegler 6621: }
1.680 riegler 6622:
1.923 bisitz 6623: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6624: vertical-align: top;
1.777 tempelho 6625: }
1.795 www 6626:
1.716 raeburn 6627: div.LC_createcourse {
1.911 bisitz 6628: margin: 10px 10px 10px 10px;
1.716 raeburn 6629: }
6630:
1.917 raeburn 6631: .LC_dccid {
1.1075.2.38 raeburn 6632: float: right;
1.917 raeburn 6633: margin: 0.2em 0 0 0;
6634: padding: 0;
6635: font-size: 90%;
6636: display:none;
6637: }
6638:
1.897 wenzelju 6639: ol.LC_primary_menu a:hover,
1.721 harmsja 6640: ol#LC_MenuBreadcrumbs a:hover,
6641: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6642: ul#LC_secondary_menu a:hover,
1.721 harmsja 6643: .LC_FormSectionClearButton input:hover
1.795 www 6644: ul.LC_TabContent li:hover a {
1.952 onken 6645: color:$button_hover;
1.911 bisitz 6646: text-decoration:none;
1.693 droeschl 6647: }
6648:
1.779 bisitz 6649: h1 {
1.911 bisitz 6650: padding: 0;
6651: line-height:130%;
1.693 droeschl 6652: }
1.698 harmsja 6653:
1.911 bisitz 6654: h2,
6655: h3,
6656: h4,
6657: h5,
6658: h6 {
6659: margin: 5px 0 5px 0;
6660: padding: 0;
6661: line-height:130%;
1.693 droeschl 6662: }
1.795 www 6663:
6664: .LC_hcell {
1.911 bisitz 6665: padding:3px 15px 3px 15px;
6666: margin: 0;
6667: background-color:$tabbg;
6668: color:$fontmenu;
6669: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6670: }
1.795 www 6671:
1.840 bisitz 6672: .LC_Box > .LC_hcell {
1.911 bisitz 6673: margin: 0 -10px 10px -10px;
1.835 bisitz 6674: }
6675:
1.721 harmsja 6676: .LC_noBorder {
1.911 bisitz 6677: border: 0;
1.698 harmsja 6678: }
1.693 droeschl 6679:
1.721 harmsja 6680: .LC_FormSectionClearButton input {
1.911 bisitz 6681: background-color:transparent;
6682: border: none;
6683: cursor:pointer;
6684: text-decoration:underline;
1.693 droeschl 6685: }
1.763 bisitz 6686:
6687: .LC_help_open_topic {
1.911 bisitz 6688: color: #FFFFFF;
6689: background-color: #EEEEFF;
6690: margin: 1px;
6691: padding: 4px;
6692: border: 1px solid #000033;
6693: white-space: nowrap;
6694: /* vertical-align: middle; */
1.759 neumanie 6695: }
1.693 droeschl 6696:
1.911 bisitz 6697: dl,
6698: ul,
6699: div,
6700: fieldset {
6701: margin: 10px 10px 10px 0;
6702: /* overflow: hidden; */
1.693 droeschl 6703: }
1.795 www 6704:
1.1075.2.90 raeburn 6705: article.geogebraweb div {
6706: margin: 0;
6707: }
6708:
1.838 bisitz 6709: fieldset > legend {
1.911 bisitz 6710: font-weight: bold;
6711: padding: 0 5px 0 5px;
1.838 bisitz 6712: }
6713:
1.813 bisitz 6714: #LC_nav_bar {
1.911 bisitz 6715: float: left;
1.995 raeburn 6716: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6717: margin: 0 0 2px 0;
1.807 droeschl 6718: }
6719:
1.916 droeschl 6720: #LC_realm {
6721: margin: 0.2em 0 0 0;
6722: padding: 0;
6723: font-weight: bold;
6724: text-align: center;
1.995 raeburn 6725: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6726: }
6727:
1.911 bisitz 6728: #LC_nav_bar em {
6729: font-weight: bold;
6730: font-style: normal;
1.807 droeschl 6731: }
6732:
1.897 wenzelju 6733: ol.LC_primary_menu {
1.934 droeschl 6734: margin: 0;
1.1075.2.2 raeburn 6735: padding: 0;
1.995 raeburn 6736: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6737: }
6738:
1.852 droeschl 6739: ol#LC_PathBreadcrumbs {
1.911 bisitz 6740: margin: 0;
1.693 droeschl 6741: }
6742:
1.897 wenzelju 6743: ol.LC_primary_menu li {
1.1075.2.2 raeburn 6744: color: RGB(80, 80, 80);
6745: vertical-align: middle;
6746: text-align: left;
6747: list-style: none;
6748: float: left;
6749: }
6750:
6751: ol.LC_primary_menu li a {
6752: display: block;
6753: margin: 0;
6754: padding: 0 5px 0 10px;
6755: text-decoration: none;
6756: }
6757:
6758: ol.LC_primary_menu li ul {
6759: display: none;
6760: width: 10em;
6761: background-color: $data_table_light;
6762: }
6763:
6764: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6765: display: block;
6766: position: absolute;
6767: margin: 0;
6768: padding: 0;
1.1075.2.5 raeburn 6769: z-index: 2;
1.1075.2.2 raeburn 6770: }
6771:
6772: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6773: font-size: 90%;
1.911 bisitz 6774: vertical-align: top;
1.1075.2.2 raeburn 6775: float: none;
1.1075.2.5 raeburn 6776: border-left: 1px solid black;
6777: border-right: 1px solid black;
1.1075.2.2 raeburn 6778: }
6779:
6780: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1075.2.5 raeburn 6781: background-color:$data_table_light;
1.1075.2.2 raeburn 6782: }
6783:
6784: ol.LC_primary_menu li li a:hover {
6785: color:$button_hover;
6786: background-color:$data_table_dark;
1.693 droeschl 6787: }
6788:
1.897 wenzelju 6789: ol.LC_primary_menu li img {
1.911 bisitz 6790: vertical-align: bottom;
1.934 droeschl 6791: height: 1.1em;
1.1075.2.3 raeburn 6792: margin: 0.2em 0 0 0;
1.693 droeschl 6793: }
6794:
1.897 wenzelju 6795: ol.LC_primary_menu a {
1.911 bisitz 6796: color: RGB(80, 80, 80);
6797: text-decoration: none;
1.693 droeschl 6798: }
1.795 www 6799:
1.949 droeschl 6800: ol.LC_primary_menu a.LC_new_message {
6801: font-weight:bold;
6802: color: darkred;
6803: }
6804:
1.975 raeburn 6805: ol.LC_docs_parameters {
6806: margin-left: 0;
6807: padding: 0;
6808: list-style: none;
6809: }
6810:
6811: ol.LC_docs_parameters li {
6812: margin: 0;
6813: padding-right: 20px;
6814: display: inline;
6815: }
6816:
1.976 raeburn 6817: ol.LC_docs_parameters li:before {
6818: content: "\\002022 \\0020";
6819: }
6820:
6821: li.LC_docs_parameters_title {
6822: font-weight: bold;
6823: }
6824:
6825: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6826: content: "";
6827: }
6828:
1.897 wenzelju 6829: ul#LC_secondary_menu {
1.1075.2.23 raeburn 6830: clear: right;
1.911 bisitz 6831: color: $fontmenu;
6832: background: $tabbg;
6833: list-style: none;
6834: padding: 0;
6835: margin: 0;
6836: width: 100%;
1.995 raeburn 6837: text-align: left;
1.1075.2.4 raeburn 6838: float: left;
1.808 droeschl 6839: }
6840:
1.897 wenzelju 6841: ul#LC_secondary_menu li {
1.911 bisitz 6842: font-weight: bold;
6843: line-height: 1.8em;
6844: border-right: 1px solid black;
6845: vertical-align: middle;
1.1075.2.4 raeburn 6846: float: left;
6847: }
6848:
6849: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6850: background-color: $data_table_light;
6851: }
6852:
6853: ul#LC_secondary_menu li a {
6854: padding: 0 0.8em;
6855: }
6856:
6857: ul#LC_secondary_menu li ul {
6858: display: none;
6859: }
6860:
6861: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6862: display: block;
6863: position: absolute;
6864: margin: 0;
6865: padding: 0;
6866: list-style:none;
6867: float: none;
6868: background-color: $data_table_light;
1.1075.2.5 raeburn 6869: z-index: 2;
1.1075.2.10 raeburn 6870: margin-left: -1px;
1.1075.2.4 raeburn 6871: }
6872:
6873: ul#LC_secondary_menu li ul li {
6874: font-size: 90%;
6875: vertical-align: top;
6876: border-left: 1px solid black;
6877: border-right: 1px solid black;
1.1075.2.33 raeburn 6878: background-color: $data_table_light;
1.1075.2.4 raeburn 6879: list-style:none;
6880: float: none;
6881: }
6882:
6883: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6884: background-color: $data_table_dark;
1.807 droeschl 6885: }
6886:
1.847 tempelho 6887: ul.LC_TabContent {
1.911 bisitz 6888: display:block;
6889: background: $sidebg;
6890: border-bottom: solid 1px $lg_border_color;
6891: list-style:none;
1.1020 raeburn 6892: margin: -1px -10px 0 -10px;
1.911 bisitz 6893: padding: 0;
1.693 droeschl 6894: }
6895:
1.795 www 6896: ul.LC_TabContent li,
6897: ul.LC_TabContentBigger li {
1.911 bisitz 6898: float:left;
1.741 harmsja 6899: }
1.795 www 6900:
1.897 wenzelju 6901: ul#LC_secondary_menu li a {
1.911 bisitz 6902: color: $fontmenu;
6903: text-decoration: none;
1.693 droeschl 6904: }
1.795 www 6905:
1.721 harmsja 6906: ul.LC_TabContent {
1.952 onken 6907: min-height:20px;
1.721 harmsja 6908: }
1.795 www 6909:
6910: ul.LC_TabContent li {
1.911 bisitz 6911: vertical-align:middle;
1.959 onken 6912: padding: 0 16px 0 10px;
1.911 bisitz 6913: background-color:$tabbg;
6914: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6915: border-left: solid 1px $font;
1.721 harmsja 6916: }
1.795 www 6917:
1.847 tempelho 6918: ul.LC_TabContent .right {
1.911 bisitz 6919: float:right;
1.847 tempelho 6920: }
6921:
1.911 bisitz 6922: ul.LC_TabContent li a,
6923: ul.LC_TabContent li {
6924: color:rgb(47,47,47);
6925: text-decoration:none;
6926: font-size:95%;
6927: font-weight:bold;
1.952 onken 6928: min-height:20px;
6929: }
6930:
1.959 onken 6931: ul.LC_TabContent li a:hover,
6932: ul.LC_TabContent li a:focus {
1.952 onken 6933: color: $button_hover;
1.959 onken 6934: background:none;
6935: outline:none;
1.952 onken 6936: }
6937:
6938: ul.LC_TabContent li:hover {
6939: color: $button_hover;
6940: cursor:pointer;
1.721 harmsja 6941: }
1.795 www 6942:
1.911 bisitz 6943: ul.LC_TabContent li.active {
1.952 onken 6944: color: $font;
1.911 bisitz 6945: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6946: border-bottom:solid 1px #FFFFFF;
6947: cursor: default;
1.744 ehlerst 6948: }
1.795 www 6949:
1.959 onken 6950: ul.LC_TabContent li.active a {
6951: color:$font;
6952: background:#FFFFFF;
6953: outline: none;
6954: }
1.1047 raeburn 6955:
6956: ul.LC_TabContent li.goback {
6957: float: left;
6958: border-left: none;
6959: }
6960:
1.870 tempelho 6961: #maincoursedoc {
1.911 bisitz 6962: clear:both;
1.870 tempelho 6963: }
6964:
6965: ul.LC_TabContentBigger {
1.911 bisitz 6966: display:block;
6967: list-style:none;
6968: padding: 0;
1.870 tempelho 6969: }
6970:
1.795 www 6971: ul.LC_TabContentBigger li {
1.911 bisitz 6972: vertical-align:bottom;
6973: height: 30px;
6974: font-size:110%;
6975: font-weight:bold;
6976: color: #737373;
1.841 tempelho 6977: }
6978:
1.957 onken 6979: ul.LC_TabContentBigger li.active {
6980: position: relative;
6981: top: 1px;
6982: }
6983:
1.870 tempelho 6984: ul.LC_TabContentBigger li a {
1.911 bisitz 6985: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6986: height: 30px;
6987: line-height: 30px;
6988: text-align: center;
6989: display: block;
6990: text-decoration: none;
1.958 onken 6991: outline: none;
1.741 harmsja 6992: }
1.795 www 6993:
1.870 tempelho 6994: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6995: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6996: color:$font;
1.744 ehlerst 6997: }
1.795 www 6998:
1.870 tempelho 6999: ul.LC_TabContentBigger li b {
1.911 bisitz 7000: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
7001: display: block;
7002: float: left;
7003: padding: 0 30px;
1.957 onken 7004: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 7005: }
7006:
1.956 onken 7007: ul.LC_TabContentBigger li:hover b {
7008: color:$button_hover;
7009: }
7010:
1.870 tempelho 7011: ul.LC_TabContentBigger li.active b {
1.911 bisitz 7012: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
7013: color:$font;
1.957 onken 7014: border: 0;
1.741 harmsja 7015: }
1.693 droeschl 7016:
1.870 tempelho 7017:
1.862 bisitz 7018: ul.LC_CourseBreadcrumbs {
7019: background: $sidebg;
1.1020 raeburn 7020: height: 2em;
1.862 bisitz 7021: padding-left: 10px;
1.1020 raeburn 7022: margin: 0;
1.862 bisitz 7023: list-style-position: inside;
7024: }
7025:
1.911 bisitz 7026: ol#LC_MenuBreadcrumbs,
1.862 bisitz 7027: ol#LC_PathBreadcrumbs {
1.911 bisitz 7028: padding-left: 10px;
7029: margin: 0;
1.933 droeschl 7030: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7031: }
7032:
1.911 bisitz 7033: ol#LC_MenuBreadcrumbs li,
7034: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7035: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7036: display: inline;
1.933 droeschl 7037: white-space: normal;
1.693 droeschl 7038: }
7039:
1.823 bisitz 7040: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7041: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7042: text-decoration: none;
7043: font-size:90%;
1.693 droeschl 7044: }
1.795 www 7045:
1.969 droeschl 7046: ol#LC_MenuBreadcrumbs h1 {
7047: display: inline;
7048: font-size: 90%;
7049: line-height: 2.5em;
7050: margin: 0;
7051: padding: 0;
7052: }
7053:
1.795 www 7054: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7055: text-decoration:none;
7056: font-size:100%;
7057: font-weight:bold;
1.693 droeschl 7058: }
1.795 www 7059:
1.840 bisitz 7060: .LC_Box {
1.911 bisitz 7061: border: solid 1px $lg_border_color;
7062: padding: 0 10px 10px 10px;
1.746 neumanie 7063: }
1.795 www 7064:
1.1020 raeburn 7065: .LC_DocsBox {
7066: border: solid 1px $lg_border_color;
7067: padding: 0 0 10px 10px;
7068: }
7069:
1.795 www 7070: .LC_AboutMe_Image {
1.911 bisitz 7071: float:left;
7072: margin-right:10px;
1.747 neumanie 7073: }
1.795 www 7074:
7075: .LC_Clear_AboutMe_Image {
1.911 bisitz 7076: clear:left;
1.747 neumanie 7077: }
1.795 www 7078:
1.721 harmsja 7079: dl.LC_ListStyleClean dt {
1.911 bisitz 7080: padding-right: 5px;
7081: display: table-header-group;
1.693 droeschl 7082: }
7083:
1.721 harmsja 7084: dl.LC_ListStyleClean dd {
1.911 bisitz 7085: display: table-row;
1.693 droeschl 7086: }
7087:
1.721 harmsja 7088: .LC_ListStyleClean,
7089: .LC_ListStyleSimple,
7090: .LC_ListStyleNormal,
1.795 www 7091: .LC_ListStyleSpecial {
1.911 bisitz 7092: /* display:block; */
7093: list-style-position: inside;
7094: list-style-type: none;
7095: overflow: hidden;
7096: padding: 0;
1.693 droeschl 7097: }
7098:
1.721 harmsja 7099: .LC_ListStyleSimple li,
7100: .LC_ListStyleSimple dd,
7101: .LC_ListStyleNormal li,
7102: .LC_ListStyleNormal dd,
7103: .LC_ListStyleSpecial li,
1.795 www 7104: .LC_ListStyleSpecial dd {
1.911 bisitz 7105: margin: 0;
7106: padding: 5px 5px 5px 10px;
7107: clear: both;
1.693 droeschl 7108: }
7109:
1.721 harmsja 7110: .LC_ListStyleClean li,
7111: .LC_ListStyleClean dd {
1.911 bisitz 7112: padding-top: 0;
7113: padding-bottom: 0;
1.693 droeschl 7114: }
7115:
1.721 harmsja 7116: .LC_ListStyleSimple dd,
1.795 www 7117: .LC_ListStyleSimple li {
1.911 bisitz 7118: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7119: }
7120:
1.721 harmsja 7121: .LC_ListStyleSpecial li,
7122: .LC_ListStyleSpecial dd {
1.911 bisitz 7123: list-style-type: none;
7124: background-color: RGB(220, 220, 220);
7125: margin-bottom: 4px;
1.693 droeschl 7126: }
7127:
1.721 harmsja 7128: table.LC_SimpleTable {
1.911 bisitz 7129: margin:5px;
7130: border:solid 1px $lg_border_color;
1.795 www 7131: }
1.693 droeschl 7132:
1.721 harmsja 7133: table.LC_SimpleTable tr {
1.911 bisitz 7134: padding: 0;
7135: border:solid 1px $lg_border_color;
1.693 droeschl 7136: }
1.795 www 7137:
7138: table.LC_SimpleTable thead {
1.911 bisitz 7139: background:rgb(220,220,220);
1.693 droeschl 7140: }
7141:
1.721 harmsja 7142: div.LC_columnSection {
1.911 bisitz 7143: display: block;
7144: clear: both;
7145: overflow: hidden;
7146: margin: 0;
1.693 droeschl 7147: }
7148:
1.721 harmsja 7149: div.LC_columnSection>* {
1.911 bisitz 7150: float: left;
7151: margin: 10px 20px 10px 0;
7152: overflow:hidden;
1.693 droeschl 7153: }
1.721 harmsja 7154:
1.795 www 7155: table em {
1.911 bisitz 7156: font-weight: bold;
7157: font-style: normal;
1.748 schulted 7158: }
1.795 www 7159:
1.779 bisitz 7160: table.LC_tableBrowseRes,
1.795 www 7161: table.LC_tableOfContent {
1.911 bisitz 7162: border:none;
7163: border-spacing: 1px;
7164: padding: 3px;
7165: background-color: #FFFFFF;
7166: font-size: 90%;
1.753 droeschl 7167: }
1.789 droeschl 7168:
1.911 bisitz 7169: table.LC_tableOfContent {
7170: border-collapse: collapse;
1.789 droeschl 7171: }
7172:
1.771 droeschl 7173: table.LC_tableBrowseRes a,
1.768 schulted 7174: table.LC_tableOfContent a {
1.911 bisitz 7175: background-color: transparent;
7176: text-decoration: none;
1.753 droeschl 7177: }
7178:
1.795 www 7179: table.LC_tableOfContent img {
1.911 bisitz 7180: border: none;
7181: height: 1.3em;
7182: vertical-align: text-bottom;
7183: margin-right: 0.3em;
1.753 droeschl 7184: }
1.757 schulted 7185:
1.795 www 7186: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7187: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7188: }
7189:
1.795 www 7190: a#LC_content_toolbar_everything {
1.911 bisitz 7191: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7192: }
7193:
1.795 www 7194: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7195: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7196: }
7197:
1.795 www 7198: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7199: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7200: }
7201:
1.795 www 7202: a#LC_content_toolbar_changefolder {
1.911 bisitz 7203: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7204: }
7205:
1.795 www 7206: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7207: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7208: }
7209:
1.1043 raeburn 7210: a#LC_content_toolbar_edittoplevel {
7211: background-image:url(/res/adm/pages/edittoplevel.gif);
7212: }
7213:
1.795 www 7214: ul#LC_toolbar li a:hover {
1.911 bisitz 7215: background-position: bottom center;
1.757 schulted 7216: }
7217:
1.795 www 7218: ul#LC_toolbar {
1.911 bisitz 7219: padding: 0;
7220: margin: 2px;
7221: list-style:none;
7222: position:relative;
7223: background-color:white;
1.1075.2.9 raeburn 7224: overflow: auto;
1.757 schulted 7225: }
7226:
1.795 www 7227: ul#LC_toolbar li {
1.911 bisitz 7228: border:1px solid white;
7229: padding: 0;
7230: margin: 0;
7231: float: left;
7232: display:inline;
7233: vertical-align:middle;
1.1075.2.9 raeburn 7234: white-space: nowrap;
1.911 bisitz 7235: }
1.757 schulted 7236:
1.783 amueller 7237:
1.795 www 7238: a.LC_toolbarItem {
1.911 bisitz 7239: display:block;
7240: padding: 0;
7241: margin: 0;
7242: height: 32px;
7243: width: 32px;
7244: color:white;
7245: border: none;
7246: background-repeat:no-repeat;
7247: background-color:transparent;
1.757 schulted 7248: }
7249:
1.915 droeschl 7250: ul.LC_funclist {
7251: margin: 0;
7252: padding: 0.5em 1em 0.5em 0;
7253: }
7254:
1.933 droeschl 7255: ul.LC_funclist > li:first-child {
7256: font-weight:bold;
7257: margin-left:0.8em;
7258: }
7259:
1.915 droeschl 7260: ul.LC_funclist + ul.LC_funclist {
7261: /*
7262: left border as a seperator if we have more than
7263: one list
7264: */
7265: border-left: 1px solid $sidebg;
7266: /*
7267: this hides the left border behind the border of the
7268: outer box if element is wrapped to the next 'line'
7269: */
7270: margin-left: -1px;
7271: }
7272:
1.843 bisitz 7273: ul.LC_funclist li {
1.915 droeschl 7274: display: inline;
1.782 bisitz 7275: white-space: nowrap;
1.915 droeschl 7276: margin: 0 0 0 25px;
7277: line-height: 150%;
1.782 bisitz 7278: }
7279:
1.974 wenzelju 7280: .LC_hidden {
7281: display: none;
7282: }
7283:
1.1030 www 7284: .LCmodal-overlay {
7285: position:fixed;
7286: top:0;
7287: right:0;
7288: bottom:0;
7289: left:0;
7290: height:100%;
7291: width:100%;
7292: margin:0;
7293: padding:0;
7294: background:#999;
7295: opacity:.75;
7296: filter: alpha(opacity=75);
7297: -moz-opacity: 0.75;
7298: z-index:101;
7299: }
7300:
7301: * html .LCmodal-overlay {
7302: position: absolute;
7303: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7304: }
7305:
7306: .LCmodal-window {
7307: position:fixed;
7308: top:50%;
7309: left:50%;
7310: margin:0;
7311: padding:0;
7312: z-index:102;
7313: }
7314:
7315: * html .LCmodal-window {
7316: position:absolute;
7317: }
7318:
7319: .LCclose-window {
7320: position:absolute;
7321: width:32px;
7322: height:32px;
7323: right:8px;
7324: top:8px;
7325: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7326: text-indent:-99999px;
7327: overflow:hidden;
7328: cursor:pointer;
7329: }
7330:
1.1075.2.17 raeburn 7331: /*
7332: styles used by TTH when "Default set of options to pass to tth/m
7333: when converting TeX" in course settings has been set
7334:
7335: option passed: -t
7336:
7337: */
7338:
7339: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7340: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7341: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7342: td div.norm {line-height:normal;}
7343:
7344: /*
7345: option passed -y3
7346: */
7347:
7348: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7349: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7350: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7351:
1.343 albertel 7352: END
7353: }
7354:
1.306 albertel 7355: =pod
7356:
7357: =item * &headtag()
7358:
7359: Returns a uniform footer for LON-CAPA web pages.
7360:
1.307 albertel 7361: Inputs: $title - optional title for the head
7362: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7363: $args - optional arguments
1.319 albertel 7364: force_register - if is true call registerurl so the remote is
7365: informed
1.415 albertel 7366: redirect -> array ref of
7367: 1- seconds before redirect occurs
7368: 2- url to redirect to
7369: 3- whether the side effect should occur
1.315 albertel 7370: (side effect of setting
7371: $env{'internal.head.redirect'} to the url
7372: redirected too)
1.352 albertel 7373: domain -> force to color decorate a page for a specific
7374: domain
7375: function -> force usage of a specific rolish color scheme
7376: bgcolor -> override the default page bgcolor
1.460 albertel 7377: no_auto_mt_title
7378: -> prevent &mt()ing the title arg
1.464 albertel 7379:
1.306 albertel 7380: =cut
7381:
7382: sub headtag {
1.313 albertel 7383: my ($title,$head_extra,$args) = @_;
1.306 albertel 7384:
1.363 albertel 7385: my $function = $args->{'function'} || &get_users_function();
7386: my $domain = $args->{'domain'} || &determinedomain();
7387: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1075.2.52 raeburn 7388: my $httphost = $args->{'use_absolute'};
1.418 albertel 7389: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7390: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7391: #time(),
1.418 albertel 7392: $env{'environment.color.timestamp'},
1.363 albertel 7393: $function,$domain,$bgcolor);
7394:
1.369 www 7395: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7396:
1.308 albertel 7397: my $result =
7398: '<head>'.
1.1075.2.56 raeburn 7399: &font_settings($args);
1.319 albertel 7400:
1.1075.2.72 raeburn 7401: my $inhibitprint;
7402: if ($args->{'print_suppress'}) {
7403: $inhibitprint = &print_suppression();
7404: }
1.1064 raeburn 7405:
1.461 albertel 7406: if (!$args->{'frameset'}) {
7407: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7408: }
1.1075.2.12 raeburn 7409: if ($args->{'force_register'}) {
7410: $result .= &Apache::lonmenu::registerurl(1);
1.319 albertel 7411: }
1.436 albertel 7412: if (!$args->{'no_nav_bar'}
7413: && !$args->{'only_body'}
7414: && !$args->{'frameset'}) {
1.1075.2.52 raeburn 7415: $result .= &help_menu_js($httphost);
1.1032 www 7416: $result.=&modal_window();
1.1038 www 7417: $result.=&togglebox_script();
1.1034 www 7418: $result.=&wishlist_window();
1.1041 www 7419: $result.=&LCprogressbarUpdate_script();
1.1034 www 7420: } else {
7421: if ($args->{'add_modal'}) {
7422: $result.=&modal_window();
7423: }
7424: if ($args->{'add_wishlist'}) {
7425: $result.=&wishlist_window();
7426: }
1.1038 www 7427: if ($args->{'add_togglebox'}) {
7428: $result.=&togglebox_script();
7429: }
1.1041 www 7430: if ($args->{'add_progressbar'}) {
7431: $result.=&LCprogressbarUpdate_script();
7432: }
1.436 albertel 7433: }
1.314 albertel 7434: if (ref($args->{'redirect'})) {
1.414 albertel 7435: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7436: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7437: if (!$inhibit_continue) {
7438: $env{'internal.head.redirect'} = $url;
7439: }
1.313 albertel 7440: $result.=<<ADDMETA
7441: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7442: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7443: ADDMETA
1.1075.2.89 raeburn 7444: } else {
7445: unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
7446: my $requrl = $env{'request.uri'};
7447: if ($requrl eq '') {
7448: $requrl = $ENV{'REQUEST_URI'};
7449: $requrl =~ s/\?.+$//;
7450: }
7451: unless (($requrl =~ m{^/adm/(?:switchserver|login|authenticate|logout|groupsort|cleanup|helper|slotrequest|grades)(\?|$)}) ||
7452: (($requrl =~ m{^/res/}) && (($env{'form.submitted'} eq 'scantron') ||
7453: ($env{'form.grade_symb'}) || ($Apache::lonhomework::scantronmode)))) {
7454: my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
7455: unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
7456: my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
7457: if (ref($domdefs{'offloadnow'}) eq 'HASH') {
7458: my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
7459: if ($domdefs{'offloadnow'}{$lonhost}) {
7460: my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
7461: if (($newserver) && ($newserver ne $lonhost)) {
7462: my $numsec = 5;
7463: my $timeout = $numsec * 1000;
7464: my ($newurl,$locknum,%locks,$msg);
7465: if ($env{'request.role.adv'}) {
7466: ($locknum,%locks) = &Apache::lonnet::get_locks();
7467: }
7468: my $disable_submit = 0;
7469: if ($requrl =~ /$LONCAPA::assess_re/) {
7470: $disable_submit = 1;
7471: }
7472: if ($locknum) {
7473: my @lockinfo = sort(values(%locks));
7474: $msg = &mt('Once the following tasks are complete: ')."\\n".
7475: join(", ",sort(values(%locks)))."\\n".
7476: &mt('your session will be transferred to a different server, after you click "Roles".');
7477: } else {
7478: if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
7479: $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
7480: }
7481: $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
7482: $newurl = '/adm/switchserver?otherserver='.$newserver;
7483: if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
7484: $newurl .= '&role='.$env{'request.role'};
7485: }
7486: if ($env{'request.symb'}) {
7487: $newurl .= '&symb='.$env{'request.symb'};
7488: } else {
7489: $newurl .= '&origurl='.$requrl;
7490: }
7491: }
1.1075.2.98 raeburn 7492: &js_escape(\$msg);
1.1075.2.89 raeburn 7493: $result.=<<OFFLOAD
7494: <meta http-equiv="pragma" content="no-cache" />
7495: <script type="text/javascript">
1.1075.2.92 raeburn 7496: // <![CDATA[
1.1075.2.89 raeburn 7497: function LC_Offload_Now() {
7498: var dest = "$newurl";
7499: if (dest != '') {
7500: window.location.href="$newurl";
7501: }
7502: }
1.1075.2.92 raeburn 7503: \$(document).ready(function () {
7504: window.alert('$msg');
7505: if ($disable_submit) {
1.1075.2.89 raeburn 7506: \$(".LC_hwk_submit").prop("disabled", true);
7507: \$( ".LC_textline" ).prop( "readonly", "readonly");
1.1075.2.92 raeburn 7508: }
7509: setTimeout('LC_Offload_Now()', $timeout);
7510: });
7511: // ]]>
1.1075.2.89 raeburn 7512: </script>
7513: OFFLOAD
7514: }
7515: }
7516: }
7517: }
7518: }
7519: }
1.313 albertel 7520: }
1.306 albertel 7521: if (!defined($title)) {
7522: $title = 'The LearningOnline Network with CAPA';
7523: }
1.460 albertel 7524: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7525: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1075.2.61 raeburn 7526: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7527: if (!$args->{'frameset'}) {
7528: $result .= ' /';
7529: }
7530: $result .= '>'
1.1064 raeburn 7531: .$inhibitprint
1.414 albertel 7532: .$head_extra;
1.1075.2.42 raeburn 7533: if ($env{'browser.mobile'}) {
7534: $result .= '
7535: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7536: <meta name="apple-mobile-web-app-capable" content="yes" />';
7537: }
1.962 droeschl 7538: return $result.'</head>';
1.306 albertel 7539: }
7540:
7541: =pod
7542:
1.340 albertel 7543: =item * &font_settings()
7544:
7545: Returns neccessary <meta> to set the proper encoding
7546:
1.1075.2.56 raeburn 7547: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7548:
7549: =cut
7550:
7551: sub font_settings {
1.1075.2.56 raeburn 7552: my ($args) = @_;
1.340 albertel 7553: my $headerstring='';
1.1075.2.56 raeburn 7554: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7555: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.340 albertel 7556: $headerstring.=
1.1075.2.61 raeburn 7557: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7558: if (!$args->{'frameset'}) {
7559: $headerstring.= ' /';
7560: }
7561: $headerstring .= '>'."\n";
1.340 albertel 7562: }
7563: return $headerstring;
7564: }
7565:
1.341 albertel 7566: =pod
7567:
1.1064 raeburn 7568: =item * &print_suppression()
7569:
7570: In course context returns css which causes the body to be blank when media="print",
7571: if printout generation is unavailable for the current resource.
7572:
7573: This could be because:
7574:
7575: (a) printstartdate is in the future
7576:
7577: (b) printenddate is in the past
7578:
7579: (c) there is an active exam block with "printout"
7580: functionality blocked
7581:
7582: Users with pav, pfo or evb privileges are exempt.
7583:
7584: Inputs: none
7585:
7586: =cut
7587:
7588:
7589: sub print_suppression {
7590: my $noprint;
7591: if ($env{'request.course.id'}) {
7592: my $scope = $env{'request.course.id'};
7593: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7594: (&Apache::lonnet::allowed('pfo',$scope))) {
7595: return;
7596: }
7597: if ($env{'request.course.sec'} ne '') {
7598: $scope .= "/$env{'request.course.sec'}";
7599: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7600: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7601: return;
1.1064 raeburn 7602: }
7603: }
7604: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7605: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.73 raeburn 7606: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7607: if ($blocked) {
7608: my $checkrole = "cm./$cdom/$cnum";
7609: if ($env{'request.course.sec'} ne '') {
7610: $checkrole .= "/$env{'request.course.sec'}";
7611: }
7612: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7613: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7614: $noprint = 1;
7615: }
7616: }
7617: unless ($noprint) {
7618: my $symb = &Apache::lonnet::symbread();
7619: if ($symb ne '') {
7620: my $navmap = Apache::lonnavmaps::navmap->new();
7621: if (ref($navmap)) {
7622: my $res = $navmap->getBySymb($symb);
7623: if (ref($res)) {
7624: if (!$res->resprintable()) {
7625: $noprint = 1;
7626: }
7627: }
7628: }
7629: }
7630: }
7631: if ($noprint) {
7632: return <<"ENDSTYLE";
7633: <style type="text/css" media="print">
7634: body { display:none }
7635: </style>
7636: ENDSTYLE
7637: }
7638: }
7639: return;
7640: }
7641:
7642: =pod
7643:
1.341 albertel 7644: =item * &xml_begin()
7645:
7646: Returns the needed doctype and <html>
7647:
7648: Inputs: none
7649:
7650: =cut
7651:
7652: sub xml_begin {
1.1075.2.61 raeburn 7653: my ($is_frameset) = @_;
1.341 albertel 7654: my $output='';
7655:
7656: if ($env{'browser.mathml'}) {
7657: $output='<?xml version="1.0"?>'
7658: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7659: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7660:
7661: # .'<!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">] >'
7662: .'<!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">'
7663: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7664: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1075.2.61 raeburn 7665: } elsif ($is_frameset) {
7666: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7667: '<html>'."\n";
1.341 albertel 7668: } else {
1.1075.2.61 raeburn 7669: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7670: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7671: }
7672: return $output;
7673: }
1.340 albertel 7674:
7675: =pod
7676:
1.306 albertel 7677: =item * &start_page()
7678:
7679: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7680:
1.648 raeburn 7681: Inputs:
7682:
7683: =over 4
7684:
7685: $title - optional title for the page
7686:
7687: $head_extra - optional extra HTML to incude inside the <head>
7688:
7689: $args - additional optional args supported are:
7690:
7691: =over 8
7692:
7693: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7694: arg on
1.814 bisitz 7695: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7696: add_entries -> additional attributes to add to the <body>
7697: domain -> force to color decorate a page for a
1.317 albertel 7698: specific domain
1.648 raeburn 7699: function -> force usage of a specific rolish color
1.317 albertel 7700: scheme
1.648 raeburn 7701: redirect -> see &headtag()
7702: bgcolor -> override the default page bg color
7703: js_ready -> return a string ready for being used in
1.317 albertel 7704: a javascript writeln
1.648 raeburn 7705: html_encode -> return a string ready for being used in
1.320 albertel 7706: a html attribute
1.648 raeburn 7707: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7708: $forcereg arg
1.648 raeburn 7709: frameset -> if true will start with a <frameset>
1.330 albertel 7710: rather than <body>
1.648 raeburn 7711: skip_phases -> hash ref of
1.338 albertel 7712: head -> skip the <html><head> generation
7713: body -> skip all <body> generation
1.1075.2.12 raeburn 7714: no_inline_link -> if true and in remote mode, don't show the
7715: 'Switch To Inline Menu' link
1.648 raeburn 7716: no_auto_mt_title -> prevent &mt()ing the title arg
1.867 kalberla 7717: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7718: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1075.2.15 raeburn 7719: group -> includes the current group, if page is for a
7720: specific group
1.361 albertel 7721:
1.648 raeburn 7722: =back
1.460 albertel 7723:
1.648 raeburn 7724: =back
1.562 albertel 7725:
1.306 albertel 7726: =cut
7727:
7728: sub start_page {
1.309 albertel 7729: my ($title,$head_extra,$args) = @_;
1.318 albertel 7730: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7731:
1.315 albertel 7732: $env{'internal.start_page'}++;
1.1075.2.15 raeburn 7733: my ($result,@advtools);
1.964 droeschl 7734:
1.338 albertel 7735: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1075.2.62 raeburn 7736: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 7737: }
7738:
7739: if (! exists($args->{'skip_phases'}{'body'}) ) {
7740: if ($args->{'frameset'}) {
7741: my $attr_string = &make_attr_string($args->{'force_register'},
7742: $args->{'add_entries'});
7743: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7744: } else {
7745: $result .=
7746: &bodytag($title,
7747: $args->{'function'}, $args->{'add_entries'},
7748: $args->{'only_body'}, $args->{'domain'},
7749: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1075.2.12 raeburn 7750: $args->{'bgcolor'}, $args->{'no_inline_link'},
1.1075.2.15 raeburn 7751: $args, \@advtools);
1.831 bisitz 7752: }
1.330 albertel 7753: }
1.338 albertel 7754:
1.315 albertel 7755: if ($args->{'js_ready'}) {
1.713 kaisler 7756: $result = &js_ready($result);
1.315 albertel 7757: }
1.320 albertel 7758: if ($args->{'html_encode'}) {
1.713 kaisler 7759: $result = &html_encode($result);
7760: }
7761:
1.813 bisitz 7762: # Preparation for new and consistent functionlist at top of screen
7763: # if ($args->{'functionlist'}) {
7764: # $result .= &build_functionlist();
7765: #}
7766:
1.964 droeschl 7767: # Don't add anything more if only_body wanted or in const space
7768: return $result if $args->{'only_body'}
7769: || $env{'request.state'} eq 'construct';
1.813 bisitz 7770:
7771: #Breadcrumbs
1.758 kaisler 7772: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7773: &Apache::lonhtmlcommon::clear_breadcrumbs();
7774: #if any br links exists, add them to the breadcrumbs
7775: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7776: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7777: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7778: }
7779: }
1.1075.2.19 raeburn 7780: # if @advtools array contains items add then to the breadcrumbs
7781: if (@advtools > 0) {
7782: &Apache::lonmenu::advtools_crumbs(@advtools);
7783: }
1.758 kaisler 7784:
7785: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7786: if(exists($args->{'bread_crumbs_component'})){
7787: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7788: }else{
7789: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7790: }
1.1075.2.24 raeburn 7791: } elsif (($env{'environment.remote'} eq 'on') &&
7792: ($env{'form.inhibitmenu'} ne 'yes') &&
7793: ($env{'request.noversionuri'} =~ m{^/res/}) &&
7794: ($env{'request.noversionuri'} !~ m{^/res/adm/pages/})) {
1.1075.2.21 raeburn 7795: $result .= '<div style="padding:0;margin:0;clear:both"><hr /></div>';
1.320 albertel 7796: }
1.315 albertel 7797: return $result;
1.306 albertel 7798: }
7799:
7800: sub end_page {
1.315 albertel 7801: my ($args) = @_;
7802: $env{'internal.end_page'}++;
1.330 albertel 7803: my $result;
1.335 albertel 7804: if ($args->{'discussion'}) {
7805: my ($target,$parser);
7806: if (ref($args->{'discussion'})) {
7807: ($target,$parser) =($args->{'discussion'}{'target'},
7808: $args->{'discussion'}{'parser'});
7809: }
7810: $result .= &Apache::lonxml::xmlend($target,$parser);
7811: }
1.330 albertel 7812: if ($args->{'frameset'}) {
7813: $result .= '</frameset>';
7814: } else {
1.635 raeburn 7815: $result .= &endbodytag($args);
1.330 albertel 7816: }
1.1075.2.6 raeburn 7817: unless ($args->{'notbody'}) {
7818: $result .= "\n</html>";
7819: }
1.330 albertel 7820:
1.315 albertel 7821: if ($args->{'js_ready'}) {
1.317 albertel 7822: $result = &js_ready($result);
1.315 albertel 7823: }
1.335 albertel 7824:
1.320 albertel 7825: if ($args->{'html_encode'}) {
7826: $result = &html_encode($result);
7827: }
1.335 albertel 7828:
1.315 albertel 7829: return $result;
7830: }
7831:
1.1034 www 7832: sub wishlist_window {
7833: return(<<'ENDWISHLIST');
1.1046 raeburn 7834: <script type="text/javascript">
1.1034 www 7835: // <![CDATA[
7836: // <!-- BEGIN LON-CAPA Internal
7837: function set_wishlistlink(title, path) {
7838: if (!title) {
7839: title = document.title;
7840: title = title.replace(/^LON-CAPA /,'');
7841: }
1.1075.2.65 raeburn 7842: title = encodeURIComponent(title);
1.1075.2.83 raeburn 7843: title = title.replace("'","\\\'");
1.1034 www 7844: if (!path) {
7845: path = location.pathname;
7846: }
1.1075.2.65 raeburn 7847: path = encodeURIComponent(path);
1.1075.2.83 raeburn 7848: path = path.replace("'","\\\'");
1.1034 www 7849: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7850: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7851: }
7852: // END LON-CAPA Internal -->
7853: // ]]>
7854: </script>
7855: ENDWISHLIST
7856: }
7857:
1.1030 www 7858: sub modal_window {
7859: return(<<'ENDMODAL');
1.1046 raeburn 7860: <script type="text/javascript">
1.1030 www 7861: // <![CDATA[
7862: // <!-- BEGIN LON-CAPA Internal
7863: var modalWindow = {
7864: parent:"body",
7865: windowId:null,
7866: content:null,
7867: width:null,
7868: height:null,
7869: close:function()
7870: {
7871: $(".LCmodal-window").remove();
7872: $(".LCmodal-overlay").remove();
7873: },
7874: open:function()
7875: {
7876: var modal = "";
7877: modal += "<div class=\"LCmodal-overlay\"></div>";
7878: 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;\">";
7879: modal += this.content;
7880: modal += "</div>";
7881:
7882: $(this.parent).append(modal);
7883:
7884: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7885: $(".LCclose-window").click(function(){modalWindow.close();});
7886: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7887: }
7888: };
1.1075.2.42 raeburn 7889: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7890: {
1.1075.2.83 raeburn 7891: source = source.replace("'","'");
1.1030 www 7892: modalWindow.windowId = "myModal";
7893: modalWindow.width = width;
7894: modalWindow.height = height;
1.1075.2.80 raeburn 7895: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7896: modalWindow.open();
1.1075.2.87 raeburn 7897: };
1.1030 www 7898: // END LON-CAPA Internal -->
7899: // ]]>
7900: </script>
7901: ENDMODAL
7902: }
7903:
7904: sub modal_link {
1.1075.2.42 raeburn 7905: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7906: unless ($width) { $width=480; }
7907: unless ($height) { $height=400; }
1.1031 www 7908: unless ($scrolling) { $scrolling='yes'; }
1.1075.2.42 raeburn 7909: unless ($transparency) { $transparency='true'; }
7910:
1.1074 raeburn 7911: my $target_attr;
7912: if (defined($target)) {
7913: $target_attr = 'target="'.$target.'"';
7914: }
7915: return <<"ENDLINK";
1.1075.2.42 raeburn 7916: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7917: $linktext</a>
7918: ENDLINK
1.1030 www 7919: }
7920:
1.1032 www 7921: sub modal_adhoc_script {
7922: my ($funcname,$width,$height,$content)=@_;
7923: return (<<ENDADHOC);
1.1046 raeburn 7924: <script type="text/javascript">
1.1032 www 7925: // <![CDATA[
7926: var $funcname = function()
7927: {
7928: modalWindow.windowId = "myModal";
7929: modalWindow.width = $width;
7930: modalWindow.height = $height;
7931: modalWindow.content = '$content';
7932: modalWindow.open();
7933: };
7934: // ]]>
7935: </script>
7936: ENDADHOC
7937: }
7938:
1.1041 www 7939: sub modal_adhoc_inner {
7940: my ($funcname,$width,$height,$content)=@_;
7941: my $innerwidth=$width-20;
7942: $content=&js_ready(
1.1042 www 7943: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
1.1075.2.42 raeburn 7944: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7945: $content.
1.1041 www 7946: &end_scrollbox().
1.1075.2.42 raeburn 7947: &end_page()
1.1041 www 7948: );
7949: return &modal_adhoc_script($funcname,$width,$height,$content);
7950: }
7951:
7952: sub modal_adhoc_window {
7953: my ($funcname,$width,$height,$content,$linktext)=@_;
7954: return &modal_adhoc_inner($funcname,$width,$height,$content).
7955: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7956: }
7957:
7958: sub modal_adhoc_launch {
7959: my ($funcname,$width,$height,$content)=@_;
7960: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7961: <script type="text/javascript">
7962: // <![CDATA[
7963: $funcname();
7964: // ]]>
7965: </script>
7966: ENDLAUNCH
7967: }
7968:
7969: sub modal_adhoc_close {
7970: return (<<ENDCLOSE);
7971: <script type="text/javascript">
7972: // <![CDATA[
7973: modalWindow.close();
7974: // ]]>
7975: </script>
7976: ENDCLOSE
7977: }
7978:
1.1038 www 7979: sub togglebox_script {
7980: return(<<ENDTOGGLE);
7981: <script type="text/javascript">
7982: // <![CDATA[
7983: function LCtoggleDisplay(id,hidetext,showtext) {
7984: link = document.getElementById(id + "link").childNodes[0];
7985: with (document.getElementById(id).style) {
7986: if (display == "none" ) {
7987: display = "inline";
7988: link.nodeValue = hidetext;
7989: } else {
7990: display = "none";
7991: link.nodeValue = showtext;
7992: }
7993: }
7994: }
7995: // ]]>
7996: </script>
7997: ENDTOGGLE
7998: }
7999:
1.1039 www 8000: sub start_togglebox {
8001: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
8002: unless ($heading) { $heading=''; } else { $heading.=' '; }
8003: unless ($showtext) { $showtext=&mt('show'); }
8004: unless ($hidetext) { $hidetext=&mt('hide'); }
8005: unless ($headerbg) { $headerbg='#FFFFFF'; }
8006: return &start_data_table().
8007: &start_data_table_header_row().
8008: '<td bgcolor="'.$headerbg.'">'.$heading.
8009: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
8010: $showtext.'\')">'.$showtext.'</a>]</td>'.
8011: &end_data_table_header_row().
8012: '<tr id="'.$id.'" style="display:none""><td>';
8013: }
8014:
8015: sub end_togglebox {
8016: return '</td></tr>'.&end_data_table();
8017: }
8018:
1.1041 www 8019: sub LCprogressbar_script {
1.1045 www 8020: my ($id)=@_;
1.1041 www 8021: return(<<ENDPROGRESS);
8022: <script type="text/javascript">
8023: // <![CDATA[
1.1045 www 8024: \$('#progressbar$id').progressbar({
1.1041 www 8025: value: 0,
8026: change: function(event, ui) {
8027: var newVal = \$(this).progressbar('option', 'value');
8028: \$('.pblabel', this).text(LCprogressTxt);
8029: }
8030: });
8031: // ]]>
8032: </script>
8033: ENDPROGRESS
8034: }
8035:
8036: sub LCprogressbarUpdate_script {
8037: return(<<ENDPROGRESSUPDATE);
8038: <style type="text/css">
8039: .ui-progressbar { position:relative; }
8040: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
8041: </style>
8042: <script type="text/javascript">
8043: // <![CDATA[
1.1045 www 8044: var LCprogressTxt='---';
8045:
8046: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 8047: LCprogressTxt=progresstext;
1.1045 www 8048: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 8049: }
8050: // ]]>
8051: </script>
8052: ENDPROGRESSUPDATE
8053: }
8054:
1.1042 www 8055: my $LClastpercent;
1.1045 www 8056: my $LCidcnt;
8057: my $LCcurrentid;
1.1042 www 8058:
1.1041 www 8059: sub LCprogressbar {
1.1042 www 8060: my ($r)=(@_);
8061: $LClastpercent=0;
1.1045 www 8062: $LCidcnt++;
8063: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 8064: my $starting=&mt('Starting');
8065: my $content=(<<ENDPROGBAR);
1.1045 www 8066: <div id="progressbar$LCcurrentid">
1.1041 www 8067: <span class="pblabel">$starting</span>
8068: </div>
8069: ENDPROGBAR
1.1045 www 8070: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 8071: }
8072:
8073: sub LCprogressbarUpdate {
1.1042 www 8074: my ($r,$val,$text)=@_;
8075: unless ($val) {
8076: if ($LClastpercent) {
8077: $val=$LClastpercent;
8078: } else {
8079: $val=0;
8080: }
8081: }
1.1041 www 8082: if ($val<0) { $val=0; }
8083: if ($val>100) { $val=0; }
1.1042 www 8084: $LClastpercent=$val;
1.1041 www 8085: unless ($text) { $text=$val.'%'; }
8086: $text=&js_ready($text);
1.1044 www 8087: &r_print($r,<<ENDUPDATE);
1.1041 www 8088: <script type="text/javascript">
8089: // <![CDATA[
1.1045 www 8090: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 8091: // ]]>
8092: </script>
8093: ENDUPDATE
1.1035 www 8094: }
8095:
1.1042 www 8096: sub LCprogressbarClose {
8097: my ($r)=@_;
8098: $LClastpercent=0;
1.1044 www 8099: &r_print($r,<<ENDCLOSE);
1.1042 www 8100: <script type="text/javascript">
8101: // <![CDATA[
1.1045 www 8102: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 8103: // ]]>
8104: </script>
8105: ENDCLOSE
1.1044 www 8106: }
8107:
8108: sub r_print {
8109: my ($r,$to_print)=@_;
8110: if ($r) {
8111: $r->print($to_print);
8112: $r->rflush();
8113: } else {
8114: print($to_print);
8115: }
1.1042 www 8116: }
8117:
1.320 albertel 8118: sub html_encode {
8119: my ($result) = @_;
8120:
1.322 albertel 8121: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8122:
8123: return $result;
8124: }
1.1044 www 8125:
1.317 albertel 8126: sub js_ready {
8127: my ($result) = @_;
8128:
1.323 albertel 8129: $result =~ s/[\n\r]/ /xmsg;
8130: $result =~ s/\\/\\\\/xmsg;
8131: $result =~ s/'/\\'/xmsg;
1.372 albertel 8132: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8133:
8134: return $result;
8135: }
8136:
1.315 albertel 8137: sub validate_page {
8138: if ( exists($env{'internal.start_page'})
1.316 albertel 8139: && $env{'internal.start_page'} > 1) {
8140: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8141: $env{'internal.start_page'}.' '.
1.316 albertel 8142: $ENV{'request.filename'});
1.315 albertel 8143: }
8144: if ( exists($env{'internal.end_page'})
1.316 albertel 8145: && $env{'internal.end_page'} > 1) {
8146: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8147: $env{'internal.end_page'}.' '.
1.316 albertel 8148: $env{'request.filename'});
1.315 albertel 8149: }
8150: if ( exists($env{'internal.start_page'})
8151: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8152: &Apache::lonnet::logthis('start_page called without end_page '.
8153: $env{'request.filename'});
1.315 albertel 8154: }
8155: if ( ! exists($env{'internal.start_page'})
8156: && exists($env{'internal.end_page'})) {
1.316 albertel 8157: &Apache::lonnet::logthis('end_page called without start_page'.
8158: $env{'request.filename'});
1.315 albertel 8159: }
1.306 albertel 8160: }
1.315 albertel 8161:
1.996 www 8162:
8163: sub start_scrollbox {
1.1075.2.56 raeburn 8164: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8165: unless ($outerwidth) { $outerwidth='520px'; }
8166: unless ($width) { $width='500px'; }
8167: unless ($height) { $height='200px'; }
1.1075 raeburn 8168: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8169: if ($id ne '') {
1.1075.2.42 raeburn 8170: $table_id = ' id="table_'.$id.'"';
8171: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8172: }
1.1075 raeburn 8173: if ($bgcolor ne '') {
8174: $tdcol = "background-color: $bgcolor;";
8175: }
1.1075.2.42 raeburn 8176: my $nicescroll_js;
8177: if ($env{'browser.mobile'}) {
8178: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8179: }
1.1075 raeburn 8180: return <<"END";
1.1075.2.42 raeburn 8181: $nicescroll_js
8182:
8183: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
1.1075.2.56 raeburn 8184: <div style="overflow:auto; width:$width; height:$height;"$div_id>
1.1075 raeburn 8185: END
1.996 www 8186: }
8187:
8188: sub end_scrollbox {
1.1036 www 8189: return '</div></td></tr></table>';
1.996 www 8190: }
8191:
1.1075.2.42 raeburn 8192: sub nicescroll_javascript {
8193: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8194: my %options;
8195: if (ref($cursor) eq 'HASH') {
8196: %options = %{$cursor};
8197: }
8198: unless ($options{'railalign'} =~ /^left|right$/) {
8199: $options{'railalign'} = 'left';
8200: }
8201: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8202: my $function = &get_users_function();
8203: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
8204: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8205: $options{'cursorcolor'} = '#00F';
8206: }
8207: }
8208: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8209: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
8210: $options{'cursoropacity'}='1.0';
8211: }
8212: } else {
8213: $options{'cursoropacity'}='1.0';
8214: }
8215: if ($options{'cursorfixedheight'} eq 'none') {
8216: delete($options{'cursorfixedheight'});
8217: } else {
8218: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8219: }
8220: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8221: delete($options{'railoffset'});
8222: }
8223: my @niceoptions;
8224: while (my($key,$value) = each(%options)) {
8225: if ($value =~ /^\{.+\}$/) {
8226: push(@niceoptions,$key.':'.$value);
8227: } else {
8228: push(@niceoptions,$key.':"'.$value.'"');
8229: }
8230: }
8231: my $nicescroll_js = '
8232: $(document).ready(
8233: function() {
8234: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8235: }
8236: );
8237: ';
8238: if ($framecheck) {
8239: $nicescroll_js .= '
8240: function expand_div(caller) {
8241: if (top === self) {
8242: document.getElementById("'.$id.'").style.width = "auto";
8243: document.getElementById("'.$id.'").style.height = "auto";
8244: } else {
8245: try {
8246: if (parent.frames) {
8247: if (parent.frames.length > 1) {
8248: var framesrc = parent.frames[1].location.href;
8249: var currsrc = framesrc.replace(/\#.*$/,"");
8250: if ((caller == "search") || (currsrc == "'.$location.'")) {
8251: document.getElementById("'.$id.'").style.width = "auto";
8252: document.getElementById("'.$id.'").style.height = "auto";
8253: }
8254: }
8255: }
8256: } catch (e) {
8257: return;
8258: }
8259: }
8260: return;
8261: }
8262: ';
8263: }
8264: if ($needjsready) {
8265: $nicescroll_js = '
8266: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8267: } else {
8268: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8269: }
8270: return $nicescroll_js;
8271: }
8272:
1.318 albertel 8273: sub simple_error_page {
1.1075.2.49 raeburn 8274: my ($r,$title,$msg,$args) = @_;
8275: if (ref($args) eq 'HASH') {
8276: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8277: } else {
8278: $msg = &mt($msg);
8279: }
8280:
1.318 albertel 8281: my $page =
8282: &Apache::loncommon::start_page($title).
1.1075.2.49 raeburn 8283: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8284: &Apache::loncommon::end_page();
8285: if (ref($r)) {
8286: $r->print($page);
1.327 albertel 8287: return;
1.318 albertel 8288: }
8289: return $page;
8290: }
1.347 albertel 8291:
8292: {
1.610 albertel 8293: my @row_count;
1.961 onken 8294:
8295: sub start_data_table_count {
8296: unshift(@row_count, 0);
8297: return;
8298: }
8299:
8300: sub end_data_table_count {
8301: shift(@row_count);
8302: return;
8303: }
8304:
1.347 albertel 8305: sub start_data_table {
1.1018 raeburn 8306: my ($add_class,$id) = @_;
1.422 albertel 8307: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8308: my $table_id;
8309: if (defined($id)) {
8310: $table_id = ' id="'.$id.'"';
8311: }
1.961 onken 8312: &start_data_table_count();
1.1018 raeburn 8313: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8314: }
8315:
8316: sub end_data_table {
1.961 onken 8317: &end_data_table_count();
1.389 albertel 8318: return '</table>'."\n";;
1.347 albertel 8319: }
8320:
8321: sub start_data_table_row {
1.974 wenzelju 8322: my ($add_class, $id) = @_;
1.610 albertel 8323: $row_count[0]++;
8324: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8325: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8326: $id = (' id="'.$id.'"') unless ($id eq '');
8327: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8328: }
1.471 banghart 8329:
8330: sub continue_data_table_row {
1.974 wenzelju 8331: my ($add_class, $id) = @_;
1.610 albertel 8332: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8333: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8334: $id = (' id="'.$id.'"') unless ($id eq '');
8335: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8336: }
1.347 albertel 8337:
8338: sub end_data_table_row {
1.389 albertel 8339: return '</tr>'."\n";;
1.347 albertel 8340: }
1.367 www 8341:
1.421 albertel 8342: sub start_data_table_empty_row {
1.707 bisitz 8343: # $row_count[0]++;
1.421 albertel 8344: return '<tr class="LC_empty_row" >'."\n";;
8345: }
8346:
8347: sub end_data_table_empty_row {
8348: return '</tr>'."\n";;
8349: }
8350:
1.367 www 8351: sub start_data_table_header_row {
1.389 albertel 8352: return '<tr class="LC_header_row">'."\n";;
1.367 www 8353: }
8354:
8355: sub end_data_table_header_row {
1.389 albertel 8356: return '</tr>'."\n";;
1.367 www 8357: }
1.890 droeschl 8358:
8359: sub data_table_caption {
8360: my $caption = shift;
8361: return "<caption class=\"LC_caption\">$caption</caption>";
8362: }
1.347 albertel 8363: }
8364:
1.548 albertel 8365: =pod
8366:
8367: =item * &inhibit_menu_check($arg)
8368:
8369: Checks for a inhibitmenu state and generates output to preserve it
8370:
8371: Inputs: $arg - can be any of
8372: - undef - in which case the return value is a string
8373: to add into arguments list of a uri
8374: - 'input' - in which case the return value is a HTML
8375: <form> <input> field of type hidden to
8376: preserve the value
8377: - a url - in which case the return value is the url with
8378: the neccesary cgi args added to preserve the
8379: inhibitmenu state
8380: - a ref to a url - no return value, but the string is
8381: updated to include the neccessary cgi
8382: args to preserve the inhibitmenu state
8383:
8384: =cut
8385:
8386: sub inhibit_menu_check {
8387: my ($arg) = @_;
8388: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8389: if ($arg eq 'input') {
8390: if ($env{'form.inhibitmenu'}) {
8391: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8392: } else {
8393: return
8394: }
8395: }
8396: if ($env{'form.inhibitmenu'}) {
8397: if (ref($arg)) {
8398: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8399: } elsif ($arg eq '') {
8400: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8401: } else {
8402: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8403: }
8404: }
8405: if (!ref($arg)) {
8406: return $arg;
8407: }
8408: }
8409:
1.251 albertel 8410: ###############################################
1.182 matthew 8411:
8412: =pod
8413:
1.549 albertel 8414: =back
8415:
8416: =head1 User Information Routines
8417:
8418: =over 4
8419:
1.405 albertel 8420: =item * &get_users_function()
1.182 matthew 8421:
8422: Used by &bodytag to determine the current users primary role.
8423: Returns either 'student','coordinator','admin', or 'author'.
8424:
8425: =cut
8426:
8427: ###############################################
8428: sub get_users_function {
1.815 tempelho 8429: my $function = 'norole';
1.818 tempelho 8430: if ($env{'request.role'}=~/^(st)/) {
8431: $function='student';
8432: }
1.907 raeburn 8433: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8434: $function='coordinator';
8435: }
1.258 albertel 8436: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8437: $function='admin';
8438: }
1.826 bisitz 8439: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8440: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8441: $function='author';
8442: }
8443: return $function;
1.54 www 8444: }
1.99 www 8445:
8446: ###############################################
8447:
1.233 raeburn 8448: =pod
8449:
1.821 raeburn 8450: =item * &show_course()
8451:
8452: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8453: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8454:
8455: Inputs:
8456: None
8457:
8458: Outputs:
8459: Scalar: 1 if 'Course' to be used, 0 otherwise.
8460:
8461: =cut
8462:
8463: ###############################################
8464: sub show_course {
8465: my $course = !$env{'user.adv'};
8466: if (!$env{'user.adv'}) {
8467: foreach my $env (keys(%env)) {
8468: next if ($env !~ m/^user\.priv\./);
8469: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8470: $course = 0;
8471: last;
8472: }
8473: }
8474: }
8475: return $course;
8476: }
8477:
8478: ###############################################
8479:
8480: =pod
8481:
1.542 raeburn 8482: =item * &check_user_status()
1.274 raeburn 8483:
8484: Determines current status of supplied role for a
8485: specific user. Roles can be active, previous or future.
8486:
8487: Inputs:
8488: user's domain, user's username, course's domain,
1.375 raeburn 8489: course's number, optional section ID.
1.274 raeburn 8490:
8491: Outputs:
8492: role status: active, previous or future.
8493:
8494: =cut
8495:
8496: sub check_user_status {
1.412 raeburn 8497: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8498: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.1075.2.85 raeburn 8499: my @uroles = keys(%userinfo);
1.274 raeburn 8500: my $srchstr;
8501: my $active_chk = 'none';
1.412 raeburn 8502: my $now = time;
1.274 raeburn 8503: if (@uroles > 0) {
1.908 raeburn 8504: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8505: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8506: } else {
1.412 raeburn 8507: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8508: }
8509: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8510: my $role_end = 0;
8511: my $role_start = 0;
8512: $active_chk = 'active';
1.412 raeburn 8513: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8514: $role_end = $1;
8515: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8516: $role_start = $1;
1.274 raeburn 8517: }
8518: }
8519: if ($role_start > 0) {
1.412 raeburn 8520: if ($now < $role_start) {
1.274 raeburn 8521: $active_chk = 'future';
8522: }
8523: }
8524: if ($role_end > 0) {
1.412 raeburn 8525: if ($now > $role_end) {
1.274 raeburn 8526: $active_chk = 'previous';
8527: }
8528: }
8529: }
8530: }
8531: return $active_chk;
8532: }
8533:
8534: ###############################################
8535:
8536: =pod
8537:
1.405 albertel 8538: =item * &get_sections()
1.233 raeburn 8539:
8540: Determines all the sections for a course including
8541: sections with students and sections containing other roles.
1.419 raeburn 8542: Incoming parameters:
8543:
8544: 1. domain
8545: 2. course number
8546: 3. reference to array containing roles for which sections should
8547: be gathered (optional).
8548: 4. reference to array containing status types for which sections
8549: should be gathered (optional).
8550:
8551: If the third argument is undefined, sections are gathered for any role.
8552: If the fourth argument is undefined, sections are gathered for any status.
8553: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8554:
1.374 raeburn 8555: Returns section hash (keys are section IDs, values are
8556: number of users in each section), subject to the
1.419 raeburn 8557: optional roles filter, optional status filter
1.233 raeburn 8558:
8559: =cut
8560:
8561: ###############################################
8562: sub get_sections {
1.419 raeburn 8563: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8564: if (!defined($cdom) || !defined($cnum)) {
8565: my $cid = $env{'request.course.id'};
8566:
8567: return if (!defined($cid));
8568:
8569: $cdom = $env{'course.'.$cid.'.domain'};
8570: $cnum = $env{'course.'.$cid.'.num'};
8571: }
8572:
8573: my %sectioncount;
1.419 raeburn 8574: my $now = time;
1.240 albertel 8575:
1.1075.2.33 raeburn 8576: my $check_students = 1;
8577: my $only_students = 0;
8578: if (ref($possible_roles) eq 'ARRAY') {
8579: if (grep(/^st$/,@{$possible_roles})) {
8580: if (@{$possible_roles} == 1) {
8581: $only_students = 1;
8582: }
8583: } else {
8584: $check_students = 0;
8585: }
8586: }
8587:
8588: if ($check_students) {
1.276 albertel 8589: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8590: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8591: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8592: my $start_index = &Apache::loncoursedata::CL_START();
8593: my $end_index = &Apache::loncoursedata::CL_END();
8594: my $status;
1.366 albertel 8595: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8596: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8597: $data->[$status_index],
8598: $data->[$start_index],
8599: $data->[$end_index]);
8600: if ($stu_status eq 'Active') {
8601: $status = 'active';
8602: } elsif ($end < $now) {
8603: $status = 'previous';
8604: } elsif ($start > $now) {
8605: $status = 'future';
8606: }
8607: if ($section ne '-1' && $section !~ /^\s*$/) {
8608: if ((!defined($possible_status)) || (($status ne '') &&
8609: (grep/^\Q$status\E$/,@{$possible_status}))) {
8610: $sectioncount{$section}++;
8611: }
1.240 albertel 8612: }
8613: }
8614: }
1.1075.2.33 raeburn 8615: if ($only_students) {
8616: return %sectioncount;
8617: }
1.240 albertel 8618: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8619: foreach my $user (sort(keys(%courseroles))) {
8620: if ($user !~ /^(\w{2})/) { next; }
8621: my ($role) = ($user =~ /^(\w{2})/);
8622: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8623: my ($section,$status);
1.240 albertel 8624: if ($role eq 'cr' &&
8625: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8626: $section=$1;
8627: }
8628: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8629: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8630: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8631: if ($end == -1 && $start == -1) {
8632: next; #deleted role
8633: }
8634: if (!defined($possible_status)) {
8635: $sectioncount{$section}++;
8636: } else {
8637: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8638: $status = 'active';
8639: } elsif ($end < $now) {
8640: $status = 'future';
8641: } elsif ($start > $now) {
8642: $status = 'previous';
8643: }
8644: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8645: $sectioncount{$section}++;
8646: }
8647: }
1.233 raeburn 8648: }
1.366 albertel 8649: return %sectioncount;
1.233 raeburn 8650: }
8651:
1.274 raeburn 8652: ###############################################
1.294 raeburn 8653:
8654: =pod
1.405 albertel 8655:
8656: =item * &get_course_users()
8657:
1.275 raeburn 8658: Retrieves usernames:domains for users in the specified course
8659: with specific role(s), and access status.
8660:
8661: Incoming parameters:
1.277 albertel 8662: 1. course domain
8663: 2. course number
8664: 3. access status: users must have - either active,
1.275 raeburn 8665: previous, future, or all.
1.277 albertel 8666: 4. reference to array of permissible roles
1.288 raeburn 8667: 5. reference to array of section restrictions (optional)
8668: 6. reference to results object (hash of hashes).
8669: 7. reference to optional userdata hash
1.609 raeburn 8670: 8. reference to optional statushash
1.630 raeburn 8671: 9. flag if privileged users (except those set to unhide in
8672: course settings) should be excluded
1.609 raeburn 8673: Keys of top level results hash are roles.
1.275 raeburn 8674: Keys of inner hashes are username:domain, with
8675: values set to access type.
1.288 raeburn 8676: Optional userdata hash returns an array with arguments in the
8677: same order as loncoursedata::get_classlist() for student data.
8678:
1.609 raeburn 8679: Optional statushash returns
8680:
1.288 raeburn 8681: Entries for end, start, section and status are blank because
8682: of the possibility of multiple values for non-student roles.
8683:
1.275 raeburn 8684: =cut
1.405 albertel 8685:
1.275 raeburn 8686: ###############################################
1.405 albertel 8687:
1.275 raeburn 8688: sub get_course_users {
1.630 raeburn 8689: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8690: my %idx = ();
1.419 raeburn 8691: my %seclists;
1.288 raeburn 8692:
8693: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8694: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8695: $idx{end} = &Apache::loncoursedata::CL_END();
8696: $idx{start} = &Apache::loncoursedata::CL_START();
8697: $idx{id} = &Apache::loncoursedata::CL_ID();
8698: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8699: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8700: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8701:
1.290 albertel 8702: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8703: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8704: my $now = time;
1.277 albertel 8705: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8706: my $match = 0;
1.412 raeburn 8707: my $secmatch = 0;
1.419 raeburn 8708: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8709: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8710: if ($section eq '') {
8711: $section = 'none';
8712: }
1.291 albertel 8713: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8714: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8715: $secmatch = 1;
8716: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8717: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8718: $secmatch = 1;
8719: }
8720: } else {
1.419 raeburn 8721: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8722: $secmatch = 1;
8723: }
1.290 albertel 8724: }
1.412 raeburn 8725: if (!$secmatch) {
8726: next;
8727: }
1.419 raeburn 8728: }
1.275 raeburn 8729: if (defined($$types{'active'})) {
1.288 raeburn 8730: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8731: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8732: $match = 1;
1.275 raeburn 8733: }
8734: }
8735: if (defined($$types{'previous'})) {
1.609 raeburn 8736: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8737: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8738: $match = 1;
1.275 raeburn 8739: }
8740: }
8741: if (defined($$types{'future'})) {
1.609 raeburn 8742: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8743: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8744: $match = 1;
1.275 raeburn 8745: }
8746: }
1.609 raeburn 8747: if ($match) {
8748: push(@{$seclists{$student}},$section);
8749: if (ref($userdata) eq 'HASH') {
8750: $$userdata{$student} = $$classlist{$student};
8751: }
8752: if (ref($statushash) eq 'HASH') {
8753: $statushash->{$student}{'st'}{$section} = $status;
8754: }
1.288 raeburn 8755: }
1.275 raeburn 8756: }
8757: }
1.412 raeburn 8758: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8759: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8760: my $now = time;
1.609 raeburn 8761: my %displaystatus = ( previous => 'Expired',
8762: active => 'Active',
8763: future => 'Future',
8764: );
1.1075.2.36 raeburn 8765: my (%nothide,@possdoms);
1.630 raeburn 8766: if ($hidepriv) {
8767: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8768: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8769: if ($user !~ /:/) {
8770: $nothide{join(':',split(/[\@]/,$user))}=1;
8771: } else {
8772: $nothide{$user} = 1;
8773: }
8774: }
1.1075.2.36 raeburn 8775: my @possdoms = ($cdom);
8776: if ($coursehash{'checkforpriv'}) {
8777: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8778: }
1.630 raeburn 8779: }
1.439 raeburn 8780: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8781: my $match = 0;
1.412 raeburn 8782: my $secmatch = 0;
1.439 raeburn 8783: my $status;
1.412 raeburn 8784: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8785: $user =~ s/:$//;
1.439 raeburn 8786: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8787: if ($end == -1 || $start == -1) {
8788: next;
8789: }
8790: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8791: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8792: my ($uname,$udom) = split(/:/,$user);
8793: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8794: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8795: $secmatch = 1;
8796: } elsif ($usec eq '') {
1.420 albertel 8797: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8798: $secmatch = 1;
8799: }
8800: } else {
8801: if (grep(/^\Q$usec\E$/,@{$sections})) {
8802: $secmatch = 1;
8803: }
8804: }
8805: if (!$secmatch) {
8806: next;
8807: }
1.288 raeburn 8808: }
1.419 raeburn 8809: if ($usec eq '') {
8810: $usec = 'none';
8811: }
1.275 raeburn 8812: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8813: if ($hidepriv) {
1.1075.2.36 raeburn 8814: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8815: (!$nothide{$uname.':'.$udom})) {
8816: next;
8817: }
8818: }
1.503 raeburn 8819: if ($end > 0 && $end < $now) {
1.439 raeburn 8820: $status = 'previous';
8821: } elsif ($start > $now) {
8822: $status = 'future';
8823: } else {
8824: $status = 'active';
8825: }
1.277 albertel 8826: foreach my $type (keys(%{$types})) {
1.275 raeburn 8827: if ($status eq $type) {
1.420 albertel 8828: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8829: push(@{$$users{$role}{$user}},$type);
8830: }
1.288 raeburn 8831: $match = 1;
8832: }
8833: }
1.419 raeburn 8834: if (($match) && (ref($userdata) eq 'HASH')) {
8835: if (!exists($$userdata{$uname.':'.$udom})) {
8836: &get_user_info($udom,$uname,\%idx,$userdata);
8837: }
1.420 albertel 8838: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8839: push(@{$seclists{$uname.':'.$udom}},$usec);
8840: }
1.609 raeburn 8841: if (ref($statushash) eq 'HASH') {
8842: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8843: }
1.275 raeburn 8844: }
8845: }
8846: }
8847: }
1.290 albertel 8848: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8849: if ((defined($cdom)) && (defined($cnum))) {
8850: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8851: if ( defined($csettings{'internal.courseowner'}) ) {
8852: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8853: next if ($owner eq '');
8854: my ($ownername,$ownerdom);
8855: if ($owner =~ /^([^:]+):([^:]+)$/) {
8856: $ownername = $1;
8857: $ownerdom = $2;
8858: } else {
8859: $ownername = $owner;
8860: $ownerdom = $cdom;
8861: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8862: }
8863: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8864: if (defined($userdata) &&
1.609 raeburn 8865: !exists($$userdata{$owner})) {
8866: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8867: if (!grep(/^none$/,@{$seclists{$owner}})) {
8868: push(@{$seclists{$owner}},'none');
8869: }
8870: if (ref($statushash) eq 'HASH') {
8871: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8872: }
1.290 albertel 8873: }
1.279 raeburn 8874: }
8875: }
8876: }
1.419 raeburn 8877: foreach my $user (keys(%seclists)) {
8878: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8879: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8880: }
1.275 raeburn 8881: }
8882: return;
8883: }
8884:
1.288 raeburn 8885: sub get_user_info {
8886: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8887: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8888: &plainname($uname,$udom,'lastname');
1.291 albertel 8889: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8890: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8891: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8892: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8893: return;
8894: }
1.275 raeburn 8895:
1.472 raeburn 8896: ###############################################
8897:
8898: =pod
8899:
8900: =item * &get_user_quota()
8901:
1.1075.2.41 raeburn 8902: Retrieves quota assigned for storage of user files.
8903: Default is to report quota for portfolio files.
1.472 raeburn 8904:
8905: Incoming parameters:
8906: 1. user's username
8907: 2. user's domain
1.1075.2.41 raeburn 8908: 3. quota name - portfolio, author, or course
8909: (if no quota name provided, defaults to portfolio).
1.1075.2.59 raeburn 8910: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1075.2.42 raeburn 8911: course
1.472 raeburn 8912:
8913: Returns:
1.1075.2.58 raeburn 8914: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8915: 2. (Optional) Type of setting: custom or default
8916: (individually assigned or default for user's
8917: institutional status).
8918: 3. (Optional) - User's institutional status (e.g., faculty, staff
8919: or student - types as defined in localenroll::inst_usertypes
8920: for user's domain, which determines default quota for user.
8921: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8922:
8923: If a value has been stored in the user's environment,
1.536 raeburn 8924: it will return that, otherwise it returns the maximal default
1.1075.2.41 raeburn 8925: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8926:
8927: =cut
8928:
8929: ###############################################
8930:
8931:
8932: sub get_user_quota {
1.1075.2.42 raeburn 8933: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8934: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8935: if (!defined($udom)) {
8936: $udom = $env{'user.domain'};
8937: }
8938: if (!defined($uname)) {
8939: $uname = $env{'user.name'};
8940: }
8941: if (($udom eq '' || $uname eq '') ||
8942: ($udom eq 'public') && ($uname eq 'public')) {
8943: $quota = 0;
1.536 raeburn 8944: $quotatype = 'default';
8945: $defquota = 0;
1.472 raeburn 8946: } else {
1.536 raeburn 8947: my $inststatus;
1.1075.2.41 raeburn 8948: if ($quotaname eq 'course') {
8949: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8950: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8951: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8952: } else {
8953: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8954: $quota = $cenv{'internal.uploadquota'};
8955: }
1.536 raeburn 8956: } else {
1.1075.2.41 raeburn 8957: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8958: if ($quotaname eq 'author') {
8959: $quota = $env{'environment.authorquota'};
8960: } else {
8961: $quota = $env{'environment.portfolioquota'};
8962: }
8963: $inststatus = $env{'environment.inststatus'};
8964: } else {
8965: my %userenv =
8966: &Apache::lonnet::get('environment',['portfolioquota',
8967: 'authorquota','inststatus'],$udom,$uname);
8968: my ($tmp) = keys(%userenv);
8969: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8970: if ($quotaname eq 'author') {
8971: $quota = $userenv{'authorquota'};
8972: } else {
8973: $quota = $userenv{'portfolioquota'};
8974: }
8975: $inststatus = $userenv{'inststatus'};
8976: } else {
8977: undef(%userenv);
8978: }
8979: }
8980: }
8981: if ($quota eq '' || wantarray) {
8982: if ($quotaname eq 'course') {
8983: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1075.2.59 raeburn 8984: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8985: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1075.2.42 raeburn 8986: $defquota = $domdefs{$crstype.'quota'};
8987: }
8988: if ($defquota eq '') {
8989: $defquota = 500;
8990: }
1.1075.2.41 raeburn 8991: } else {
8992: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8993: }
8994: if ($quota eq '') {
8995: $quota = $defquota;
8996: $quotatype = 'default';
8997: } else {
8998: $quotatype = 'custom';
8999: }
1.472 raeburn 9000: }
9001: }
1.536 raeburn 9002: if (wantarray) {
9003: return ($quota,$quotatype,$settingstatus,$defquota);
9004: } else {
9005: return $quota;
9006: }
1.472 raeburn 9007: }
9008:
9009: ###############################################
9010:
9011: =pod
9012:
9013: =item * &default_quota()
9014:
1.536 raeburn 9015: Retrieves default quota assigned for storage of user portfolio files,
9016: given an (optional) user's institutional status.
1.472 raeburn 9017:
9018: Incoming parameters:
1.1075.2.42 raeburn 9019:
1.472 raeburn 9020: 1. domain
1.536 raeburn 9021: 2. (Optional) institutional status(es). This is a : separated list of
9022: status types (e.g., faculty, staff, student etc.)
9023: which apply to the user for whom the default is being retrieved.
9024: If the institutional status string in undefined, the domain
1.1075.2.41 raeburn 9025: default quota will be returned.
9026: 3. quota name - portfolio, author, or course
9027: (if no quota name provided, defaults to portfolio).
1.472 raeburn 9028:
9029: Returns:
1.1075.2.42 raeburn 9030:
1.1075.2.58 raeburn 9031: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 9032: 2. (Optional) institutional type which determined the value of the
9033: default quota.
1.472 raeburn 9034:
9035: If a value has been stored in the domain's configuration db,
9036: it will return that, otherwise it returns 20 (for backwards
9037: compatibility with domains which have not set up a configuration
1.1075.2.58 raeburn 9038: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 9039:
1.536 raeburn 9040: If the user's status includes multiple types (e.g., staff and student),
9041: the largest default quota which applies to the user determines the
9042: default quota returned.
9043:
1.472 raeburn 9044: =cut
9045:
9046: ###############################################
9047:
9048:
9049: sub default_quota {
1.1075.2.41 raeburn 9050: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 9051: my ($defquota,$settingstatus);
9052: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 9053: ['quotas'],$udom);
1.1075.2.41 raeburn 9054: my $key = 'defaultquota';
9055: if ($quotaname eq 'author') {
9056: $key = 'authorquota';
9057: }
1.622 raeburn 9058: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 9059: if ($inststatus ne '') {
1.765 raeburn 9060: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 9061: foreach my $item (@statuses) {
1.1075.2.41 raeburn 9062: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9063: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 9064: if ($defquota eq '') {
1.1075.2.41 raeburn 9065: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9066: $settingstatus = $item;
1.1075.2.41 raeburn 9067: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
9068: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 9069: $settingstatus = $item;
9070: }
9071: }
1.1075.2.41 raeburn 9072: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9073: if ($quotahash{'quotas'}{$item} ne '') {
9074: if ($defquota eq '') {
9075: $defquota = $quotahash{'quotas'}{$item};
9076: $settingstatus = $item;
9077: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
9078: $defquota = $quotahash{'quotas'}{$item};
9079: $settingstatus = $item;
9080: }
1.536 raeburn 9081: }
9082: }
9083: }
9084: }
9085: if ($defquota eq '') {
1.1075.2.41 raeburn 9086: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
9087: $defquota = $quotahash{'quotas'}{$key}{'default'};
9088: } elsif ($key eq 'defaultquota') {
1.711 raeburn 9089: $defquota = $quotahash{'quotas'}{'default'};
9090: }
1.536 raeburn 9091: $settingstatus = 'default';
1.1075.2.42 raeburn 9092: if ($defquota eq '') {
9093: if ($quotaname eq 'author') {
9094: $defquota = 500;
9095: }
9096: }
1.536 raeburn 9097: }
9098: } else {
9099: $settingstatus = 'default';
1.1075.2.41 raeburn 9100: if ($quotaname eq 'author') {
9101: $defquota = 500;
9102: } else {
9103: $defquota = 20;
9104: }
1.536 raeburn 9105: }
9106: if (wantarray) {
9107: return ($defquota,$settingstatus);
1.472 raeburn 9108: } else {
1.536 raeburn 9109: return $defquota;
1.472 raeburn 9110: }
9111: }
9112:
1.1075.2.41 raeburn 9113: ###############################################
9114:
9115: =pod
9116:
1.1075.2.42 raeburn 9117: =item * &excess_filesize_warning()
1.1075.2.41 raeburn 9118:
9119: Returns warning message if upload of file to authoring space, or copying
1.1075.2.42 raeburn 9120: of existing file within authoring space will cause quota for the authoring
9121: space to be exceeded.
9122:
9123: Same, if upload of a file directly to a course/community via Course Editor
9124: will cause quota for uploaded content for the course to be exceeded.
1.1075.2.41 raeburn 9125:
1.1075.2.61 raeburn 9126: Inputs: 7
1.1075.2.42 raeburn 9127: 1. username or coursenum
1.1075.2.41 raeburn 9128: 2. domain
1.1075.2.42 raeburn 9129: 3. context ('author' or 'course')
1.1075.2.41 raeburn 9130: 4. filename of file for which action is being requested
9131: 5. filesize (kB) of file
9132: 6. action being taken: copy or upload.
1.1075.2.59 raeburn 9133: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1075.2.41 raeburn 9134:
9135: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
9136: otherwise return null.
9137:
1.1075.2.42 raeburn 9138: =back
9139:
1.1075.2.41 raeburn 9140: =cut
9141:
1.1075.2.42 raeburn 9142: sub excess_filesize_warning {
1.1075.2.59 raeburn 9143: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1075.2.42 raeburn 9144: my $current_disk_usage = 0;
1.1075.2.59 raeburn 9145: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1075.2.42 raeburn 9146: if ($context eq 'author') {
9147: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9148: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9149: } else {
9150: foreach my $subdir ('docs','supplemental') {
9151: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9152: }
9153: }
1.1075.2.41 raeburn 9154: $disk_quota = int($disk_quota * 1000);
9155: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1075.2.69 raeburn 9156: return '<p class="LC_warning">'.
1.1075.2.41 raeburn 9157: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1075.2.69 raeburn 9158: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9159: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1075.2.41 raeburn 9160: $disk_quota,$current_disk_usage).
9161: '</p>';
9162: }
9163: return;
9164: }
9165:
9166: ###############################################
9167:
9168:
1.384 raeburn 9169: sub get_secgrprole_info {
9170: my ($cdom,$cnum,$needroles,$type) = @_;
9171: my %sections_count = &get_sections($cdom,$cnum);
9172: my @sections = (sort {$a <=> $b} keys(%sections_count));
9173: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9174: my @groups = sort(keys(%curr_groups));
9175: my $allroles = [];
9176: my $rolehash;
9177: my $accesshash = {
9178: active => 'Currently has access',
9179: future => 'Will have future access',
9180: previous => 'Previously had access',
9181: };
9182: if ($needroles) {
9183: $rolehash = {'all' => 'all'};
1.385 albertel 9184: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9185: if (&Apache::lonnet::error(%user_roles)) {
9186: undef(%user_roles);
9187: }
9188: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9189: my ($role)=split(/\:/,$item,2);
9190: if ($role eq 'cr') { next; }
9191: if ($role =~ /^cr/) {
9192: $$rolehash{$role} = (split('/',$role))[3];
9193: } else {
9194: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9195: }
9196: }
9197: foreach my $key (sort(keys(%{$rolehash}))) {
9198: push(@{$allroles},$key);
9199: }
9200: push (@{$allroles},'st');
9201: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9202: }
9203: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9204: }
9205:
1.555 raeburn 9206: sub user_picker {
1.994 raeburn 9207: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9208: my $currdom = $dom;
9209: my %curr_selected = (
9210: srchin => 'dom',
1.580 raeburn 9211: srchby => 'lastname',
1.555 raeburn 9212: );
9213: my $srchterm;
1.625 raeburn 9214: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9215: if ($srch->{'srchby'} ne '') {
9216: $curr_selected{'srchby'} = $srch->{'srchby'};
9217: }
9218: if ($srch->{'srchin'} ne '') {
9219: $curr_selected{'srchin'} = $srch->{'srchin'};
9220: }
9221: if ($srch->{'srchtype'} ne '') {
9222: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9223: }
9224: if ($srch->{'srchdomain'} ne '') {
9225: $currdom = $srch->{'srchdomain'};
9226: }
9227: $srchterm = $srch->{'srchterm'};
9228: }
1.1075.2.98 raeburn 9229: my %html_lt=&Apache::lonlocal::texthash(
1.573 raeburn 9230: 'usr' => 'Search criteria',
1.563 raeburn 9231: 'doma' => 'Domain/institution to search',
1.558 albertel 9232: 'uname' => 'username',
9233: 'lastname' => 'last name',
1.555 raeburn 9234: 'lastfirst' => 'last name, first name',
1.558 albertel 9235: 'crs' => 'in this course',
1.576 raeburn 9236: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9237: 'alc' => 'all LON-CAPA',
1.573 raeburn 9238: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9239: 'exact' => 'is',
9240: 'contains' => 'contains',
1.569 raeburn 9241: 'begins' => 'begins with',
1.1075.2.98 raeburn 9242: );
9243: my %js_lt=&Apache::lonlocal::texthash(
1.571 raeburn 9244: 'youm' => "You must include some text to search for.",
9245: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9246: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9247: 'yomc' => "You must choose a domain when using an institutional directory search.",
9248: 'ymcd' => "You must choose a domain when using a domain search.",
9249: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9250: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9251: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9252: );
1.1075.2.98 raeburn 9253: &html_escape(\%html_lt);
9254: &js_escape(\%js_lt);
1.563 raeburn 9255: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9256: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9257:
9258: my @srchins = ('crs','dom','alc','instd');
9259:
9260: foreach my $option (@srchins) {
9261: # FIXME 'alc' option unavailable until
9262: # loncreateuser::print_user_query_page()
9263: # has been completed.
9264: next if ($option eq 'alc');
1.880 raeburn 9265: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9266: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9267: if ($curr_selected{'srchin'} eq $option) {
9268: $srchinsel .= '
1.1075.2.98 raeburn 9269: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.563 raeburn 9270: } else {
9271: $srchinsel .= '
1.1075.2.98 raeburn 9272: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.563 raeburn 9273: }
1.555 raeburn 9274: }
1.563 raeburn 9275: $srchinsel .= "\n </select>\n";
1.555 raeburn 9276:
9277: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9278: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9279: if ($curr_selected{'srchby'} eq $option) {
9280: $srchbysel .= '
1.1075.2.98 raeburn 9281: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9282: } else {
9283: $srchbysel .= '
1.1075.2.98 raeburn 9284: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9285: }
9286: }
9287: $srchbysel .= "\n </select>\n";
9288:
9289: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9290: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9291: if ($curr_selected{'srchtype'} eq $option) {
9292: $srchtypesel .= '
1.1075.2.98 raeburn 9293: <option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
1.555 raeburn 9294: } else {
9295: $srchtypesel .= '
1.1075.2.98 raeburn 9296: <option value="'.$option.'">'.$html_lt{$option}.'</option>';
1.555 raeburn 9297: }
9298: }
9299: $srchtypesel .= "\n </select>\n";
9300:
1.558 albertel 9301: my ($newuserscript,$new_user_create);
1.994 raeburn 9302: my $context_dom = $env{'request.role.domain'};
9303: if ($context eq 'requestcrs') {
9304: if ($env{'form.coursedom'} ne '') {
9305: $context_dom = $env{'form.coursedom'};
9306: }
9307: }
1.556 raeburn 9308: if ($forcenewuser) {
1.576 raeburn 9309: if (ref($srch) eq 'HASH') {
1.994 raeburn 9310: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9311: if ($cancreate) {
9312: $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>';
9313: } else {
1.799 bisitz 9314: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9315: my %usertypetext = (
9316: official => 'institutional',
9317: unofficial => 'non-institutional',
9318: );
1.799 bisitz 9319: $new_user_create = '<p class="LC_warning">'
9320: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9321: .' '
9322: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9323: ,'<a href="'.$helplink.'">','</a>')
9324: .'</p><br />';
1.627 raeburn 9325: }
1.576 raeburn 9326: }
9327: }
9328:
1.556 raeburn 9329: $newuserscript = <<"ENDSCRIPT";
9330:
1.570 raeburn 9331: function setSearch(createnew,callingForm) {
1.556 raeburn 9332: if (createnew == 1) {
1.570 raeburn 9333: for (var i=0; i<callingForm.srchby.length; i++) {
9334: if (callingForm.srchby.options[i].value == 'uname') {
9335: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9336: }
9337: }
1.570 raeburn 9338: for (var i=0; i<callingForm.srchin.length; i++) {
9339: if ( callingForm.srchin.options[i].value == 'dom') {
9340: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9341: }
9342: }
1.570 raeburn 9343: for (var i=0; i<callingForm.srchtype.length; i++) {
9344: if (callingForm.srchtype.options[i].value == 'exact') {
9345: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9346: }
9347: }
1.570 raeburn 9348: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9349: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9350: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9351: }
9352: }
9353: }
9354: }
9355: ENDSCRIPT
1.558 albertel 9356:
1.556 raeburn 9357: }
9358:
1.555 raeburn 9359: my $output = <<"END_BLOCK";
1.556 raeburn 9360: <script type="text/javascript">
1.824 bisitz 9361: // <![CDATA[
1.570 raeburn 9362: function validateEntry(callingForm) {
1.558 albertel 9363:
1.556 raeburn 9364: var checkok = 1;
1.558 albertel 9365: var srchin;
1.570 raeburn 9366: for (var i=0; i<callingForm.srchin.length; i++) {
9367: if ( callingForm.srchin[i].checked ) {
9368: srchin = callingForm.srchin[i].value;
1.558 albertel 9369: }
9370: }
9371:
1.570 raeburn 9372: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9373: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9374: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9375: var srchterm = callingForm.srchterm.value;
9376: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9377: var msg = "";
9378:
9379: if (srchterm == "") {
9380: checkok = 0;
1.1075.2.98 raeburn 9381: msg += "$js_lt{'youm'}\\n";
1.556 raeburn 9382: }
9383:
1.569 raeburn 9384: if (srchtype== 'begins') {
9385: if (srchterm.length < 2) {
9386: checkok = 0;
1.1075.2.98 raeburn 9387: msg += "$js_lt{'thte'}\\n";
1.569 raeburn 9388: }
9389: }
9390:
1.556 raeburn 9391: if (srchtype== 'contains') {
9392: if (srchterm.length < 3) {
9393: checkok = 0;
1.1075.2.98 raeburn 9394: msg += "$js_lt{'thet'}\\n";
1.556 raeburn 9395: }
9396: }
9397: if (srchin == 'instd') {
9398: if (srchdomain == '') {
9399: checkok = 0;
1.1075.2.98 raeburn 9400: msg += "$js_lt{'yomc'}\\n";
1.556 raeburn 9401: }
9402: }
9403: if (srchin == 'dom') {
9404: if (srchdomain == '') {
9405: checkok = 0;
1.1075.2.98 raeburn 9406: msg += "$js_lt{'ymcd'}\\n";
1.556 raeburn 9407: }
9408: }
9409: if (srchby == 'lastfirst') {
9410: if (srchterm.indexOf(",") == -1) {
9411: checkok = 0;
1.1075.2.98 raeburn 9412: msg += "$js_lt{'whus'}\\n";
1.556 raeburn 9413: }
9414: if (srchterm.indexOf(",") == srchterm.length -1) {
9415: checkok = 0;
1.1075.2.98 raeburn 9416: msg += "$js_lt{'whse'}\\n";
1.556 raeburn 9417: }
9418: }
9419: if (checkok == 0) {
1.1075.2.98 raeburn 9420: alert("$js_lt{'thfo'}\\n"+msg);
1.556 raeburn 9421: return;
9422: }
9423: if (checkok == 1) {
1.570 raeburn 9424: callingForm.submit();
1.556 raeburn 9425: }
9426: }
9427:
9428: $newuserscript
9429:
1.824 bisitz 9430: // ]]>
1.556 raeburn 9431: </script>
1.558 albertel 9432:
9433: $new_user_create
9434:
1.555 raeburn 9435: END_BLOCK
1.558 albertel 9436:
1.876 raeburn 9437: $output .= &Apache::lonhtmlcommon::start_pick_box().
1.1075.2.98 raeburn 9438: &Apache::lonhtmlcommon::row_title($html_lt{'doma'}).
1.876 raeburn 9439: $domform.
9440: &Apache::lonhtmlcommon::row_closure().
1.1075.2.98 raeburn 9441: &Apache::lonhtmlcommon::row_title($html_lt{'usr'}).
1.876 raeburn 9442: $srchbysel.
9443: $srchtypesel.
9444: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9445: $srchinsel.
9446: &Apache::lonhtmlcommon::row_closure(1).
9447: &Apache::lonhtmlcommon::end_pick_box().
9448: '<br />';
1.555 raeburn 9449: return $output;
9450: }
9451:
1.612 raeburn 9452: sub user_rule_check {
1.615 raeburn 9453: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.1075.2.99 raeburn 9454: my ($response,%inst_response);
1.612 raeburn 9455: if (ref($usershash) eq 'HASH') {
1.1075.2.99 raeburn 9456: if (keys(%{$usershash}) > 1) {
9457: my (%by_username,%by_id,%userdoms);
9458: my $checkid;
1.612 raeburn 9459: if (ref($checks) eq 'HASH') {
1.1075.2.99 raeburn 9460: if ((!defined($checks->{'username'})) && (defined($checks->{'id'}))) {
9461: $checkid = 1;
9462: }
9463: }
9464: foreach my $user (keys(%{$usershash})) {
9465: my ($uname,$udom) = split(/:/,$user);
9466: if ($checkid) {
9467: if (ref($usershash->{$user}) eq 'HASH') {
9468: if ($usershash->{$user}->{'id'} ne '') {
9469: $by_id{$udom}{$usershash->{$user}->{'id'}} = $uname;
9470: $userdoms{$udom} = 1;
9471: if (ref($inst_results) eq 'HASH') {
9472: $inst_results->{$uname.':'.$udom} = {};
9473: }
9474: }
9475: }
9476: } else {
9477: $by_username{$udom}{$uname} = 1;
9478: $userdoms{$udom} = 1;
9479: if (ref($inst_results) eq 'HASH') {
9480: $inst_results->{$uname.':'.$udom} = {};
9481: }
9482: }
9483: }
9484: foreach my $udom (keys(%userdoms)) {
9485: if (!$got_rules->{$udom}) {
9486: my %domconfig = &Apache::lonnet::get_dom('configuration',
9487: ['usercreation'],$udom);
9488: if (ref($domconfig{'usercreation'}) eq 'HASH') {
9489: foreach my $item ('username','id') {
9490: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9491: $$curr_rules{$udom}{$item} =
9492: $domconfig{'usercreation'}{$item.'_rule'};
9493: }
9494: }
9495: }
9496: $got_rules->{$udom} = 1;
9497: }
9498: }
9499: if ($checkid) {
9500: foreach my $udom (keys(%by_id)) {
9501: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_id{$udom},'id');
9502: if ($outcome eq 'ok') {
9503: foreach my $id (keys(%{$by_id{$udom}})) {
9504: my $uname = $by_id{$udom}{$id};
9505: $inst_response{$uname.':'.$udom} = $outcome;
9506: }
9507: if (ref($results) eq 'HASH') {
9508: foreach my $uname (keys(%{$results})) {
9509: if (exists($inst_response{$uname.':'.$udom})) {
9510: $inst_response{$uname.':'.$udom} = $outcome;
9511: $inst_results->{$uname.':'.$udom} = $results->{$uname};
9512: }
9513: }
9514: }
9515: }
1.612 raeburn 9516: }
1.615 raeburn 9517: } else {
1.1075.2.99 raeburn 9518: foreach my $udom (keys(%by_username)) {
9519: my ($outcome,$results) = &Apache::lonnet::get_multiple_instusers($udom,$by_username{$udom});
9520: if ($outcome eq 'ok') {
9521: foreach my $uname (keys(%{$by_username{$udom}})) {
9522: $inst_response{$uname.':'.$udom} = $outcome;
9523: }
9524: if (ref($results) eq 'HASH') {
9525: foreach my $uname (keys(%{$results})) {
9526: $inst_results->{$uname.':'.$udom} = $results->{$uname};
9527: }
9528: }
9529: }
9530: }
1.612 raeburn 9531: }
1.1075.2.99 raeburn 9532: } elsif (keys(%{$usershash}) == 1) {
9533: my $user = (keys(%{$usershash}))[0];
9534: my ($uname,$udom) = split(/:/,$user);
9535: if (($udom ne '') && ($uname ne '')) {
9536: if (ref($usershash->{$user}) eq 'HASH') {
9537: if (ref($checks) eq 'HASH') {
9538: if (defined($checks->{'username'})) {
9539: ($inst_response{$user},%{$inst_results->{$user}}) =
9540: &Apache::lonnet::get_instuser($udom,$uname);
9541: } elsif (defined($checks->{'id'})) {
9542: if ($usershash->{$user}->{'id'} ne '') {
9543: ($inst_response{$user},%{$inst_results->{$user}}) =
9544: &Apache::lonnet::get_instuser($udom,undef,
9545: $usershash->{$user}->{'id'});
9546: } else {
9547: ($inst_response{$user},%{$inst_results->{$user}}) =
9548: &Apache::lonnet::get_instuser($udom,$uname);
9549: }
9550: }
9551: } else {
9552: ($inst_response{$user},%{$inst_results->{$user}}) =
9553: &Apache::lonnet::get_instuser($udom,$uname);
9554: return;
9555: }
9556: if (!$got_rules->{$udom}) {
9557: my %domconfig = &Apache::lonnet::get_dom('configuration',
9558: ['usercreation'],$udom);
9559: if (ref($domconfig{'usercreation'}) eq 'HASH') {
9560: foreach my $item ('username','id') {
9561: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9562: $$curr_rules{$udom}{$item} =
9563: $domconfig{'usercreation'}{$item.'_rule'};
9564: }
9565: }
1.585 raeburn 9566: }
1.1075.2.99 raeburn 9567: $got_rules->{$udom} = 1;
1.585 raeburn 9568: }
9569: }
1.1075.2.99 raeburn 9570: } else {
9571: return;
9572: }
9573: } else {
9574: return;
9575: }
9576: foreach my $user (keys(%{$usershash})) {
9577: my ($uname,$udom) = split(/:/,$user);
9578: next if (($udom eq '') || ($uname eq ''));
9579: my $id;
9580: if (ref($inst_results) eq 'HASH') {
9581: if (ref($inst_results->{$user}) eq 'HASH') {
9582: $id = $inst_results->{$user}->{'id'};
9583: }
9584: }
9585: if ($id eq '') {
9586: if (ref($usershash->{$user})) {
9587: $id = $usershash->{$user}->{'id'};
9588: }
1.585 raeburn 9589: }
1.612 raeburn 9590: foreach my $item (keys(%{$checks})) {
9591: if (ref($$curr_rules{$udom}) eq 'HASH') {
9592: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9593: if (@{$$curr_rules{$udom}{$item}} > 0) {
1.1075.2.99 raeburn 9594: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,
9595: $$curr_rules{$udom}{$item});
1.612 raeburn 9596: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9597: if ($rule_check{$rule}) {
9598: $$rulematch{$user}{$item} = $rule;
1.1075.2.99 raeburn 9599: if ($inst_response{$user} eq 'ok') {
1.615 raeburn 9600: if (ref($inst_results) eq 'HASH') {
9601: if (ref($inst_results->{$user}) eq 'HASH') {
9602: if (keys(%{$inst_results->{$user}}) == 0) {
9603: $$alerts{$item}{$udom}{$uname} = 1;
1.1075.2.99 raeburn 9604: } elsif ($item eq 'id') {
9605: if ($inst_results->{$user}->{'id'} eq '') {
9606: $$alerts{$item}{$udom}{$uname} = 1;
9607: }
1.615 raeburn 9608: }
1.612 raeburn 9609: }
9610: }
1.615 raeburn 9611: }
9612: last;
1.585 raeburn 9613: }
9614: }
9615: }
9616: }
9617: }
9618: }
9619: }
9620: }
1.612 raeburn 9621: return;
9622: }
9623:
9624: sub user_rule_formats {
9625: my ($domain,$domdesc,$curr_rules,$check) = @_;
9626: my %text = (
9627: 'username' => 'Usernames',
9628: 'id' => 'IDs',
9629: );
9630: my $output;
9631: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9632: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9633: if (@{$ruleorder} > 0) {
1.1075.2.20 raeburn 9634: $output = '<br />'.
9635: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9636: '<span class="LC_cusr_emph">','</span>',$domdesc).
9637: ' <ul>';
1.612 raeburn 9638: foreach my $rule (@{$ruleorder}) {
9639: if (ref($curr_rules) eq 'ARRAY') {
9640: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9641: if (ref($rules->{$rule}) eq 'HASH') {
9642: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9643: $rules->{$rule}{'desc'}.'</li>';
9644: }
9645: }
9646: }
9647: }
9648: $output .= '</ul>';
9649: }
9650: }
9651: return $output;
9652: }
9653:
9654: sub instrule_disallow_msg {
1.615 raeburn 9655: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9656: my $response;
9657: my %text = (
9658: item => 'username',
9659: items => 'usernames',
9660: match => 'matches',
9661: do => 'does',
9662: action => 'a username',
9663: one => 'one',
9664: );
9665: if ($count > 1) {
9666: $text{'item'} = 'usernames';
9667: $text{'match'} ='match';
9668: $text{'do'} = 'do';
9669: $text{'action'} = 'usernames',
9670: $text{'one'} = 'ones';
9671: }
9672: if ($checkitem eq 'id') {
9673: $text{'items'} = 'IDs';
9674: $text{'item'} = 'ID';
9675: $text{'action'} = 'an ID';
1.615 raeburn 9676: if ($count > 1) {
9677: $text{'item'} = 'IDs';
9678: $text{'action'} = 'IDs';
9679: }
1.612 raeburn 9680: }
1.674 bisitz 9681: $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 9682: if ($mode eq 'upload') {
9683: if ($checkitem eq 'username') {
9684: $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'}.");
9685: } elsif ($checkitem eq 'id') {
1.674 bisitz 9686: $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 9687: }
1.669 raeburn 9688: } elsif ($mode eq 'selfcreate') {
9689: if ($checkitem eq 'id') {
9690: $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.");
9691: }
1.615 raeburn 9692: } else {
9693: if ($checkitem eq 'username') {
9694: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9695: } elsif ($checkitem eq 'id') {
9696: $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.");
9697: }
1.612 raeburn 9698: }
9699: return $response;
1.585 raeburn 9700: }
9701:
1.624 raeburn 9702: sub personal_data_fieldtitles {
9703: my %fieldtitles = &Apache::lonlocal::texthash (
9704: id => 'Student/Employee ID',
9705: permanentemail => 'E-mail address',
9706: lastname => 'Last Name',
9707: firstname => 'First Name',
9708: middlename => 'Middle Name',
9709: generation => 'Generation',
9710: gen => 'Generation',
1.765 raeburn 9711: inststatus => 'Affiliation',
1.624 raeburn 9712: );
9713: return %fieldtitles;
9714: }
9715:
1.642 raeburn 9716: sub sorted_inst_types {
9717: my ($dom) = @_;
1.1075.2.70 raeburn 9718: my ($usertypes,$order);
9719: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9720: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9721: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9722: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9723: } else {
9724: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9725: }
1.642 raeburn 9726: my $othertitle = &mt('All users');
9727: if ($env{'request.course.id'}) {
1.668 raeburn 9728: $othertitle = &mt('Any users');
1.642 raeburn 9729: }
9730: my @types;
9731: if (ref($order) eq 'ARRAY') {
9732: @types = @{$order};
9733: }
9734: if (@types == 0) {
9735: if (ref($usertypes) eq 'HASH') {
9736: @types = sort(keys(%{$usertypes}));
9737: }
9738: }
9739: if (keys(%{$usertypes}) > 0) {
9740: $othertitle = &mt('Other users');
9741: }
9742: return ($othertitle,$usertypes,\@types);
9743: }
9744:
1.645 raeburn 9745: sub get_institutional_codes {
9746: my ($settings,$allcourses,$LC_code) = @_;
9747: # Get complete list of course sections to update
9748: my @currsections = ();
9749: my @currxlists = ();
9750: my $coursecode = $$settings{'internal.coursecode'};
9751:
9752: if ($$settings{'internal.sectionnums'} ne '') {
9753: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9754: }
9755:
9756: if ($$settings{'internal.crosslistings'} ne '') {
9757: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9758: }
9759:
9760: if (@currxlists > 0) {
9761: foreach (@currxlists) {
9762: if (m/^([^:]+):(\w*)$/) {
9763: unless (grep/^$1$/,@{$allcourses}) {
9764: push @{$allcourses},$1;
9765: $$LC_code{$1} = $2;
9766: }
9767: }
9768: }
9769: }
9770:
9771: if (@currsections > 0) {
9772: foreach (@currsections) {
9773: if (m/^(\w+):(\w*)$/) {
9774: my $sec = $coursecode.$1;
9775: my $lc_sec = $2;
9776: unless (grep/^$sec$/,@{$allcourses}) {
9777: push @{$allcourses},$sec;
9778: $$LC_code{$sec} = $lc_sec;
9779: }
9780: }
9781: }
9782: }
9783: return;
9784: }
9785:
1.971 raeburn 9786: sub get_standard_codeitems {
9787: return ('Year','Semester','Department','Number','Section');
9788: }
9789:
1.112 bowersj2 9790: =pod
9791:
1.780 raeburn 9792: =head1 Slot Helpers
9793:
9794: =over 4
9795:
9796: =item * sorted_slots()
9797:
1.1040 raeburn 9798: Sorts an array of slot names in order of an optional sort key,
9799: default sort is by slot start time (earliest first).
1.780 raeburn 9800:
9801: Inputs:
9802:
9803: =over 4
9804:
9805: slotsarr - Reference to array of unsorted slot names.
9806:
9807: slots - Reference to hash of hash, where outer hash keys are slot names.
9808:
1.1040 raeburn 9809: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9810:
1.549 albertel 9811: =back
9812:
1.780 raeburn 9813: Returns:
9814:
9815: =over 4
9816:
1.1040 raeburn 9817: sorted - An array of slot names sorted by a specified sort key
9818: (default sort key is start time of the slot).
1.780 raeburn 9819:
9820: =back
9821:
9822: =cut
9823:
9824:
9825: sub sorted_slots {
1.1040 raeburn 9826: my ($slotsarr,$slots,$sortkey) = @_;
9827: if ($sortkey eq '') {
9828: $sortkey = 'starttime';
9829: }
1.780 raeburn 9830: my @sorted;
9831: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9832: @sorted =
9833: sort {
9834: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9835: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9836: }
9837: if (ref($slots->{$a})) { return -1;}
9838: if (ref($slots->{$b})) { return 1;}
9839: return 0;
9840: } @{$slotsarr};
9841: }
9842: return @sorted;
9843: }
9844:
1.1040 raeburn 9845: =pod
9846:
9847: =item * get_future_slots()
9848:
9849: Inputs:
9850:
9851: =over 4
9852:
9853: cnum - course number
9854:
9855: cdom - course domain
9856:
9857: now - current UNIX time
9858:
9859: symb - optional symb
9860:
9861: =back
9862:
9863: Returns:
9864:
9865: =over 4
9866:
9867: sorted_reservable - ref to array of student_schedulable slots currently
9868: reservable, ordered by end date of reservation period.
9869:
9870: reservable_now - ref to hash of student_schedulable slots currently
9871: reservable.
9872:
9873: Keys in inner hash are:
9874: (a) symb: either blank or symb to which slot use is restricted.
1.1075.2.104! raeburn 9875: (b) endreserve: end date of reservation period.
! 9876: (c) uniqueperiod: start,end dates when slot is to be uniquely
! 9877: selected.
1.1040 raeburn 9878:
9879: sorted_future - ref to array of student_schedulable slots reservable in
9880: the future, ordered by start date of reservation period.
9881:
9882: future_reservable - ref to hash of student_schedulable slots reservable
9883: in the future.
9884:
9885: Keys in inner hash are:
9886: (a) symb: either blank or symb to which slot use is restricted.
9887: (b) startreserve: start date of reservation period.
1.1075.2.104! raeburn 9888: (c) uniqueperiod: start,end dates when slot is to be uniquely
! 9889: selected.
1.1040 raeburn 9890:
9891: =back
9892:
9893: =cut
9894:
9895: sub get_future_slots {
9896: my ($cnum,$cdom,$now,$symb) = @_;
9897: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9898: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9899: foreach my $slot (keys(%slots)) {
9900: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9901: if ($symb) {
9902: next if (($slots{$slot}->{'symb'} ne '') &&
9903: ($slots{$slot}->{'symb'} ne $symb));
9904: }
9905: if (($slots{$slot}->{'starttime'} > $now) &&
9906: ($slots{$slot}->{'endtime'} > $now)) {
9907: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9908: my $userallowed = 0;
9909: if ($slots{$slot}->{'allowedsections'}) {
9910: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9911: if (!defined($env{'request.role.sec'})
9912: && grep(/^No section assigned$/,@allowed_sec)) {
9913: $userallowed=1;
9914: } else {
9915: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9916: $userallowed=1;
9917: }
9918: }
9919: unless ($userallowed) {
9920: if (defined($env{'request.course.groups'})) {
9921: my @groups = split(/:/,$env{'request.course.groups'});
9922: foreach my $group (@groups) {
9923: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9924: $userallowed=1;
9925: last;
9926: }
9927: }
9928: }
9929: }
9930: }
9931: if ($slots{$slot}->{'allowedusers'}) {
9932: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9933: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9934: if (grep(/^\Q$user\E$/,@allowed_users)) {
9935: $userallowed = 1;
9936: }
9937: }
9938: next unless($userallowed);
9939: }
9940: my $startreserve = $slots{$slot}->{'startreserve'};
9941: my $endreserve = $slots{$slot}->{'endreserve'};
9942: my $symb = $slots{$slot}->{'symb'};
1.1075.2.104! raeburn 9943: my $uniqueperiod;
! 9944: if (ref($slots{$slot}->{'uniqueperiod'}) eq 'ARRAY') {
! 9945: $uniqueperiod = join(',',@{$slots{$slot}->{'uniqueperiod'}});
! 9946: }
1.1040 raeburn 9947: if (($startreserve < $now) &&
9948: (!$endreserve || $endreserve > $now)) {
9949: my $lastres = $endreserve;
9950: if (!$lastres) {
9951: $lastres = $slots{$slot}->{'starttime'};
9952: }
9953: $reservable_now{$slot} = {
9954: symb => $symb,
1.1075.2.104! raeburn 9955: endreserve => $lastres,
! 9956: uniqueperiod => $uniqueperiod,
1.1040 raeburn 9957: };
9958: } elsif (($startreserve > $now) &&
9959: (!$endreserve || $endreserve > $startreserve)) {
9960: $future_reservable{$slot} = {
9961: symb => $symb,
1.1075.2.104! raeburn 9962: startreserve => $startreserve,
! 9963: uniqueperiod => $uniqueperiod,
1.1040 raeburn 9964: };
9965: }
9966: }
9967: }
9968: my @unsorted_reservable = keys(%reservable_now);
9969: if (@unsorted_reservable > 0) {
9970: @sorted_reservable =
9971: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9972: }
9973: my @unsorted_future = keys(%future_reservable);
9974: if (@unsorted_future > 0) {
9975: @sorted_future =
9976: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9977: }
9978: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9979: }
1.780 raeburn 9980:
9981: =pod
9982:
1.1057 foxr 9983: =back
9984:
1.549 albertel 9985: =head1 HTTP Helpers
9986:
9987: =over 4
9988:
1.648 raeburn 9989: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9990:
1.258 albertel 9991: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9992: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9993: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9994:
9995: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9996: $possible_names is an ref to an array of form element names. As an example:
9997: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9998: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9999:
10000: =cut
1.1 albertel 10001:
1.6 albertel 10002: sub get_unprocessed_cgi {
1.25 albertel 10003: my ($query,$possible_names)= @_;
1.26 matthew 10004: # $Apache::lonxml::debug=1;
1.356 albertel 10005: foreach my $pair (split(/&/,$query)) {
10006: my ($name, $value) = split(/=/,$pair);
1.369 www 10007: $name = &unescape($name);
1.25 albertel 10008: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
10009: $value =~ tr/+/ /;
10010: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10011: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10012: }
1.16 harris41 10013: }
1.6 albertel 10014: }
10015:
1.112 bowersj2 10016: =pod
10017:
1.648 raeburn 10018: =item * &cacheheader()
1.112 bowersj2 10019:
10020: returns cache-controlling header code
10021:
10022: =cut
10023:
1.7 albertel 10024: sub cacheheader {
1.258 albertel 10025: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10026: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10027: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10028: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10029: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10030: return $output;
1.7 albertel 10031: }
10032:
1.112 bowersj2 10033: =pod
10034:
1.648 raeburn 10035: =item * &no_cache($r)
1.112 bowersj2 10036:
10037: specifies header code to not have cache
10038:
10039: =cut
10040:
1.9 albertel 10041: sub no_cache {
1.216 albertel 10042: my ($r) = @_;
10043: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10044: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10045: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10046: $r->no_cache(1);
10047: $r->header_out("Expires" => $date);
10048: $r->header_out("Pragma" => "no-cache");
1.123 www 10049: }
10050:
10051: sub content_type {
1.181 albertel 10052: my ($r,$type,$charset) = @_;
1.299 foxr 10053: if ($r) {
10054: # Note that printout.pl calls this with undef for $r.
10055: &no_cache($r);
10056: }
1.258 albertel 10057: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10058: unless ($charset) {
10059: $charset=&Apache::lonlocal::current_encoding;
10060: }
10061: if ($charset) { $type.='; charset='.$charset; }
10062: if ($r) {
10063: $r->content_type($type);
10064: } else {
10065: print("Content-type: $type\n\n");
10066: }
1.9 albertel 10067: }
1.25 albertel 10068:
1.112 bowersj2 10069: =pod
10070:
1.648 raeburn 10071: =item * &add_to_env($name,$value)
1.112 bowersj2 10072:
1.258 albertel 10073: adds $name to the %env hash with value
1.112 bowersj2 10074: $value, if $name already exists, the entry is converted to an array
10075: reference and $value is added to the array.
10076:
10077: =cut
10078:
1.25 albertel 10079: sub add_to_env {
10080: my ($name,$value)=@_;
1.258 albertel 10081: if (defined($env{$name})) {
10082: if (ref($env{$name})) {
1.25 albertel 10083: #already have multiple values
1.258 albertel 10084: push(@{ $env{$name} },$value);
1.25 albertel 10085: } else {
10086: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10087: my $first=$env{$name};
10088: undef($env{$name});
10089: push(@{ $env{$name} },$first,$value);
1.25 albertel 10090: }
10091: } else {
1.258 albertel 10092: $env{$name}=$value;
1.25 albertel 10093: }
1.31 albertel 10094: }
1.149 albertel 10095:
10096: =pod
10097:
1.648 raeburn 10098: =item * &get_env_multiple($name)
1.149 albertel 10099:
1.258 albertel 10100: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10101: values may be defined and end up as an array ref.
10102:
10103: returns an array of values
10104:
10105: =cut
10106:
10107: sub get_env_multiple {
10108: my ($name) = @_;
10109: my @values;
1.258 albertel 10110: if (defined($env{$name})) {
1.149 albertel 10111: # exists is it an array
1.258 albertel 10112: if (ref($env{$name})) {
10113: @values=@{ $env{$name} };
1.149 albertel 10114: } else {
1.258 albertel 10115: $values[0]=$env{$name};
1.149 albertel 10116: }
10117: }
10118: return(@values);
10119: }
10120:
1.660 raeburn 10121: sub ask_for_embedded_content {
10122: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10123: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 10124: %currsubfile,%unused,$rem);
1.1071 raeburn 10125: my $counter = 0;
10126: my $numnew = 0;
1.987 raeburn 10127: my $numremref = 0;
10128: my $numinvalid = 0;
10129: my $numpathchg = 0;
10130: my $numexisting = 0;
1.1071 raeburn 10131: my $numunused = 0;
10132: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 10133: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10134: my $heading = &mt('Upload embedded files');
10135: my $buttontext = &mt('Upload');
10136:
1.1075.2.11 raeburn 10137: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 10138: if ($actionurl eq '/adm/dependencies') {
10139: $navmap = Apache::lonnavmaps::navmap->new();
10140: }
10141: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10142: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 10143: }
1.1075.2.35 raeburn 10144: if (($actionurl eq '/adm/portfolio') ||
10145: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10146: my $current_path='/';
10147: if ($env{'form.currentpath'}) {
10148: $current_path = $env{'form.currentpath'};
10149: }
10150: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 10151: $udom = $cdom;
10152: $uname = $cnum;
1.984 raeburn 10153: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10154: } else {
10155: $udom = $env{'user.domain'};
10156: $uname = $env{'user.name'};
10157: $url = '/userfiles/portfolio';
10158: }
1.987 raeburn 10159: $toplevel = $url.'/';
1.984 raeburn 10160: $url .= $current_path;
10161: $getpropath = 1;
1.987 raeburn 10162: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10163: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10164: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10165: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10166: $toplevel = $url;
1.984 raeburn 10167: if ($rest ne '') {
1.987 raeburn 10168: $url .= $rest;
10169: }
10170: } elsif ($actionurl eq '/adm/coursedocs') {
10171: if (ref($args) eq 'HASH') {
1.1071 raeburn 10172: $url = $args->{'docs_url'};
10173: $toplevel = $url;
1.1075.2.11 raeburn 10174: if ($args->{'context'} eq 'paste') {
10175: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10176: ($path) =
10177: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10178: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10179: $fileloc =~ s{^/}{};
10180: }
1.1071 raeburn 10181: }
10182: } elsif ($actionurl eq '/adm/dependencies') {
10183: if ($env{'request.course.id'} ne '') {
10184: if (ref($args) eq 'HASH') {
10185: $url = $args->{'docs_url'};
10186: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 10187: $toplevel = $url;
10188: unless ($toplevel =~ m{^/}) {
10189: $toplevel = "/$url";
10190: }
1.1075.2.11 raeburn 10191: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 10192: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10193: $path = $1;
10194: } else {
10195: ($path) =
10196: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10197: }
1.1075.2.79 raeburn 10198: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10199: $fileloc = $toplevel;
10200: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10201: my ($udom,$uname,$fname) =
10202: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10203: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10204: } else {
10205: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10206: }
1.1071 raeburn 10207: $fileloc =~ s{^/}{};
10208: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10209: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10210: }
1.987 raeburn 10211: }
1.1075.2.35 raeburn 10212: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10213: $udom = $cdom;
10214: $uname = $cnum;
10215: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10216: $toplevel = $url;
10217: $path = $url;
10218: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10219: $fileloc =~ s{^/}{};
10220: }
10221: foreach my $file (keys(%{$allfiles})) {
10222: my $embed_file;
10223: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10224: $embed_file = $1;
10225: } else {
10226: $embed_file = $file;
10227: }
1.1075.2.55 raeburn 10228: my ($absolutepath,$cleaned_file);
10229: if ($embed_file =~ m{^\w+://}) {
10230: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 10231: $newfiles{$cleaned_file} = 1;
10232: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10233: } else {
1.1075.2.55 raeburn 10234: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10235: if ($embed_file =~ m{^/}) {
10236: $absolutepath = $embed_file;
10237: }
1.1075.2.47 raeburn 10238: if ($cleaned_file =~ m{/}) {
10239: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10240: $path = &check_for_traversal($path,$url,$toplevel);
10241: my $item = $fname;
10242: if ($path ne '') {
10243: $item = $path.'/'.$fname;
10244: $subdependencies{$path}{$fname} = 1;
10245: } else {
10246: $dependencies{$item} = 1;
10247: }
10248: if ($absolutepath) {
10249: $mapping{$item} = $absolutepath;
10250: } else {
10251: $mapping{$item} = $embed_file;
10252: }
10253: } else {
10254: $dependencies{$embed_file} = 1;
10255: if ($absolutepath) {
1.1075.2.47 raeburn 10256: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10257: } else {
1.1075.2.47 raeburn 10258: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10259: }
10260: }
1.984 raeburn 10261: }
10262: }
1.1071 raeburn 10263: my $dirptr = 16384;
1.984 raeburn 10264: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10265: $currsubfile{$path} = {};
1.1075.2.35 raeburn 10266: if (($actionurl eq '/adm/portfolio') ||
10267: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10268: my ($sublistref,$listerror) =
10269: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10270: if (ref($sublistref) eq 'ARRAY') {
10271: foreach my $line (@{$sublistref}) {
10272: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10273: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10274: }
1.984 raeburn 10275: }
1.987 raeburn 10276: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10277: if (opendir(my $dir,$url.'/'.$path)) {
10278: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10279: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10280: }
1.1075.2.11 raeburn 10281: } elsif (($actionurl eq '/adm/dependencies') ||
10282: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10283: ($args->{'context'} eq 'paste')) ||
10284: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10285: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 10286: my $dir;
10287: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10288: $dir = $fileloc;
10289: } else {
10290: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10291: }
1.1071 raeburn 10292: if ($dir ne '') {
10293: my ($sublistref,$listerror) =
10294: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10295: if (ref($sublistref) eq 'ARRAY') {
10296: foreach my $line (@{$sublistref}) {
10297: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10298: undef,$mtime)=split(/\&/,$line,12);
10299: unless (($testdir&$dirptr) ||
10300: ($file_name =~ /^\.\.?$/)) {
10301: $currsubfile{$path}{$file_name} = [$size,$mtime];
10302: }
10303: }
10304: }
10305: }
1.984 raeburn 10306: }
10307: }
10308: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10309: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10310: my $item = $path.'/'.$file;
10311: unless ($mapping{$item} eq $item) {
10312: $pathchanges{$item} = 1;
10313: }
10314: $existing{$item} = 1;
10315: $numexisting ++;
10316: } else {
10317: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10318: }
10319: }
1.1071 raeburn 10320: if ($actionurl eq '/adm/dependencies') {
10321: foreach my $path (keys(%currsubfile)) {
10322: if (ref($currsubfile{$path}) eq 'HASH') {
10323: foreach my $file (keys(%{$currsubfile{$path}})) {
10324: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 10325: next if (($rem ne '') &&
10326: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10327: (ref($navmap) &&
10328: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10329: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10330: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10331: $unused{$path.'/'.$file} = 1;
10332: }
10333: }
10334: }
10335: }
10336: }
1.984 raeburn 10337: }
1.987 raeburn 10338: my %currfile;
1.1075.2.35 raeburn 10339: if (($actionurl eq '/adm/portfolio') ||
10340: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10341: my ($dirlistref,$listerror) =
10342: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10343: if (ref($dirlistref) eq 'ARRAY') {
10344: foreach my $line (@{$dirlistref}) {
10345: my ($file_name,$rest) = split(/\&/,$line,2);
10346: $currfile{$file_name} = 1;
10347: }
1.984 raeburn 10348: }
1.987 raeburn 10349: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10350: if (opendir(my $dir,$url)) {
1.987 raeburn 10351: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10352: map {$currfile{$_} = 1;} @dir_list;
10353: }
1.1075.2.11 raeburn 10354: } elsif (($actionurl eq '/adm/dependencies') ||
10355: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10356: ($args->{'context'} eq 'paste')) ||
10357: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10358: if ($env{'request.course.id'} ne '') {
10359: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10360: if ($dir ne '') {
10361: my ($dirlistref,$listerror) =
10362: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10363: if (ref($dirlistref) eq 'ARRAY') {
10364: foreach my $line (@{$dirlistref}) {
10365: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10366: $size,undef,$mtime)=split(/\&/,$line,12);
10367: unless (($testdir&$dirptr) ||
10368: ($file_name =~ /^\.\.?$/)) {
10369: $currfile{$file_name} = [$size,$mtime];
10370: }
10371: }
10372: }
10373: }
10374: }
1.984 raeburn 10375: }
10376: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10377: if (exists($currfile{$file})) {
1.987 raeburn 10378: unless ($mapping{$file} eq $file) {
10379: $pathchanges{$file} = 1;
10380: }
10381: $existing{$file} = 1;
10382: $numexisting ++;
10383: } else {
1.984 raeburn 10384: $newfiles{$file} = 1;
10385: }
10386: }
1.1071 raeburn 10387: foreach my $file (keys(%currfile)) {
10388: unless (($file eq $filename) ||
10389: ($file eq $filename.'.bak') ||
10390: ($dependencies{$file})) {
1.1075.2.11 raeburn 10391: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 10392: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10393: next if (($rem ne '') &&
10394: (($env{"httpref.$rem".$file} ne '') ||
10395: (ref($navmap) &&
10396: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10397: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10398: ($navmap->getResourceByUrl($rem.$1)))))));
10399: }
1.1075.2.11 raeburn 10400: }
1.1071 raeburn 10401: $unused{$file} = 1;
10402: }
10403: }
1.1075.2.11 raeburn 10404: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10405: ($args->{'context'} eq 'paste')) {
10406: $counter = scalar(keys(%existing));
10407: $numpathchg = scalar(keys(%pathchanges));
10408: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 10409: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10410: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10411: $counter = scalar(keys(%existing));
10412: $numpathchg = scalar(keys(%pathchanges));
10413: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 10414: }
1.984 raeburn 10415: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10416: if ($actionurl eq '/adm/dependencies') {
10417: next if ($embed_file =~ m{^\w+://});
10418: }
1.660 raeburn 10419: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10420: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10421: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10422: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 10423: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10424: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10425: }
1.1075.2.35 raeburn 10426: $upload_output .= '</td>';
1.1071 raeburn 10427: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 10428: $upload_output.='<td align="right">'.
10429: '<span class="LC_info LC_fontsize_medium">'.
10430: &mt("URL points to web address").'</span>';
1.987 raeburn 10431: $numremref++;
1.660 raeburn 10432: } elsif ($args->{'error_on_invalid_names'}
10433: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 10434: $upload_output.='<td align="right"><span class="LC_warning">'.
10435: &mt('Invalid characters').'</span>';
1.987 raeburn 10436: $numinvalid++;
1.660 raeburn 10437: } else {
1.1075.2.35 raeburn 10438: $upload_output .= '<td>'.
10439: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10440: $embed_file,\%mapping,
1.1071 raeburn 10441: $allfiles,$codebase,'upload');
10442: $counter ++;
10443: $numnew ++;
1.987 raeburn 10444: }
10445: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10446: }
10447: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10448: if ($actionurl eq '/adm/dependencies') {
10449: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10450: $modify_output .= &start_data_table_row().
10451: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10452: '<img src="'.&icon($embed_file).'" border="0" />'.
10453: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10454: '<td>'.$size.'</td>'.
10455: '<td>'.$mtime.'</td>'.
10456: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10457: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10458: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10459: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10460: &embedded_file_element('upload_embedded',$counter,
10461: $embed_file,\%mapping,
10462: $allfiles,$codebase,'modify').
10463: '</div></td>'.
10464: &end_data_table_row()."\n";
10465: $counter ++;
10466: } else {
10467: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10468: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10469: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10470: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10471: &Apache::loncommon::end_data_table_row()."\n";
10472: }
10473: }
10474: my $delidx = $counter;
10475: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10476: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10477: $delete_output .= &start_data_table_row().
10478: '<td><img src="'.&icon($oldfile).'" />'.
10479: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10480: '<td>'.$size.'</td>'.
10481: '<td>'.$mtime.'</td>'.
10482: '<td><label><input type="checkbox" name="del_upload_dep" '.
10483: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10484: &embedded_file_element('upload_embedded',$delidx,
10485: $oldfile,\%mapping,$allfiles,
10486: $codebase,'delete').'</td>'.
10487: &end_data_table_row()."\n";
10488: $numunused ++;
10489: $delidx ++;
1.987 raeburn 10490: }
10491: if ($upload_output) {
10492: $upload_output = &start_data_table().
10493: $upload_output.
10494: &end_data_table()."\n";
10495: }
1.1071 raeburn 10496: if ($modify_output) {
10497: $modify_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('Upload replacement?').'</th>'.
10503: &end_data_table_header_row().
10504: $modify_output.
10505: &end_data_table()."\n";
10506: }
10507: if ($delete_output) {
10508: $delete_output = &start_data_table().
10509: &start_data_table_header_row().
10510: '<th>'.&mt('File').'</th>'.
10511: '<th>'.&mt('Size (KB)').'</th>'.
10512: '<th>'.&mt('Modified').'</th>'.
10513: '<th>'.&mt('Delete?').'</th>'.
10514: &end_data_table_header_row().
10515: $delete_output.
10516: &end_data_table()."\n";
10517: }
1.987 raeburn 10518: my $applies = 0;
10519: if ($numremref) {
10520: $applies ++;
10521: }
10522: if ($numinvalid) {
10523: $applies ++;
10524: }
10525: if ($numexisting) {
10526: $applies ++;
10527: }
1.1071 raeburn 10528: if ($counter || $numunused) {
1.987 raeburn 10529: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10530: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10531: $state.'<h3>'.$heading.'</h3>';
10532: if ($actionurl eq '/adm/dependencies') {
10533: if ($numnew) {
10534: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10535: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10536: $upload_output.'<br />'."\n";
10537: }
10538: if ($numexisting) {
10539: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10540: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10541: $modify_output.'<br />'."\n";
10542: $buttontext = &mt('Save changes');
10543: }
10544: if ($numunused) {
10545: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10546: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10547: $delete_output.'<br />'."\n";
10548: $buttontext = &mt('Save changes');
10549: }
10550: } else {
10551: $output .= $upload_output.'<br />'."\n";
10552: }
10553: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10554: $counter.'" />'."\n";
10555: if ($actionurl eq '/adm/dependencies') {
10556: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10557: $numnew.'" />'."\n";
10558: } elsif ($actionurl eq '') {
1.987 raeburn 10559: $output .= '<input type="hidden" name="phase" value="three" />';
10560: }
10561: } elsif ($applies) {
10562: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10563: if ($applies > 1) {
10564: $output .=
1.1075.2.35 raeburn 10565: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10566: if ($numremref) {
10567: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10568: }
10569: if ($numinvalid) {
10570: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10571: }
10572: if ($numexisting) {
10573: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10574: }
10575: $output .= '</ul><br />';
10576: } elsif ($numremref) {
10577: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10578: } elsif ($numinvalid) {
10579: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10580: } elsif ($numexisting) {
10581: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10582: }
10583: $output .= $upload_output.'<br />';
10584: }
10585: my ($pathchange_output,$chgcount);
1.1071 raeburn 10586: $chgcount = $counter;
1.987 raeburn 10587: if (keys(%pathchanges) > 0) {
10588: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10589: if ($counter) {
1.987 raeburn 10590: $output .= &embedded_file_element('pathchange',$chgcount,
10591: $embed_file,\%mapping,
1.1071 raeburn 10592: $allfiles,$codebase,'change');
1.987 raeburn 10593: } else {
10594: $pathchange_output .=
10595: &start_data_table_row().
10596: '<td><input type ="checkbox" name="namechange" value="'.
10597: $chgcount.'" checked="checked" /></td>'.
10598: '<td>'.$mapping{$embed_file}.'</td>'.
10599: '<td>'.$embed_file.
10600: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10601: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10602: '</td>'.&end_data_table_row();
1.660 raeburn 10603: }
1.987 raeburn 10604: $numpathchg ++;
10605: $chgcount ++;
1.660 raeburn 10606: }
10607: }
1.1075.2.35 raeburn 10608: if (($counter) || ($numunused)) {
1.987 raeburn 10609: if ($numpathchg) {
10610: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10611: $numpathchg.'" />'."\n";
10612: }
10613: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10614: ($actionurl eq '/adm/imsimport')) {
10615: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10616: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10617: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10618: } elsif ($actionurl eq '/adm/dependencies') {
10619: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10620: }
1.1075.2.35 raeburn 10621: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10622: } elsif ($numpathchg) {
10623: my %pathchange = ();
10624: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10625: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10626: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 10627: }
1.987 raeburn 10628: }
1.1071 raeburn 10629: return ($output,$counter,$numpathchg);
1.987 raeburn 10630: }
10631:
1.1075.2.47 raeburn 10632: =pod
10633:
10634: =item * clean_path($name)
10635:
10636: Performs clean-up of directories, subdirectories and filename in an
10637: embedded object, referenced in an HTML file which is being uploaded
10638: to a course or portfolio, where
10639: "Upload embedded images/multimedia files if HTML file" checkbox was
10640: checked.
10641:
10642: Clean-up is similar to replacements in lonnet::clean_filename()
10643: except each / between sub-directory and next level is preserved.
10644:
10645: =cut
10646:
10647: sub clean_path {
10648: my ($embed_file) = @_;
10649: $embed_file =~s{^/+}{};
10650: my @contents;
10651: if ($embed_file =~ m{/}) {
10652: @contents = split(/\//,$embed_file);
10653: } else {
10654: @contents = ($embed_file);
10655: }
10656: my $lastidx = scalar(@contents)-1;
10657: for (my $i=0; $i<=$lastidx; $i++) {
10658: $contents[$i]=~s{\\}{/}g;
10659: $contents[$i]=~s/\s+/\_/g;
10660: $contents[$i]=~s{[^/\w\.\-]}{}g;
10661: if ($i == $lastidx) {
10662: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10663: }
10664: }
10665: if ($lastidx > 0) {
10666: return join('/',@contents);
10667: } else {
10668: return $contents[0];
10669: }
10670: }
10671:
1.987 raeburn 10672: sub embedded_file_element {
1.1071 raeburn 10673: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10674: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10675: (ref($codebase) eq 'HASH'));
10676: my $output;
1.1071 raeburn 10677: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10678: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10679: }
10680: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10681: &escape($embed_file).'" />';
10682: unless (($context eq 'upload_embedded') &&
10683: ($mapping->{$embed_file} eq $embed_file)) {
10684: $output .='
10685: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10686: }
10687: my $attrib;
10688: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10689: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10690: }
10691: $output .=
10692: "\n\t\t".
10693: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10694: $attrib.'" />';
10695: if (exists($codebase->{$mapping->{$embed_file}})) {
10696: $output .=
10697: "\n\t\t".
10698: '<input name="codebase_'.$num.'" type="hidden" value="'.
10699: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10700: }
1.987 raeburn 10701: return $output;
1.660 raeburn 10702: }
10703:
1.1071 raeburn 10704: sub get_dependency_details {
10705: my ($currfile,$currsubfile,$embed_file) = @_;
10706: my ($size,$mtime,$showsize,$showmtime);
10707: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10708: if ($embed_file =~ m{/}) {
10709: my ($path,$fname) = split(/\//,$embed_file);
10710: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10711: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10712: }
10713: } else {
10714: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10715: ($size,$mtime) = @{$currfile->{$embed_file}};
10716: }
10717: }
10718: $showsize = $size/1024.0;
10719: $showsize = sprintf("%.1f",$showsize);
10720: if ($mtime > 0) {
10721: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10722: }
10723: }
10724: return ($showsize,$showmtime);
10725: }
10726:
10727: sub ask_embedded_js {
10728: return <<"END";
10729: <script type="text/javascript"">
10730: // <![CDATA[
10731: function toggleBrowse(counter) {
10732: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10733: var fileid = document.getElementById('embedded_item_'+counter);
10734: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10735: if (chkboxid.checked == true) {
10736: uploaddivid.style.display='block';
10737: } else {
10738: uploaddivid.style.display='none';
10739: fileid.value = '';
10740: }
10741: }
10742: // ]]>
10743: </script>
10744:
10745: END
10746: }
10747:
1.661 raeburn 10748: sub upload_embedded {
10749: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10750: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10751: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10752: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10753: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10754: my $orig_uploaded_filename =
10755: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10756: foreach my $type ('orig','ref','attrib','codebase') {
10757: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10758: $env{'form.embedded_'.$type.'_'.$i} =
10759: &unescape($env{'form.embedded_'.$type.'_'.$i});
10760: }
10761: }
1.661 raeburn 10762: my ($path,$fname) =
10763: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10764: # no path, whole string is fname
10765: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10766: $fname = &Apache::lonnet::clean_filename($fname);
10767: # See if there is anything left
10768: next if ($fname eq '');
10769:
10770: # Check if file already exists as a file or directory.
10771: my ($state,$msg);
10772: if ($context eq 'portfolio') {
10773: my $port_path = $dirpath;
10774: if ($group ne '') {
10775: $port_path = "groups/$group/$port_path";
10776: }
1.987 raeburn 10777: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10778: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10779: $dir_root,$port_path,$disk_quota,
10780: $current_disk_usage,$uname,$udom);
10781: if ($state eq 'will_exceed_quota'
1.984 raeburn 10782: || $state eq 'file_locked') {
1.661 raeburn 10783: $output .= $msg;
10784: next;
10785: }
10786: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10787: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10788: if ($state eq 'exists') {
10789: $output .= $msg;
10790: next;
10791: }
10792: }
10793: # Check if extension is valid
10794: if (($fname =~ /\.(\w+)$/) &&
10795: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 10796: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10797: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10798: next;
10799: } elsif (($fname =~ /\.(\w+)$/) &&
10800: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10801: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10802: next;
10803: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 10804: $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 10805: next;
10806: }
10807: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 10808: my $subdir = $path;
10809: $subdir =~ s{/+$}{};
1.661 raeburn 10810: if ($context eq 'portfolio') {
1.984 raeburn 10811: my $result;
10812: if ($state eq 'existingfile') {
10813: $result=
10814: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 10815: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10816: } else {
1.984 raeburn 10817: $result=
10818: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10819: $dirpath.
1.1075.2.35 raeburn 10820: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10821: if ($result !~ m|^/uploaded/|) {
10822: $output .= '<span class="LC_error">'
10823: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10824: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10825: .'</span><br />';
10826: next;
10827: } else {
1.987 raeburn 10828: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10829: $path.$fname.'</span>').'<br />';
1.984 raeburn 10830: }
1.661 raeburn 10831: }
1.1075.2.35 raeburn 10832: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
10833: my $extendedsubdir = $dirpath.'/'.$subdir;
10834: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10835: my $result =
1.1075.2.35 raeburn 10836: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10837: if ($result !~ m|^/uploaded/|) {
10838: $output .= '<span class="LC_error">'
10839: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10840: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10841: .'</span><br />';
10842: next;
10843: } else {
10844: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10845: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 10846: if ($context eq 'syllabus') {
10847: &Apache::lonnet::make_public_indefinitely($result);
10848: }
1.987 raeburn 10849: }
1.661 raeburn 10850: } else {
10851: # Save the file
10852: my $target = $env{'form.embedded_item_'.$i};
10853: my $fullpath = $dir_root.$dirpath.'/'.$path;
10854: my $dest = $fullpath.$fname;
10855: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10856: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10857: my $count;
10858: my $filepath = $dir_root;
1.1027 raeburn 10859: foreach my $subdir (@parts) {
10860: $filepath .= "/$subdir";
10861: if (!-e $filepath) {
1.661 raeburn 10862: mkdir($filepath,0770);
10863: }
10864: }
10865: my $fh;
10866: if (!open($fh,'>'.$dest)) {
10867: &Apache::lonnet::logthis('Failed to create '.$dest);
10868: $output .= '<span class="LC_error">'.
1.1071 raeburn 10869: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10870: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10871: '</span><br />';
10872: } else {
10873: if (!print $fh $env{'form.embedded_item_'.$i}) {
10874: &Apache::lonnet::logthis('Failed to write to '.$dest);
10875: $output .= '<span class="LC_error">'.
1.1071 raeburn 10876: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10877: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10878: '</span><br />';
10879: } else {
1.987 raeburn 10880: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10881: $url.'</span>').'<br />';
10882: unless ($context eq 'testbank') {
10883: $footer .= &mt('View embedded file: [_1]',
10884: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10885: }
10886: }
10887: close($fh);
10888: }
10889: }
10890: if ($env{'form.embedded_ref_'.$i}) {
10891: $pathchange{$i} = 1;
10892: }
10893: }
10894: if ($output) {
10895: $output = '<p>'.$output.'</p>';
10896: }
10897: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10898: $returnflag = 'ok';
1.1071 raeburn 10899: my $numpathchgs = scalar(keys(%pathchange));
10900: if ($numpathchgs > 0) {
1.987 raeburn 10901: if ($context eq 'portfolio') {
10902: $output .= '<p>'.&mt('or').'</p>';
10903: } elsif ($context eq 'testbank') {
1.1071 raeburn 10904: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10905: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10906: $returnflag = 'modify_orightml';
10907: }
10908: }
1.1071 raeburn 10909: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10910: }
10911:
10912: sub modify_html_form {
10913: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10914: my $end = 0;
10915: my $modifyform;
10916: if ($context eq 'upload_embedded') {
10917: return unless (ref($pathchange) eq 'HASH');
10918: if ($env{'form.number_embedded_items'}) {
10919: $end += $env{'form.number_embedded_items'};
10920: }
10921: if ($env{'form.number_pathchange_items'}) {
10922: $end += $env{'form.number_pathchange_items'};
10923: }
10924: if ($end) {
10925: for (my $i=0; $i<$end; $i++) {
10926: if ($i < $env{'form.number_embedded_items'}) {
10927: next unless($pathchange->{$i});
10928: }
10929: $modifyform .=
10930: &start_data_table_row().
10931: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10932: 'checked="checked" /></td>'.
10933: '<td>'.$env{'form.embedded_ref_'.$i}.
10934: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10935: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10936: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10937: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10938: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10939: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10940: '<td>'.$env{'form.embedded_orig_'.$i}.
10941: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10942: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10943: &end_data_table_row();
1.1071 raeburn 10944: }
1.987 raeburn 10945: }
10946: } else {
10947: $modifyform = $pathchgtable;
10948: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10949: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10950: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10951: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10952: }
10953: }
10954: if ($modifyform) {
1.1071 raeburn 10955: if ($actionurl eq '/adm/dependencies') {
10956: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10957: }
1.987 raeburn 10958: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10959: '<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".
10960: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10961: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10962: '</ol></p>'."\n".'<p>'.
10963: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10964: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10965: &start_data_table()."\n".
10966: &start_data_table_header_row().
10967: '<th>'.&mt('Change?').'</th>'.
10968: '<th>'.&mt('Current reference').'</th>'.
10969: '<th>'.&mt('Required reference').'</th>'.
10970: &end_data_table_header_row()."\n".
10971: $modifyform.
10972: &end_data_table().'<br />'."\n".$hiddenstate.
10973: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10974: '</form>'."\n";
10975: }
10976: return;
10977: }
10978:
10979: sub modify_html_refs {
1.1075.2.35 raeburn 10980: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10981: my $container;
10982: if ($context eq 'portfolio') {
10983: $container = $env{'form.container'};
10984: } elsif ($context eq 'coursedoc') {
10985: $container = $env{'form.primaryurl'};
1.1071 raeburn 10986: } elsif ($context eq 'manage_dependencies') {
10987: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10988: $container = "/$container";
1.1075.2.35 raeburn 10989: } elsif ($context eq 'syllabus') {
10990: $container = $url;
1.987 raeburn 10991: } else {
1.1027 raeburn 10992: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10993: }
10994: my (%allfiles,%codebase,$output,$content);
10995: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 10996: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10997: if (wantarray) {
10998: return ('',0,0);
10999: } else {
11000: return;
11001: }
11002: }
11003: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 11004: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 11005: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
11006: if (wantarray) {
11007: return ('',0,0);
11008: } else {
11009: return;
11010: }
11011: }
1.987 raeburn 11012: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11013: if ($content eq '-1') {
11014: if (wantarray) {
11015: return ('',0,0);
11016: } else {
11017: return;
11018: }
11019: }
1.987 raeburn 11020: } else {
1.1071 raeburn 11021: unless ($container =~ /^\Q$dir_root\E/) {
11022: if (wantarray) {
11023: return ('',0,0);
11024: } else {
11025: return;
11026: }
11027: }
1.987 raeburn 11028: if (open(my $fh,"<$container")) {
11029: $content = join('', <$fh>);
11030: close($fh);
11031: } else {
1.1071 raeburn 11032: if (wantarray) {
11033: return ('',0,0);
11034: } else {
11035: return;
11036: }
1.987 raeburn 11037: }
11038: }
11039: my ($count,$codebasecount) = (0,0);
11040: my $mm = new File::MMagic;
11041: my $mime_type = $mm->checktype_contents($content);
11042: if ($mime_type eq 'text/html') {
11043: my $parse_result =
11044: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11045: \%codebase,\$content);
11046: if ($parse_result eq 'ok') {
11047: foreach my $i (@changes) {
11048: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11049: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11050: if ($allfiles{$ref}) {
11051: my $newname = $orig;
11052: my ($attrib_regexp,$codebase);
1.1006 raeburn 11053: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11054: if ($attrib_regexp =~ /:/) {
11055: $attrib_regexp =~ s/\:/|/g;
11056: }
11057: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11058: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11059: $count += $numchg;
1.1075.2.35 raeburn 11060: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 11061: delete($allfiles{$ref});
1.987 raeburn 11062: }
11063: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11064: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11065: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11066: $codebasecount ++;
11067: }
11068: }
11069: }
1.1075.2.35 raeburn 11070: my $skiprewrites;
1.987 raeburn 11071: if ($count || $codebasecount) {
11072: my $saveresult;
1.1071 raeburn 11073: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 11074: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11075: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11076: if ($url eq $container) {
11077: my ($fname) = ($container =~ m{/([^/]+)$});
11078: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11079: $count,'<span class="LC_filename">'.
1.1071 raeburn 11080: $fname.'</span>').'</p>';
1.987 raeburn 11081: } else {
11082: $output = '<p class="LC_error">'.
11083: &mt('Error: update failed for: [_1].',
11084: '<span class="LC_filename">'.
11085: $container.'</span>').'</p>';
11086: }
1.1075.2.35 raeburn 11087: if ($context eq 'syllabus') {
11088: unless ($saveresult eq 'ok') {
11089: $skiprewrites = 1;
11090: }
11091: }
1.987 raeburn 11092: } else {
11093: if (open(my $fh,">$container")) {
11094: print $fh $content;
11095: close($fh);
11096: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11097: $count,'<span class="LC_filename">'.
11098: $container.'</span>').'</p>';
1.661 raeburn 11099: } else {
1.987 raeburn 11100: $output = '<p class="LC_error">'.
11101: &mt('Error: could not update [_1].',
11102: '<span class="LC_filename">'.
11103: $container.'</span>').'</p>';
1.661 raeburn 11104: }
11105: }
11106: }
1.1075.2.35 raeburn 11107: if (($context eq 'syllabus') && (!$skiprewrites)) {
11108: my ($actionurl,$state);
11109: $actionurl = "/public/$udom/$uname/syllabus";
11110: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11111: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11112: \%codebase,
11113: {'context' => 'rewrites',
11114: 'ignore_remote_references' => 1,});
11115: if (ref($mapping) eq 'HASH') {
11116: my $rewrites = 0;
11117: foreach my $key (keys(%{$mapping})) {
11118: next if ($key =~ m{^https?://});
11119: my $ref = $mapping->{$key};
11120: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11121: my $attrib;
11122: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11123: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11124: }
11125: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11126: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11127: $rewrites += $numchg;
11128: }
11129: }
11130: if ($rewrites) {
11131: my $saveresult;
11132: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11133: if ($url eq $container) {
11134: my ($fname) = ($container =~ m{/([^/]+)$});
11135: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11136: $count,'<span class="LC_filename">'.
11137: $fname.'</span>').'</p>';
11138: } else {
11139: $output .= '<p class="LC_error">'.
11140: &mt('Error: could not update links in [_1].',
11141: '<span class="LC_filename">'.
11142: $container.'</span>').'</p>';
11143:
11144: }
11145: }
11146: }
11147: }
1.987 raeburn 11148: } else {
11149: &logthis('Failed to parse '.$container.
11150: ' to modify references: '.$parse_result);
1.661 raeburn 11151: }
11152: }
1.1071 raeburn 11153: if (wantarray) {
11154: return ($output,$count,$codebasecount);
11155: } else {
11156: return $output;
11157: }
1.661 raeburn 11158: }
11159:
11160: sub check_for_existing {
11161: my ($path,$fname,$element) = @_;
11162: my ($state,$msg);
11163: if (-d $path.'/'.$fname) {
11164: $state = 'exists';
11165: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11166: } elsif (-e $path.'/'.$fname) {
11167: $state = 'exists';
11168: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11169: }
11170: if ($state eq 'exists') {
11171: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11172: }
11173: return ($state,$msg);
11174: }
11175:
11176: sub check_for_upload {
11177: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11178: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11179: my $filesize = length($env{'form.'.$element});
11180: if (!$filesize) {
11181: my $msg = '<span class="LC_error">'.
11182: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11183: '<span class="LC_filename">'.$fname.'</span>',
11184: $filesize).'<br />'.
1.1007 raeburn 11185: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11186: '</span>';
11187: return ('zero_bytes',$msg);
11188: }
11189: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11190: my $getpropath = 1;
1.1021 raeburn 11191: my ($dirlistref,$listerror) =
11192: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11193: my $found_file = 0;
11194: my $locked_file = 0;
1.991 raeburn 11195: my @lockers;
11196: my $navmap;
11197: if ($env{'request.course.id'}) {
11198: $navmap = Apache::lonnavmaps::navmap->new();
11199: }
1.1021 raeburn 11200: if (ref($dirlistref) eq 'ARRAY') {
11201: foreach my $line (@{$dirlistref}) {
11202: my ($file_name,$rest)=split(/\&/,$line,2);
11203: if ($file_name eq $fname){
11204: $file_name = $path.$file_name;
11205: if ($group ne '') {
11206: $file_name = $group.$file_name;
11207: }
11208: $found_file = 1;
11209: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11210: foreach my $lock (@lockers) {
11211: if (ref($lock) eq 'ARRAY') {
11212: my ($symb,$crsid) = @{$lock};
11213: if ($crsid eq $env{'request.course.id'}) {
11214: if (ref($navmap)) {
11215: my $res = $navmap->getBySymb($symb);
11216: foreach my $part (@{$res->parts()}) {
11217: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11218: unless (($slot_status == $res->RESERVED) ||
11219: ($slot_status == $res->RESERVED_LOCATION)) {
11220: $locked_file = 1;
11221: }
1.991 raeburn 11222: }
1.1021 raeburn 11223: } else {
11224: $locked_file = 1;
1.991 raeburn 11225: }
11226: } else {
11227: $locked_file = 1;
11228: }
11229: }
1.1021 raeburn 11230: }
11231: } else {
11232: my @info = split(/\&/,$rest);
11233: my $currsize = $info[6]/1000;
11234: if ($currsize < $filesize) {
11235: my $extra = $filesize - $currsize;
11236: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 11237: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11238: &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 11239: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11240: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11241: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11242: return ('will_exceed_quota',$msg);
11243: }
1.984 raeburn 11244: }
11245: }
1.661 raeburn 11246: }
11247: }
11248: }
11249: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 11250: my $msg = '<p class="LC_warning">'.
11251: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
11252: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11253: return ('will_exceed_quota',$msg);
11254: } elsif ($found_file) {
11255: if ($locked_file) {
1.1075.2.69 raeburn 11256: my $msg = '<p class="LC_warning">';
1.661 raeburn 11257: $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 11258: $msg .= '</p>';
1.661 raeburn 11259: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11260: return ('file_locked',$msg);
11261: } else {
1.1075.2.69 raeburn 11262: my $msg = '<p class="LC_error">';
1.984 raeburn 11263: $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 11264: $msg .= '</p>';
1.984 raeburn 11265: return ('existingfile',$msg);
1.661 raeburn 11266: }
11267: }
11268: }
11269:
1.987 raeburn 11270: sub check_for_traversal {
11271: my ($path,$url,$toplevel) = @_;
11272: my @parts=split(/\//,$path);
11273: my $cleanpath;
11274: my $fullpath = $url;
11275: for (my $i=0;$i<@parts;$i++) {
11276: next if ($parts[$i] eq '.');
11277: if ($parts[$i] eq '..') {
11278: $fullpath =~ s{([^/]+/)$}{};
11279: } else {
11280: $fullpath .= $parts[$i].'/';
11281: }
11282: }
11283: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11284: $cleanpath = $1;
11285: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11286: my $curr_toprel = $1;
11287: my @parts = split(/\//,$curr_toprel);
11288: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11289: my @urlparts = split(/\//,$url_toprel);
11290: my $doubledots;
11291: my $startdiff = -1;
11292: for (my $i=0; $i<@urlparts; $i++) {
11293: if ($startdiff == -1) {
11294: unless ($urlparts[$i] eq $parts[$i]) {
11295: $startdiff = $i;
11296: $doubledots .= '../';
11297: }
11298: } else {
11299: $doubledots .= '../';
11300: }
11301: }
11302: if ($startdiff > -1) {
11303: $cleanpath = $doubledots;
11304: for (my $i=$startdiff; $i<@parts; $i++) {
11305: $cleanpath .= $parts[$i].'/';
11306: }
11307: }
11308: }
11309: $cleanpath =~ s{(/)$}{};
11310: return $cleanpath;
11311: }
1.31 albertel 11312:
1.1053 raeburn 11313: sub is_archive_file {
11314: my ($mimetype) = @_;
11315: if (($mimetype eq 'application/octet-stream') ||
11316: ($mimetype eq 'application/x-stuffit') ||
11317: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11318: return 1;
11319: }
11320: return;
11321: }
11322:
11323: sub decompress_form {
1.1065 raeburn 11324: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11325: my %lt = &Apache::lonlocal::texthash (
11326: this => 'This file is an archive file.',
1.1067 raeburn 11327: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11328: itsc => 'Its contents are as follows:',
1.1053 raeburn 11329: youm => 'You may wish to extract its contents.',
11330: extr => 'Extract contents',
1.1067 raeburn 11331: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11332: proa => 'Process automatically?',
1.1053 raeburn 11333: yes => 'Yes',
11334: no => 'No',
1.1067 raeburn 11335: fold => 'Title for folder containing movie',
11336: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11337: );
1.1065 raeburn 11338: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11339: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11340: my $info = &list_archive_contents($fileloc,\@paths);
11341: if (@paths) {
11342: foreach my $path (@paths) {
11343: $path =~ s{^/}{};
1.1067 raeburn 11344: if ($path =~ m{^([^/]+)/$}) {
11345: $topdir = $1;
11346: }
1.1065 raeburn 11347: if ($path =~ m{^([^/]+)/}) {
11348: $toplevel{$1} = $path;
11349: } else {
11350: $toplevel{$path} = $path;
11351: }
11352: }
11353: }
1.1067 raeburn 11354: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 11355: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11356: "$topdir/media/",
11357: "$topdir/media/$topdir.mp4",
11358: "$topdir/media/FirstFrame.png",
11359: "$topdir/media/player.swf",
11360: "$topdir/media/swfobject.js",
11361: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 11362: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 11363: "$topdir/$topdir.mp4",
11364: "$topdir/$topdir\_config.xml",
11365: "$topdir/$topdir\_controller.swf",
11366: "$topdir/$topdir\_embed.css",
11367: "$topdir/$topdir\_First_Frame.png",
11368: "$topdir/$topdir\_player.html",
11369: "$topdir/$topdir\_Thumbnails.png",
11370: "$topdir/playerProductInstall.swf",
11371: "$topdir/scripts/",
11372: "$topdir/scripts/config_xml.js",
11373: "$topdir/scripts/handlebars.js",
11374: "$topdir/scripts/jquery-1.7.1.min.js",
11375: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11376: "$topdir/scripts/modernizr.js",
11377: "$topdir/scripts/player-min.js",
11378: "$topdir/scripts/swfobject.js",
11379: "$topdir/skins/",
11380: "$topdir/skins/configuration_express.xml",
11381: "$topdir/skins/express_show/",
11382: "$topdir/skins/express_show/player-min.css",
11383: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 11384: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11385: "$topdir/$topdir.mp4",
11386: "$topdir/$topdir\_config.xml",
11387: "$topdir/$topdir\_controller.swf",
11388: "$topdir/$topdir\_embed.css",
11389: "$topdir/$topdir\_First_Frame.png",
11390: "$topdir/$topdir\_player.html",
11391: "$topdir/$topdir\_Thumbnails.png",
11392: "$topdir/playerProductInstall.swf",
11393: "$topdir/scripts/",
11394: "$topdir/scripts/config_xml.js",
11395: "$topdir/scripts/techsmith-smart-player.min.js",
11396: "$topdir/skins/",
11397: "$topdir/skins/configuration_express.xml",
11398: "$topdir/skins/express_show/",
11399: "$topdir/skins/express_show/spritesheet.min.css",
11400: "$topdir/skins/express_show/spritesheet.png",
11401: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 11402: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11403: if (@diffs == 0) {
1.1075.2.59 raeburn 11404: $is_camtasia = 6;
11405: } else {
1.1075.2.81 raeburn 11406: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 11407: if (@diffs == 0) {
11408: $is_camtasia = 8;
1.1075.2.81 raeburn 11409: } else {
11410: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11411: if (@diffs == 0) {
11412: $is_camtasia = 8;
11413: }
1.1075.2.59 raeburn 11414: }
1.1067 raeburn 11415: }
11416: }
11417: my $output;
11418: if ($is_camtasia) {
11419: $output = <<"ENDCAM";
11420: <script type="text/javascript" language="Javascript">
11421: // <![CDATA[
11422:
11423: function camtasiaToggle() {
11424: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11425: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 11426: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11427: document.getElementById('camtasia_titles').style.display='block';
11428: } else {
11429: document.getElementById('camtasia_titles').style.display='none';
11430: }
11431: }
11432: }
11433: return;
11434: }
11435:
11436: // ]]>
11437: </script>
11438: <p>$lt{'camt'}</p>
11439: ENDCAM
1.1065 raeburn 11440: } else {
1.1067 raeburn 11441: $output = '<p>'.$lt{'this'};
11442: if ($info eq '') {
11443: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11444: } else {
11445: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11446: '<div><pre>'.$info.'</pre></div>';
11447: }
1.1065 raeburn 11448: }
1.1067 raeburn 11449: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11450: my $duplicates;
11451: my $num = 0;
11452: if (ref($dirlist) eq 'ARRAY') {
11453: foreach my $item (@{$dirlist}) {
11454: if (ref($item) eq 'ARRAY') {
11455: if (exists($toplevel{$item->[0]})) {
11456: $duplicates .=
11457: &start_data_table_row().
11458: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11459: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11460: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11461: 'value="1" />'.&mt('Yes').'</label>'.
11462: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11463: '<td>'.$item->[0].'</td>';
11464: if ($item->[2]) {
11465: $duplicates .= '<td>'.&mt('Directory').'</td>';
11466: } else {
11467: $duplicates .= '<td>'.&mt('File').'</td>';
11468: }
11469: $duplicates .= '<td>'.$item->[3].'</td>'.
11470: '<td>'.
11471: &Apache::lonlocal::locallocaltime($item->[4]).
11472: '</td>'.
11473: &end_data_table_row();
11474: $num ++;
11475: }
11476: }
11477: }
11478: }
11479: my $itemcount;
11480: if (@paths > 0) {
11481: $itemcount = scalar(@paths);
11482: } else {
11483: $itemcount = 1;
11484: }
1.1067 raeburn 11485: if ($is_camtasia) {
11486: $output .= $lt{'auto'}.'<br />'.
11487: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 11488: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11489: $lt{'yes'}.'</label> <label>'.
11490: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11491: $lt{'no'}.'</label></span><br />'.
11492: '<div id="camtasia_titles" style="display:block">'.
11493: &Apache::lonhtmlcommon::start_pick_box().
11494: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11495: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11496: &Apache::lonhtmlcommon::row_closure().
11497: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11498: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11499: &Apache::lonhtmlcommon::row_closure(1).
11500: &Apache::lonhtmlcommon::end_pick_box().
11501: '</div>';
11502: }
1.1065 raeburn 11503: $output .=
11504: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11505: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11506: "\n";
1.1065 raeburn 11507: if ($duplicates ne '') {
11508: $output .= '<p><span class="LC_warning">'.
11509: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11510: &start_data_table().
11511: &start_data_table_header_row().
11512: '<th>'.&mt('Overwrite?').'</th>'.
11513: '<th>'.&mt('Name').'</th>'.
11514: '<th>'.&mt('Type').'</th>'.
11515: '<th>'.&mt('Size').'</th>'.
11516: '<th>'.&mt('Last modified').'</th>'.
11517: &end_data_table_header_row().
11518: $duplicates.
11519: &end_data_table().
11520: '</p>';
11521: }
1.1067 raeburn 11522: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11523: if (ref($hiddenelements) eq 'HASH') {
11524: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11525: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11526: }
11527: }
11528: $output .= <<"END";
1.1067 raeburn 11529: <br />
1.1053 raeburn 11530: <input type="submit" name="decompress" value="$lt{'extr'}" />
11531: </form>
11532: $noextract
11533: END
11534: return $output;
11535: }
11536:
1.1065 raeburn 11537: sub decompression_utility {
11538: my ($program) = @_;
11539: my @utilities = ('tar','gunzip','bunzip2','unzip');
11540: my $location;
11541: if (grep(/^\Q$program\E$/,@utilities)) {
11542: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11543: '/usr/sbin/') {
11544: if (-x $dir.$program) {
11545: $location = $dir.$program;
11546: last;
11547: }
11548: }
11549: }
11550: return $location;
11551: }
11552:
11553: sub list_archive_contents {
11554: my ($file,$pathsref) = @_;
11555: my (@cmd,$output);
11556: my $needsregexp;
11557: if ($file =~ /\.zip$/) {
11558: @cmd = (&decompression_utility('unzip'),"-l");
11559: $needsregexp = 1;
11560: } elsif (($file =~ m/\.tar\.gz$/) ||
11561: ($file =~ /\.tgz$/)) {
11562: @cmd = (&decompression_utility('tar'),"-ztf");
11563: } elsif ($file =~ /\.tar\.bz2$/) {
11564: @cmd = (&decompression_utility('tar'),"-jtf");
11565: } elsif ($file =~ m|\.tar$|) {
11566: @cmd = (&decompression_utility('tar'),"-tf");
11567: }
11568: if (@cmd) {
11569: undef($!);
11570: undef($@);
11571: if (open(my $fh,"-|", @cmd, $file)) {
11572: while (my $line = <$fh>) {
11573: $output .= $line;
11574: chomp($line);
11575: my $item;
11576: if ($needsregexp) {
11577: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11578: } else {
11579: $item = $line;
11580: }
11581: if ($item ne '') {
11582: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11583: push(@{$pathsref},$item);
11584: }
11585: }
11586: }
11587: close($fh);
11588: }
11589: }
11590: return $output;
11591: }
11592:
1.1053 raeburn 11593: sub decompress_uploaded_file {
11594: my ($file,$dir) = @_;
11595: &Apache::lonnet::appenv({'cgi.file' => $file});
11596: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11597: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11598: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11599: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11600: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11601: my $decompressed = $env{'cgi.decompressed'};
11602: &Apache::lonnet::delenv('cgi.file');
11603: &Apache::lonnet::delenv('cgi.dir');
11604: &Apache::lonnet::delenv('cgi.decompressed');
11605: return ($decompressed,$result);
11606: }
11607:
1.1055 raeburn 11608: sub process_decompression {
11609: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11610: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 11611: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 11612: $error = &mt('Filename not a supported archive file type.').
11613: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11614: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11615: } else {
11616: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11617: if ($docuhome eq 'no_host') {
11618: $error = &mt('Could not determine home server for course.');
11619: } else {
11620: my @ids=&Apache::lonnet::current_machine_ids();
11621: my $currdir = "$dir_root/$destination";
11622: if (grep(/^\Q$docuhome\E$/,@ids)) {
11623: $dir = &LONCAPA::propath($docudom,$docuname).
11624: "$dir_root/$destination";
11625: } else {
11626: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11627: "$dir_root/$docudom/$docuname/$destination";
11628: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11629: $error = &mt('Archive file not found.');
11630: }
11631: }
1.1065 raeburn 11632: my (@to_overwrite,@to_skip);
11633: if ($env{'form.archive_overwrite_total'} > 0) {
11634: my $total = $env{'form.archive_overwrite_total'};
11635: for (my $i=0; $i<$total; $i++) {
11636: if ($env{'form.archive_overwrite_'.$i} == 1) {
11637: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11638: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11639: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11640: }
11641: }
11642: }
11643: my $numskip = scalar(@to_skip);
11644: if (($numskip > 0) &&
11645: ($numskip == $env{'form.archive_itemcount'})) {
11646: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11647: } elsif ($dir eq '') {
1.1055 raeburn 11648: $error = &mt('Directory containing archive file unavailable.');
11649: } elsif (!$error) {
1.1065 raeburn 11650: my ($decompressed,$display);
11651: if ($numskip > 0) {
11652: my $tempdir = time.'_'.$$.int(rand(10000));
11653: mkdir("$dir/$tempdir",0755);
11654: system("mv $dir/$file $dir/$tempdir/$file");
11655: ($decompressed,$display) =
11656: &decompress_uploaded_file($file,"$dir/$tempdir");
11657: foreach my $item (@to_skip) {
11658: if (($item ne '') && ($item !~ /\.\./)) {
11659: if (-f "$dir/$tempdir/$item") {
11660: unlink("$dir/$tempdir/$item");
11661: } elsif (-d "$dir/$tempdir/$item") {
11662: system("rm -rf $dir/$tempdir/$item");
11663: }
11664: }
11665: }
11666: system("mv $dir/$tempdir/* $dir");
11667: rmdir("$dir/$tempdir");
11668: } else {
11669: ($decompressed,$display) =
11670: &decompress_uploaded_file($file,$dir);
11671: }
1.1055 raeburn 11672: if ($decompressed eq 'ok') {
1.1065 raeburn 11673: $output = '<p class="LC_info">'.
11674: &mt('Files extracted successfully from archive.').
11675: '</p>'."\n";
1.1055 raeburn 11676: my ($warning,$result,@contents);
11677: my ($newdirlistref,$newlisterror) =
11678: &Apache::lonnet::dirlist($currdir,$docudom,
11679: $docuname,1);
11680: my (%is_dir,%changes,@newitems);
11681: my $dirptr = 16384;
1.1065 raeburn 11682: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11683: foreach my $dir_line (@{$newdirlistref}) {
11684: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11685: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11686: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11687: push(@newitems,$item);
11688: if ($dirptr&$testdir) {
11689: $is_dir{$item} = 1;
11690: }
11691: $changes{$item} = 1;
11692: }
11693: }
11694: }
11695: if (keys(%changes) > 0) {
11696: foreach my $item (sort(@newitems)) {
11697: if ($changes{$item}) {
11698: push(@contents,$item);
11699: }
11700: }
11701: }
11702: if (@contents > 0) {
1.1067 raeburn 11703: my $wantform;
11704: unless ($env{'form.autoextract_camtasia'}) {
11705: $wantform = 1;
11706: }
1.1056 raeburn 11707: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11708: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11709: $currdir,\%is_dir,
11710: \%children,\%parent,
1.1056 raeburn 11711: \@contents,\%dirorder,
11712: \%titles,$wantform);
1.1055 raeburn 11713: if ($datatable ne '') {
11714: $output .= &archive_options_form('decompressed',$datatable,
11715: $count,$hiddenelem);
1.1065 raeburn 11716: my $startcount = 6;
1.1055 raeburn 11717: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11718: \%titles,\%children);
1.1055 raeburn 11719: }
1.1067 raeburn 11720: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 11721: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11722: my %displayed;
11723: my $total = 1;
11724: $env{'form.archive_directory'} = [];
11725: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11726: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11727: $path =~ s{/$}{};
11728: my $item;
11729: if ($path ne '') {
11730: $item = "$path/$titles{$i}";
11731: } else {
11732: $item = $titles{$i};
11733: }
11734: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11735: if ($item eq $contents[0]) {
11736: push(@{$env{'form.archive_directory'}},$i);
11737: $env{'form.archive_'.$i} = 'display';
11738: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11739: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 11740: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11741: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11742: $env{'form.archive_'.$i} = 'display';
11743: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11744: $displayed{'web'} = $i;
11745: } else {
1.1075.2.59 raeburn 11746: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11747: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11748: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11749: push(@{$env{'form.archive_directory'}},$i);
11750: }
11751: $env{'form.archive_'.$i} = 'dependency';
11752: }
11753: $total ++;
11754: }
11755: for (my $i=1; $i<$total; $i++) {
11756: next if ($i == $displayed{'web'});
11757: next if ($i == $displayed{'folder'});
11758: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11759: }
11760: $env{'form.phase'} = 'decompress_cleanup';
11761: $env{'form.archivedelete'} = 1;
11762: $env{'form.archive_count'} = $total-1;
11763: $output .=
11764: &process_extracted_files('coursedocs',$docudom,
11765: $docuname,$destination,
11766: $dir_root,$hiddenelem);
11767: }
1.1055 raeburn 11768: } else {
11769: $warning = &mt('No new items extracted from archive file.');
11770: }
11771: } else {
11772: $output = $display;
11773: $error = &mt('An error occurred during extraction from the archive file.');
11774: }
11775: }
11776: }
11777: }
11778: if ($error) {
11779: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11780: $error.'</p>'."\n";
11781: }
11782: if ($warning) {
11783: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11784: }
11785: return $output;
11786: }
11787:
11788: sub get_extracted {
1.1056 raeburn 11789: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11790: $titles,$wantform) = @_;
1.1055 raeburn 11791: my $count = 0;
11792: my $depth = 0;
11793: my $datatable;
1.1056 raeburn 11794: my @hierarchy;
1.1055 raeburn 11795: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11796: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11797: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11798: foreach my $item (@{$contents}) {
11799: $count ++;
1.1056 raeburn 11800: @{$dirorder->{$count}} = @hierarchy;
11801: $titles->{$count} = $item;
1.1055 raeburn 11802: &archive_hierarchy($depth,$count,$parent,$children);
11803: if ($wantform) {
11804: $datatable .= &archive_row($is_dir->{$item},$item,
11805: $currdir,$depth,$count);
11806: }
11807: if ($is_dir->{$item}) {
11808: $depth ++;
1.1056 raeburn 11809: push(@hierarchy,$count);
11810: $parent->{$depth} = $count;
1.1055 raeburn 11811: $datatable .=
11812: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11813: \$depth,\$count,\@hierarchy,$dirorder,
11814: $children,$parent,$titles,$wantform);
1.1055 raeburn 11815: $depth --;
1.1056 raeburn 11816: pop(@hierarchy);
1.1055 raeburn 11817: }
11818: }
11819: return ($count,$datatable);
11820: }
11821:
11822: sub recurse_extracted_archive {
1.1056 raeburn 11823: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11824: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11825: my $result='';
1.1056 raeburn 11826: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11827: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11828: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11829: return $result;
11830: }
11831: my $dirptr = 16384;
11832: my ($newdirlistref,$newlisterror) =
11833: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11834: if (ref($newdirlistref) eq 'ARRAY') {
11835: foreach my $dir_line (@{$newdirlistref}) {
11836: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11837: unless ($item =~ /^\.+$/) {
11838: $$count ++;
1.1056 raeburn 11839: @{$dirorder->{$$count}} = @{$hierarchy};
11840: $titles->{$$count} = $item;
1.1055 raeburn 11841: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11842:
1.1055 raeburn 11843: my $is_dir;
11844: if ($dirptr&$testdir) {
11845: $is_dir = 1;
11846: }
11847: if ($wantform) {
11848: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11849: }
11850: if ($is_dir) {
11851: $$depth ++;
1.1056 raeburn 11852: push(@{$hierarchy},$$count);
11853: $parent->{$$depth} = $$count;
1.1055 raeburn 11854: $result .=
11855: &recurse_extracted_archive("$currdir/$item",$docudom,
11856: $docuname,$depth,$count,
1.1056 raeburn 11857: $hierarchy,$dirorder,$children,
11858: $parent,$titles,$wantform);
1.1055 raeburn 11859: $$depth --;
1.1056 raeburn 11860: pop(@{$hierarchy});
1.1055 raeburn 11861: }
11862: }
11863: }
11864: }
11865: return $result;
11866: }
11867:
11868: sub archive_hierarchy {
11869: my ($depth,$count,$parent,$children) =@_;
11870: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11871: if (exists($parent->{$depth})) {
11872: $children->{$parent->{$depth}} .= $count.':';
11873: }
11874: }
11875: return;
11876: }
11877:
11878: sub archive_row {
11879: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11880: my ($name) = ($item =~ m{([^/]+)$});
11881: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11882: 'display' => 'Add as file',
1.1055 raeburn 11883: 'dependency' => 'Include as dependency',
11884: 'discard' => 'Discard',
11885: );
11886: if ($is_dir) {
1.1059 raeburn 11887: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11888: }
1.1056 raeburn 11889: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11890: my $offset = 0;
1.1055 raeburn 11891: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11892: $offset ++;
1.1065 raeburn 11893: if ($action ne 'display') {
11894: $offset ++;
11895: }
1.1055 raeburn 11896: $output .= '<td><span class="LC_nobreak">'.
11897: '<label><input type="radio" name="archive_'.$count.
11898: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11899: my $text = $choices{$action};
11900: if ($is_dir) {
11901: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11902: if ($action eq 'display') {
1.1059 raeburn 11903: $text = &mt('Add as folder');
1.1055 raeburn 11904: }
1.1056 raeburn 11905: } else {
11906: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11907:
11908: }
11909: $output .= ' /> '.$choices{$action}.'</label></span>';
11910: if ($action eq 'dependency') {
11911: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11912: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11913: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11914: '<option value=""></option>'."\n".
11915: '</select>'."\n".
11916: '</div>';
1.1059 raeburn 11917: } elsif ($action eq 'display') {
11918: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11919: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11920: '</div>';
1.1055 raeburn 11921: }
1.1056 raeburn 11922: $output .= '</td>';
1.1055 raeburn 11923: }
11924: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11925: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11926: for (my $i=0; $i<$depth; $i++) {
11927: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11928: }
11929: if ($is_dir) {
11930: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11931: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11932: } else {
11933: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11934: }
11935: $output .= ' '.$name.'</td>'."\n".
11936: &end_data_table_row();
11937: return $output;
11938: }
11939:
11940: sub archive_options_form {
1.1065 raeburn 11941: my ($form,$display,$count,$hiddenelem) = @_;
11942: my %lt = &Apache::lonlocal::texthash(
11943: perm => 'Permanently remove archive file?',
11944: hows => 'How should each extracted item be incorporated in the course?',
11945: cont => 'Content actions for all',
11946: addf => 'Add as folder/file',
11947: incd => 'Include as dependency for a displayed file',
11948: disc => 'Discard',
11949: no => 'No',
11950: yes => 'Yes',
11951: save => 'Save',
11952: );
11953: my $output = <<"END";
11954: <form name="$form" method="post" action="">
11955: <p><span class="LC_nobreak">$lt{'perm'}
11956: <label>
11957: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11958: </label>
11959:
11960: <label>
11961: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11962: </span>
11963: </p>
11964: <input type="hidden" name="phase" value="decompress_cleanup" />
11965: <br />$lt{'hows'}
11966: <div class="LC_columnSection">
11967: <fieldset>
11968: <legend>$lt{'cont'}</legend>
11969: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11970: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11971: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11972: </fieldset>
11973: </div>
11974: END
11975: return $output.
1.1055 raeburn 11976: &start_data_table()."\n".
1.1065 raeburn 11977: $display."\n".
1.1055 raeburn 11978: &end_data_table()."\n".
11979: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11980: $hiddenelem.
1.1065 raeburn 11981: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11982: '</form>';
11983: }
11984:
11985: sub archive_javascript {
1.1056 raeburn 11986: my ($startcount,$numitems,$titles,$children) = @_;
11987: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11988: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11989: my $scripttag = <<START;
11990: <script type="text/javascript">
11991: // <![CDATA[
11992:
11993: function checkAll(form,prefix) {
11994: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11995: for (var i=0; i < form.elements.length; i++) {
11996: var id = form.elements[i].id;
11997: if ((id != '') && (id != undefined)) {
11998: if (idstr.test(id)) {
11999: if (form.elements[i].type == 'radio') {
12000: form.elements[i].checked = true;
1.1056 raeburn 12001: var nostart = i-$startcount;
1.1059 raeburn 12002: var offset = nostart%7;
12003: var count = (nostart-offset)/7;
1.1056 raeburn 12004: dependencyCheck(form,count,offset);
1.1055 raeburn 12005: }
12006: }
12007: }
12008: }
12009: }
12010:
12011: function propagateCheck(form,count) {
12012: if (count > 0) {
1.1059 raeburn 12013: var startelement = $startcount + ((count-1) * 7);
12014: for (var j=1; j<6; j++) {
12015: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12016: var item = startelement + j;
12017: if (form.elements[item].type == 'radio') {
12018: if (form.elements[item].checked) {
12019: containerCheck(form,count,j);
12020: break;
12021: }
1.1055 raeburn 12022: }
12023: }
12024: }
12025: }
12026: }
12027:
12028: numitems = $numitems
1.1056 raeburn 12029: var titles = new Array(numitems);
12030: var parents = new Array(numitems);
1.1055 raeburn 12031: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12032: parents[i] = new Array;
1.1055 raeburn 12033: }
1.1059 raeburn 12034: var maintitle = '$maintitle';
1.1055 raeburn 12035:
12036: START
12037:
1.1056 raeburn 12038: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12039: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12040: for (my $i=0; $i<@contents; $i ++) {
12041: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12042: }
12043: }
12044:
1.1056 raeburn 12045: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12046: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12047: }
12048:
1.1055 raeburn 12049: $scripttag .= <<END;
12050:
12051: function containerCheck(form,count,offset) {
12052: if (count > 0) {
1.1056 raeburn 12053: dependencyCheck(form,count,offset);
1.1059 raeburn 12054: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12055: form.elements[item].checked = true;
12056: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12057: if (parents[count].length > 0) {
12058: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12059: containerCheck(form,parents[count][j],offset);
12060: }
12061: }
12062: }
12063: }
12064: }
12065:
12066: function dependencyCheck(form,count,offset) {
12067: if (count > 0) {
1.1059 raeburn 12068: var chosen = (offset+$startcount)+7*(count-1);
12069: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12070: var currtype = form.elements[depitem].type;
12071: if (form.elements[chosen].value == 'dependency') {
12072: document.getElementById('arc_depon_'+count).style.display='block';
12073: form.elements[depitem].options.length = 0;
12074: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 12075: for (var i=1; i<=numitems; i++) {
12076: if (i == count) {
12077: continue;
12078: }
1.1059 raeburn 12079: var startelement = $startcount + (i-1) * 7;
12080: for (var j=1; j<6; j++) {
12081: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12082: var item = startelement + j;
12083: if (form.elements[item].type == 'radio') {
12084: if (form.elements[item].checked) {
12085: if (form.elements[item].value == 'display') {
12086: var n = form.elements[depitem].options.length;
12087: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12088: }
12089: }
12090: }
12091: }
12092: }
12093: }
12094: } else {
12095: document.getElementById('arc_depon_'+count).style.display='none';
12096: form.elements[depitem].options.length = 0;
12097: form.elements[depitem].options[0] = new Option('Select','',true,true);
12098: }
1.1059 raeburn 12099: titleCheck(form,count,offset);
1.1056 raeburn 12100: }
12101: }
12102:
12103: function propagateSelect(form,count,offset) {
12104: if (count > 0) {
1.1065 raeburn 12105: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12106: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12107: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12108: if (parents[count].length > 0) {
12109: for (var j=0; j<parents[count].length; j++) {
12110: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12111: }
12112: }
12113: }
12114: }
12115: }
1.1056 raeburn 12116:
12117: function containerSelect(form,count,offset,picked) {
12118: if (count > 0) {
1.1065 raeburn 12119: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12120: if (form.elements[item].type == 'radio') {
12121: if (form.elements[item].value == 'dependency') {
12122: if (form.elements[item+1].type == 'select-one') {
12123: for (var i=0; i<form.elements[item+1].options.length; i++) {
12124: if (form.elements[item+1].options[i].value == picked) {
12125: form.elements[item+1].selectedIndex = i;
12126: break;
12127: }
12128: }
12129: }
12130: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12131: if (parents[count].length > 0) {
12132: for (var j=0; j<parents[count].length; j++) {
12133: containerSelect(form,parents[count][j],offset,picked);
12134: }
12135: }
12136: }
12137: }
12138: }
12139: }
12140: }
12141:
1.1059 raeburn 12142: function titleCheck(form,count,offset) {
12143: if (count > 0) {
12144: var chosen = (offset+$startcount)+7*(count-1);
12145: var depitem = $startcount + ((count-1) * 7) + 2;
12146: var currtype = form.elements[depitem].type;
12147: if (form.elements[chosen].value == 'display') {
12148: document.getElementById('arc_title_'+count).style.display='block';
12149: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12150: document.getElementById('archive_title_'+count).value=maintitle;
12151: }
12152: } else {
12153: document.getElementById('arc_title_'+count).style.display='none';
12154: if (currtype == 'text') {
12155: document.getElementById('archive_title_'+count).value='';
12156: }
12157: }
12158: }
12159: return;
12160: }
12161:
1.1055 raeburn 12162: // ]]>
12163: </script>
12164: END
12165: return $scripttag;
12166: }
12167:
12168: sub process_extracted_files {
1.1067 raeburn 12169: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12170: my $numitems = $env{'form.archive_count'};
12171: return unless ($numitems);
12172: my @ids=&Apache::lonnet::current_machine_ids();
12173: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12174: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12175: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12176: if (grep(/^\Q$docuhome\E$/,@ids)) {
12177: $prefix = &LONCAPA::propath($docudom,$docuname);
12178: $pathtocheck = "$dir_root/$destination";
12179: $dir = $dir_root;
12180: $ishome = 1;
12181: } else {
12182: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12183: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12184: $dir = "$dir_root/$docudom/$docuname";
12185: }
12186: my $currdir = "$dir_root/$destination";
12187: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12188: if ($env{'form.folderpath'}) {
12189: my @items = split('&',$env{'form.folderpath'});
12190: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 12191: if ($env{'form.folderpath'} =~ /\:1$/) {
12192: $containers{'0'}='page';
12193: } else {
12194: $containers{'0'}='sequence';
12195: }
1.1055 raeburn 12196: }
12197: my @archdirs = &get_env_multiple('form.archive_directory');
12198: if ($numitems) {
12199: for (my $i=1; $i<=$numitems; $i++) {
12200: my $path = $env{'form.archive_content_'.$i};
12201: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12202: my $item = $1;
12203: $toplevelitems{$item} = $i;
12204: if (grep(/^\Q$i\E$/,@archdirs)) {
12205: $is_dir{$item} = 1;
12206: }
12207: }
12208: }
12209: }
1.1067 raeburn 12210: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12211: if (keys(%toplevelitems) > 0) {
12212: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12213: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12214: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12215: }
1.1066 raeburn 12216: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12217: if ($numitems) {
12218: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 12219: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12220: my $path = $env{'form.archive_content_'.$i};
12221: if ($path =~ /^\Q$pathtocheck\E/) {
12222: if ($env{'form.archive_'.$i} eq 'discard') {
12223: if ($prefix ne '' && $path ne '') {
12224: if (-e $prefix.$path) {
1.1066 raeburn 12225: if ((@archdirs > 0) &&
12226: (grep(/^\Q$i\E$/,@archdirs))) {
12227: $todeletedir{$prefix.$path} = 1;
12228: } else {
12229: $todelete{$prefix.$path} = 1;
12230: }
1.1055 raeburn 12231: }
12232: }
12233: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12234: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12235: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12236: $docstitle = $env{'form.archive_title_'.$i};
12237: if ($docstitle eq '') {
12238: $docstitle = $title;
12239: }
1.1055 raeburn 12240: $outer = 0;
1.1056 raeburn 12241: if (ref($dirorder{$i}) eq 'ARRAY') {
12242: if (@{$dirorder{$i}} > 0) {
12243: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12244: if ($env{'form.archive_'.$item} eq 'display') {
12245: $outer = $item;
12246: last;
12247: }
12248: }
12249: }
12250: }
12251: my ($errtext,$fatal) =
12252: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12253: '/'.$folders{$outer}.'.'.
12254: $containers{$outer});
12255: next if ($fatal);
12256: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12257: if ($context eq 'coursedocs') {
1.1056 raeburn 12258: $mapinner{$i} = time;
1.1055 raeburn 12259: $folders{$i} = 'default_'.$mapinner{$i};
12260: $containers{$i} = 'sequence';
12261: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12262: $folders{$i}.'.'.$containers{$i};
12263: my $newidx = &LONCAPA::map::getresidx();
12264: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12265: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12266: push(@LONCAPA::map::order,$newidx);
12267: my ($outtext,$errtext) =
12268: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12269: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12270: '.'.$containers{$outer},1,1);
1.1056 raeburn 12271: $newseqid{$i} = $newidx;
1.1067 raeburn 12272: unless ($errtext) {
12273: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12274: }
1.1055 raeburn 12275: }
12276: } else {
12277: if ($context eq 'coursedocs') {
12278: my $newidx=&LONCAPA::map::getresidx();
12279: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12280: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12281: $title;
12282: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12283: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12284: }
12285: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12286: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12287: }
12288: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12289: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12290: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12291: unless ($ishome) {
12292: my $fetch = "$newdest{$i}/$title";
12293: $fetch =~ s/^\Q$prefix$dir\E//;
12294: $prompttofetch{$fetch} = 1;
12295: }
1.1055 raeburn 12296: }
12297: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12298: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12299: push(@LONCAPA::map::order, $newidx);
12300: my ($outtext,$errtext)=
12301: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12302: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12303: '.'.$containers{$outer},1,1);
1.1067 raeburn 12304: unless ($errtext) {
12305: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12306: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12307: }
12308: }
1.1055 raeburn 12309: }
12310: }
1.1075.2.11 raeburn 12311: }
12312: } else {
12313: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12314: }
12315: }
12316: for (my $i=1; $i<=$numitems; $i++) {
12317: next unless ($env{'form.archive_'.$i} eq 'dependency');
12318: my $path = $env{'form.archive_content_'.$i};
12319: if ($path =~ /^\Q$pathtocheck\E/) {
12320: my ($title) = ($path =~ m{/([^/]+)$});
12321: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12322: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12323: if (ref($dirorder{$i}) eq 'ARRAY') {
12324: my ($itemidx,$fullpath,$relpath);
12325: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12326: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12327: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 12328: if ($dirorder{$i}->[$j] eq $container) {
12329: $itemidx = $j;
1.1056 raeburn 12330: }
12331: }
1.1075.2.11 raeburn 12332: }
12333: if ($itemidx eq '') {
12334: $itemidx = 0;
12335: }
12336: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12337: if ($mapinner{$referrer{$i}}) {
12338: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12339: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12340: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12341: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12342: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12343: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12344: if (!-e $fullpath) {
12345: mkdir($fullpath,0755);
1.1056 raeburn 12346: }
12347: }
1.1075.2.11 raeburn 12348: } else {
12349: last;
1.1056 raeburn 12350: }
1.1075.2.11 raeburn 12351: }
12352: }
12353: } elsif ($newdest{$referrer{$i}}) {
12354: $fullpath = $newdest{$referrer{$i}};
12355: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12356: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12357: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12358: last;
12359: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12360: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12361: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12362: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12363: if (!-e $fullpath) {
12364: mkdir($fullpath,0755);
1.1056 raeburn 12365: }
12366: }
1.1075.2.11 raeburn 12367: } else {
12368: last;
1.1056 raeburn 12369: }
1.1075.2.11 raeburn 12370: }
12371: }
12372: if ($fullpath ne '') {
12373: if (-e "$prefix$path") {
12374: system("mv $prefix$path $fullpath/$title");
12375: }
12376: if (-e "$fullpath/$title") {
12377: my $showpath;
12378: if ($relpath ne '') {
12379: $showpath = "$relpath/$title";
12380: } else {
12381: $showpath = "/$title";
1.1056 raeburn 12382: }
1.1075.2.11 raeburn 12383: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12384: }
12385: unless ($ishome) {
12386: my $fetch = "$fullpath/$title";
12387: $fetch =~ s/^\Q$prefix$dir\E//;
12388: $prompttofetch{$fetch} = 1;
1.1055 raeburn 12389: }
12390: }
12391: }
1.1075.2.11 raeburn 12392: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12393: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12394: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12395: }
12396: } else {
1.1075.2.11 raeburn 12397: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055 raeburn 12398: }
12399: }
12400: if (keys(%todelete)) {
12401: foreach my $key (keys(%todelete)) {
12402: unlink($key);
1.1066 raeburn 12403: }
12404: }
12405: if (keys(%todeletedir)) {
12406: foreach my $key (keys(%todeletedir)) {
12407: rmdir($key);
12408: }
12409: }
12410: foreach my $dir (sort(keys(%is_dir))) {
12411: if (($pathtocheck ne '') && ($dir ne '')) {
12412: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12413: }
12414: }
1.1067 raeburn 12415: if ($result ne '') {
12416: $output .= '<ul>'."\n".
12417: $result."\n".
12418: '</ul>';
12419: }
12420: unless ($ishome) {
12421: my $replicationfail;
12422: foreach my $item (keys(%prompttofetch)) {
12423: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12424: unless ($fetchresult eq 'ok') {
12425: $replicationfail .= '<li>'.$item.'</li>'."\n";
12426: }
12427: }
12428: if ($replicationfail) {
12429: $output .= '<p class="LC_error">'.
12430: &mt('Course home server failed to retrieve:').'<ul>'.
12431: $replicationfail.
12432: '</ul></p>';
12433: }
12434: }
1.1055 raeburn 12435: } else {
12436: $warning = &mt('No items found in archive.');
12437: }
12438: if ($error) {
12439: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12440: $error.'</p>'."\n";
12441: }
12442: if ($warning) {
12443: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12444: }
12445: return $output;
12446: }
12447:
1.1066 raeburn 12448: sub cleanup_empty_dirs {
12449: my ($path) = @_;
12450: if (($path ne '') && (-d $path)) {
12451: if (opendir(my $dirh,$path)) {
12452: my @dircontents = grep(!/^\./,readdir($dirh));
12453: my $numitems = 0;
12454: foreach my $item (@dircontents) {
12455: if (-d "$path/$item") {
1.1075.2.28 raeburn 12456: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12457: if (-e "$path/$item") {
12458: $numitems ++;
12459: }
12460: } else {
12461: $numitems ++;
12462: }
12463: }
12464: if ($numitems == 0) {
12465: rmdir($path);
12466: }
12467: closedir($dirh);
12468: }
12469: }
12470: return;
12471: }
12472:
1.41 ng 12473: =pod
1.45 matthew 12474:
1.1075.2.56 raeburn 12475: =item * &get_folder_hierarchy()
1.1068 raeburn 12476:
12477: Provides hierarchy of names of folders/sub-folders containing the current
12478: item,
12479:
12480: Inputs: 3
12481: - $navmap - navmaps object
12482:
12483: - $map - url for map (either the trigger itself, or map containing
12484: the resource, which is the trigger).
12485:
12486: - $showitem - 1 => show title for map itself; 0 => do not show.
12487:
12488: Outputs: 1 @pathitems - array of folder/subfolder names.
12489:
12490: =cut
12491:
12492: sub get_folder_hierarchy {
12493: my ($navmap,$map,$showitem) = @_;
12494: my @pathitems;
12495: if (ref($navmap)) {
12496: my $mapres = $navmap->getResourceByUrl($map);
12497: if (ref($mapres)) {
12498: my $pcslist = $mapres->map_hierarchy();
12499: if ($pcslist ne '') {
12500: my @pcs = split(/,/,$pcslist);
12501: foreach my $pc (@pcs) {
12502: if ($pc == 1) {
1.1075.2.38 raeburn 12503: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12504: } else {
12505: my $res = $navmap->getByMapPc($pc);
12506: if (ref($res)) {
12507: my $title = $res->compTitle();
12508: $title =~ s/\W+/_/g;
12509: if ($title ne '') {
12510: push(@pathitems,$title);
12511: }
12512: }
12513: }
12514: }
12515: }
1.1071 raeburn 12516: if ($showitem) {
12517: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 12518: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12519: } else {
12520: my $maptitle = $mapres->compTitle();
12521: $maptitle =~ s/\W+/_/g;
12522: if ($maptitle ne '') {
12523: push(@pathitems,$maptitle);
12524: }
1.1068 raeburn 12525: }
12526: }
12527: }
12528: }
12529: return @pathitems;
12530: }
12531:
12532: =pod
12533:
1.1015 raeburn 12534: =item * &get_turnedin_filepath()
12535:
12536: Determines path in a user's portfolio file for storage of files uploaded
12537: to a specific essayresponse or dropbox item.
12538:
12539: Inputs: 3 required + 1 optional.
12540: $symb is symb for resource, $uname and $udom are for current user (required).
12541: $caller is optional (can be "submission", if routine is called when storing
12542: an upoaded file when "Submit Answer" button was pressed).
12543:
12544: Returns array containing $path and $multiresp.
12545: $path is path in portfolio. $multiresp is 1 if this resource contains more
12546: than one file upload item. Callers of routine should append partid as a
12547: subdirectory to $path in cases where $multiresp is 1.
12548:
12549: Called by: homework/essayresponse.pm and homework/structuretags.pm
12550:
12551: =cut
12552:
12553: sub get_turnedin_filepath {
12554: my ($symb,$uname,$udom,$caller) = @_;
12555: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12556: my $turnindir;
12557: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12558: $turnindir = $userhash{'turnindir'};
12559: my ($path,$multiresp);
12560: if ($turnindir eq '') {
12561: if ($caller eq 'submission') {
12562: $turnindir = &mt('turned in');
12563: $turnindir =~ s/\W+/_/g;
12564: my %newhash = (
12565: 'turnindir' => $turnindir,
12566: );
12567: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12568: }
12569: }
12570: if ($turnindir ne '') {
12571: $path = '/'.$turnindir.'/';
12572: my ($multipart,$turnin,@pathitems);
12573: my $navmap = Apache::lonnavmaps::navmap->new();
12574: if (defined($navmap)) {
12575: my $mapres = $navmap->getResourceByUrl($map);
12576: if (ref($mapres)) {
12577: my $pcslist = $mapres->map_hierarchy();
12578: if ($pcslist ne '') {
12579: foreach my $pc (split(/,/,$pcslist)) {
12580: my $res = $navmap->getByMapPc($pc);
12581: if (ref($res)) {
12582: my $title = $res->compTitle();
12583: $title =~ s/\W+/_/g;
12584: if ($title ne '') {
1.1075.2.48 raeburn 12585: if (($pc > 1) && (length($title) > 12)) {
12586: $title = substr($title,0,12);
12587: }
1.1015 raeburn 12588: push(@pathitems,$title);
12589: }
12590: }
12591: }
12592: }
12593: my $maptitle = $mapres->compTitle();
12594: $maptitle =~ s/\W+/_/g;
12595: if ($maptitle ne '') {
1.1075.2.48 raeburn 12596: if (length($maptitle) > 12) {
12597: $maptitle = substr($maptitle,0,12);
12598: }
1.1015 raeburn 12599: push(@pathitems,$maptitle);
12600: }
12601: unless ($env{'request.state'} eq 'construct') {
12602: my $res = $navmap->getBySymb($symb);
12603: if (ref($res)) {
12604: my $partlist = $res->parts();
12605: my $totaluploads = 0;
12606: if (ref($partlist) eq 'ARRAY') {
12607: foreach my $part (@{$partlist}) {
12608: my @types = $res->responseType($part);
12609: my @ids = $res->responseIds($part);
12610: for (my $i=0; $i < scalar(@ids); $i++) {
12611: if ($types[$i] eq 'essay') {
12612: my $partid = $part.'_'.$ids[$i];
12613: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12614: $totaluploads ++;
12615: }
12616: }
12617: }
12618: }
12619: if ($totaluploads > 1) {
12620: $multiresp = 1;
12621: }
12622: }
12623: }
12624: }
12625: } else {
12626: return;
12627: }
12628: } else {
12629: return;
12630: }
12631: my $restitle=&Apache::lonnet::gettitle($symb);
12632: $restitle =~ s/\W+/_/g;
12633: if ($restitle eq '') {
12634: $restitle = ($resurl =~ m{/[^/]+$});
12635: if ($restitle eq '') {
12636: $restitle = time;
12637: }
12638: }
1.1075.2.48 raeburn 12639: if (length($restitle) > 12) {
12640: $restitle = substr($restitle,0,12);
12641: }
1.1015 raeburn 12642: push(@pathitems,$restitle);
12643: $path .= join('/',@pathitems);
12644: }
12645: return ($path,$multiresp);
12646: }
12647:
12648: =pod
12649:
1.464 albertel 12650: =back
1.41 ng 12651:
1.112 bowersj2 12652: =head1 CSV Upload/Handling functions
1.38 albertel 12653:
1.41 ng 12654: =over 4
12655:
1.648 raeburn 12656: =item * &upfile_store($r)
1.41 ng 12657:
12658: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12659: needs $env{'form.upfile'}
1.41 ng 12660: returns $datatoken to be put into hidden field
12661:
12662: =cut
1.31 albertel 12663:
12664: sub upfile_store {
12665: my $r=shift;
1.258 albertel 12666: $env{'form.upfile'}=~s/\r/\n/gs;
12667: $env{'form.upfile'}=~s/\f/\n/gs;
12668: $env{'form.upfile'}=~s/\n+/\n/gs;
12669: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12670:
1.258 albertel 12671: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12672: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12673: {
1.158 raeburn 12674: my $datafile = $r->dir_config('lonDaemons').
12675: '/tmp/'.$datatoken.'.tmp';
12676: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12677: print $fh $env{'form.upfile'};
1.158 raeburn 12678: close($fh);
12679: }
1.31 albertel 12680: }
12681: return $datatoken;
12682: }
12683:
1.56 matthew 12684: =pod
12685:
1.648 raeburn 12686: =item * &load_tmp_file($r)
1.41 ng 12687:
12688: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12689: needs $env{'form.datatoken'},
12690: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12691:
12692: =cut
1.31 albertel 12693:
12694: sub load_tmp_file {
12695: my $r=shift;
12696: my @studentdata=();
12697: {
1.158 raeburn 12698: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12699: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12700: if ( open(my $fh,"<$studentfile") ) {
12701: @studentdata=<$fh>;
12702: close($fh);
12703: }
1.31 albertel 12704: }
1.258 albertel 12705: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12706: }
12707:
1.56 matthew 12708: =pod
12709:
1.648 raeburn 12710: =item * &upfile_record_sep()
1.41 ng 12711:
12712: Separate uploaded file into records
12713: returns array of records,
1.258 albertel 12714: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12715:
12716: =cut
1.31 albertel 12717:
12718: sub upfile_record_sep {
1.258 albertel 12719: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12720: } else {
1.248 albertel 12721: my @records;
1.258 albertel 12722: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12723: if ($line=~/^\s*$/) { next; }
12724: push(@records,$line);
12725: }
12726: return @records;
1.31 albertel 12727: }
12728: }
12729:
1.56 matthew 12730: =pod
12731:
1.648 raeburn 12732: =item * &record_sep($record)
1.41 ng 12733:
1.258 albertel 12734: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12735:
12736: =cut
12737:
1.263 www 12738: sub takeleft {
12739: my $index=shift;
12740: return substr('0000'.$index,-4,4);
12741: }
12742:
1.31 albertel 12743: sub record_sep {
12744: my $record=shift;
12745: my %components=();
1.258 albertel 12746: if ($env{'form.upfiletype'} eq 'xml') {
12747: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12748: my $i=0;
1.356 albertel 12749: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12750: $field=~s/^(\"|\')//;
12751: $field=~s/(\"|\')$//;
1.263 www 12752: $components{&takeleft($i)}=$field;
1.31 albertel 12753: $i++;
12754: }
1.258 albertel 12755: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12756: my $i=0;
1.356 albertel 12757: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12758: $field=~s/^(\"|\')//;
12759: $field=~s/(\"|\')$//;
1.263 www 12760: $components{&takeleft($i)}=$field;
1.31 albertel 12761: $i++;
12762: }
12763: } else {
1.561 www 12764: my $separator=',';
1.480 banghart 12765: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12766: $separator=';';
1.480 banghart 12767: }
1.31 albertel 12768: my $i=0;
1.561 www 12769: # the character we are looking for to indicate the end of a quote or a record
12770: my $looking_for=$separator;
12771: # do not add the characters to the fields
12772: my $ignore=0;
12773: # we just encountered a separator (or the beginning of the record)
12774: my $just_found_separator=1;
12775: # store the field we are working on here
12776: my $field='';
12777: # work our way through all characters in record
12778: foreach my $character ($record=~/(.)/g) {
12779: if ($character eq $looking_for) {
12780: if ($character ne $separator) {
12781: # Found the end of a quote, again looking for separator
12782: $looking_for=$separator;
12783: $ignore=1;
12784: } else {
12785: # Found a separator, store away what we got
12786: $components{&takeleft($i)}=$field;
12787: $i++;
12788: $just_found_separator=1;
12789: $ignore=0;
12790: $field='';
12791: }
12792: next;
12793: }
12794: # single or double quotation marks after a separator indicate beginning of a quote
12795: # we are now looking for the end of the quote and need to ignore separators
12796: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12797: $looking_for=$character;
12798: next;
12799: }
12800: # ignore would be true after we reached the end of a quote
12801: if ($ignore) { next; }
12802: if (($just_found_separator) && ($character=~/\s/)) { next; }
12803: $field.=$character;
12804: $just_found_separator=0;
1.31 albertel 12805: }
1.561 www 12806: # catch the very last entry, since we never encountered the separator
12807: $components{&takeleft($i)}=$field;
1.31 albertel 12808: }
12809: return %components;
12810: }
12811:
1.144 matthew 12812: ######################################################
12813: ######################################################
12814:
1.56 matthew 12815: =pod
12816:
1.648 raeburn 12817: =item * &upfile_select_html()
1.41 ng 12818:
1.144 matthew 12819: Return HTML code to select a file from the users machine and specify
12820: the file type.
1.41 ng 12821:
12822: =cut
12823:
1.144 matthew 12824: ######################################################
12825: ######################################################
1.31 albertel 12826: sub upfile_select_html {
1.144 matthew 12827: my %Types = (
12828: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12829: semisv => &mt('Semicolon separated values'),
1.144 matthew 12830: space => &mt('Space separated'),
12831: tab => &mt('Tabulator separated'),
12832: # xml => &mt('HTML/XML'),
12833: );
12834: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12835: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12836: foreach my $type (sort(keys(%Types))) {
12837: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12838: }
12839: $Str .= "</select>\n";
12840: return $Str;
1.31 albertel 12841: }
12842:
1.301 albertel 12843: sub get_samples {
12844: my ($records,$toget) = @_;
12845: my @samples=({});
12846: my $got=0;
12847: foreach my $rec (@$records) {
12848: my %temp = &record_sep($rec);
12849: if (! grep(/\S/, values(%temp))) { next; }
12850: if (%temp) {
12851: $samples[$got]=\%temp;
12852: $got++;
12853: if ($got == $toget) { last; }
12854: }
12855: }
12856: return \@samples;
12857: }
12858:
1.144 matthew 12859: ######################################################
12860: ######################################################
12861:
1.56 matthew 12862: =pod
12863:
1.648 raeburn 12864: =item * &csv_print_samples($r,$records)
1.41 ng 12865:
12866: Prints a table of sample values from each column uploaded $r is an
12867: Apache Request ref, $records is an arrayref from
12868: &Apache::loncommon::upfile_record_sep
12869:
12870: =cut
12871:
1.144 matthew 12872: ######################################################
12873: ######################################################
1.31 albertel 12874: sub csv_print_samples {
12875: my ($r,$records) = @_;
1.662 bisitz 12876: my $samples = &get_samples($records,5);
1.301 albertel 12877:
1.594 raeburn 12878: $r->print(&mt('Samples').'<br />'.&start_data_table().
12879: &start_data_table_header_row());
1.356 albertel 12880: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12881: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12882: $r->print(&end_data_table_header_row());
1.301 albertel 12883: foreach my $hash (@$samples) {
1.594 raeburn 12884: $r->print(&start_data_table_row());
1.356 albertel 12885: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12886: $r->print('<td>');
1.356 albertel 12887: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12888: $r->print('</td>');
12889: }
1.594 raeburn 12890: $r->print(&end_data_table_row());
1.31 albertel 12891: }
1.594 raeburn 12892: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12893: }
12894:
1.144 matthew 12895: ######################################################
12896: ######################################################
12897:
1.56 matthew 12898: =pod
12899:
1.648 raeburn 12900: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12901:
12902: Prints a table to create associations between values and table columns.
1.144 matthew 12903:
1.41 ng 12904: $r is an Apache Request ref,
12905: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12906: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12907:
12908: =cut
12909:
1.144 matthew 12910: ######################################################
12911: ######################################################
1.31 albertel 12912: sub csv_print_select_table {
12913: my ($r,$records,$d) = @_;
1.301 albertel 12914: my $i=0;
12915: my $samples = &get_samples($records,1);
1.144 matthew 12916: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12917: &start_data_table().&start_data_table_header_row().
1.144 matthew 12918: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12919: '<th>'.&mt('Column').'</th>'.
12920: &end_data_table_header_row()."\n");
1.356 albertel 12921: foreach my $array_ref (@$d) {
12922: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12923: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12924:
1.875 bisitz 12925: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12926: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12927: $r->print('<option value="none"></option>');
1.356 albertel 12928: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12929: $r->print('<option value="'.$sample.'"'.
12930: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12931: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12932: }
1.594 raeburn 12933: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12934: $i++;
12935: }
1.594 raeburn 12936: $r->print(&end_data_table());
1.31 albertel 12937: $i--;
12938: return $i;
12939: }
1.56 matthew 12940:
1.144 matthew 12941: ######################################################
12942: ######################################################
12943:
1.56 matthew 12944: =pod
1.31 albertel 12945:
1.648 raeburn 12946: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12947:
12948: Prints a table of sample values from the upload and can make associate samples to internal names.
12949:
12950: $r is an Apache Request ref,
12951: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12952: $d is an array of 2 element arrays (internal name, displayed name)
12953:
12954: =cut
12955:
1.144 matthew 12956: ######################################################
12957: ######################################################
1.31 albertel 12958: sub csv_samples_select_table {
12959: my ($r,$records,$d) = @_;
12960: my $i=0;
1.144 matthew 12961: #
1.662 bisitz 12962: my $max_samples = 5;
12963: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12964: $r->print(&start_data_table().
12965: &start_data_table_header_row().'<th>'.
12966: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12967: &end_data_table_header_row());
1.301 albertel 12968:
12969: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12970: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12971: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12972: foreach my $option (@$d) {
12973: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12974: $r->print('<option value="'.$value.'"'.
1.253 albertel 12975: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12976: $display.'</option>');
1.31 albertel 12977: }
12978: $r->print('</select></td><td>');
1.662 bisitz 12979: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12980: if (defined($samples->[$line]{$key})) {
12981: $r->print($samples->[$line]{$key}."<br />\n");
12982: }
12983: }
1.594 raeburn 12984: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12985: $i++;
12986: }
1.594 raeburn 12987: $r->print(&end_data_table());
1.31 albertel 12988: $i--;
12989: return($i);
1.115 matthew 12990: }
12991:
1.144 matthew 12992: ######################################################
12993: ######################################################
12994:
1.115 matthew 12995: =pod
12996:
1.648 raeburn 12997: =item * &clean_excel_name($name)
1.115 matthew 12998:
12999: Returns a replacement for $name which does not contain any illegal characters.
13000:
13001: =cut
13002:
1.144 matthew 13003: ######################################################
13004: ######################################################
1.115 matthew 13005: sub clean_excel_name {
13006: my ($name) = @_;
13007: $name =~ s/[:\*\?\/\\]//g;
13008: if (length($name) > 31) {
13009: $name = substr($name,0,31);
13010: }
13011: return $name;
1.25 albertel 13012: }
1.84 albertel 13013:
1.85 albertel 13014: =pod
13015:
1.648 raeburn 13016: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13017:
13018: Returns either 1 or undef
13019:
13020: 1 if the part is to be hidden, undef if it is to be shown
13021:
13022: Arguments are:
13023:
13024: $id the id of the part to be checked
13025: $symb, optional the symb of the resource to check
13026: $udom, optional the domain of the user to check for
13027: $uname, optional the username of the user to check for
13028:
13029: =cut
1.84 albertel 13030:
13031: sub check_if_partid_hidden {
13032: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13033: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13034: $symb,$udom,$uname);
1.141 albertel 13035: my $truth=1;
13036: #if the string starts with !, then the list is the list to show not hide
13037: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13038: my @hiddenlist=split(/,/,$hiddenparts);
13039: foreach my $checkid (@hiddenlist) {
1.141 albertel 13040: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13041: }
1.141 albertel 13042: return !$truth;
1.84 albertel 13043: }
1.127 matthew 13044:
1.138 matthew 13045:
13046: ############################################################
13047: ############################################################
13048:
13049: =pod
13050:
1.157 matthew 13051: =back
13052:
1.138 matthew 13053: =head1 cgi-bin script and graphing routines
13054:
1.157 matthew 13055: =over 4
13056:
1.648 raeburn 13057: =item * &get_cgi_id()
1.138 matthew 13058:
13059: Inputs: none
13060:
13061: Returns an id which can be used to pass environment variables
13062: to various cgi-bin scripts. These environment variables will
13063: be removed from the users environment after a given time by
13064: the routine &Apache::lonnet::transfer_profile_to_env.
13065:
13066: =cut
13067:
13068: ############################################################
13069: ############################################################
1.152 albertel 13070: my $uniq=0;
1.136 matthew 13071: sub get_cgi_id {
1.154 albertel 13072: $uniq=($uniq+1)%100000;
1.280 albertel 13073: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13074: }
13075:
1.127 matthew 13076: ############################################################
13077: ############################################################
13078:
13079: =pod
13080:
1.648 raeburn 13081: =item * &DrawBarGraph()
1.127 matthew 13082:
1.138 matthew 13083: Facilitates the plotting of data in a (stacked) bar graph.
13084: Puts plot definition data into the users environment in order for
13085: graph.png to plot it. Returns an <img> tag for the plot.
13086: The bars on the plot are labeled '1','2',...,'n'.
13087:
13088: Inputs:
13089:
13090: =over 4
13091:
13092: =item $Title: string, the title of the plot
13093:
13094: =item $xlabel: string, text describing the X-axis of the plot
13095:
13096: =item $ylabel: string, text describing the Y-axis of the plot
13097:
13098: =item $Max: scalar, the maximum Y value to use in the plot
13099: If $Max is < any data point, the graph will not be rendered.
13100:
1.140 matthew 13101: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13102: they are plotted. If undefined, default values will be used.
13103:
1.178 matthew 13104: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13105:
1.138 matthew 13106: =item @Values: An array of array references. Each array reference holds data
13107: to be plotted in a stacked bar chart.
13108:
1.239 matthew 13109: =item If the final element of @Values is a hash reference the key/value
13110: pairs will be added to the graph definition.
13111:
1.138 matthew 13112: =back
13113:
13114: Returns:
13115:
13116: An <img> tag which references graph.png and the appropriate identifying
13117: information for the plot.
13118:
1.127 matthew 13119: =cut
13120:
13121: ############################################################
13122: ############################################################
1.134 matthew 13123: sub DrawBarGraph {
1.178 matthew 13124: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13125: #
13126: if (! defined($colors)) {
13127: $colors = ['#33ff00',
13128: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13129: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13130: ];
13131: }
1.228 matthew 13132: my $extra_settings = {};
13133: if (ref($Values[-1]) eq 'HASH') {
13134: $extra_settings = pop(@Values);
13135: }
1.127 matthew 13136: #
1.136 matthew 13137: my $identifier = &get_cgi_id();
13138: my $id = 'cgi.'.$identifier;
1.129 matthew 13139: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13140: return '';
13141: }
1.225 matthew 13142: #
13143: my @Labels;
13144: if (defined($labels)) {
13145: @Labels = @$labels;
13146: } else {
13147: for (my $i=0;$i<@{$Values[0]};$i++) {
13148: push (@Labels,$i+1);
13149: }
13150: }
13151: #
1.129 matthew 13152: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13153: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13154: my %ValuesHash;
13155: my $NumSets=1;
13156: foreach my $array (@Values) {
13157: next if (! ref($array));
1.136 matthew 13158: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13159: join(',',@$array);
1.129 matthew 13160: }
1.127 matthew 13161: #
1.136 matthew 13162: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13163: if ($NumBars < 3) {
13164: $width = 120+$NumBars*32;
1.220 matthew 13165: $xskip = 1;
1.225 matthew 13166: $bar_width = 30;
13167: } elsif ($NumBars < 5) {
13168: $width = 120+$NumBars*20;
13169: $xskip = 1;
13170: $bar_width = 20;
1.220 matthew 13171: } elsif ($NumBars < 10) {
1.136 matthew 13172: $width = 120+$NumBars*15;
13173: $xskip = 1;
13174: $bar_width = 15;
13175: } elsif ($NumBars <= 25) {
13176: $width = 120+$NumBars*11;
13177: $xskip = 5;
13178: $bar_width = 8;
13179: } elsif ($NumBars <= 50) {
13180: $width = 120+$NumBars*8;
13181: $xskip = 5;
13182: $bar_width = 4;
13183: } else {
13184: $width = 120+$NumBars*8;
13185: $xskip = 5;
13186: $bar_width = 4;
13187: }
13188: #
1.137 matthew 13189: $Max = 1 if ($Max < 1);
13190: if ( int($Max) < $Max ) {
13191: $Max++;
13192: $Max = int($Max);
13193: }
1.127 matthew 13194: $Title = '' if (! defined($Title));
13195: $xlabel = '' if (! defined($xlabel));
13196: $ylabel = '' if (! defined($ylabel));
1.369 www 13197: $ValuesHash{$id.'.title'} = &escape($Title);
13198: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13199: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13200: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13201: $ValuesHash{$id.'.NumBars'} = $NumBars;
13202: $ValuesHash{$id.'.NumSets'} = $NumSets;
13203: $ValuesHash{$id.'.PlotType'} = 'bar';
13204: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13205: $ValuesHash{$id.'.height'} = $height;
13206: $ValuesHash{$id.'.width'} = $width;
13207: $ValuesHash{$id.'.xskip'} = $xskip;
13208: $ValuesHash{$id.'.bar_width'} = $bar_width;
13209: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13210: #
1.228 matthew 13211: # Deal with other parameters
13212: while (my ($key,$value) = each(%$extra_settings)) {
13213: $ValuesHash{$id.'.'.$key} = $value;
13214: }
13215: #
1.646 raeburn 13216: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13217: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13218: }
13219:
13220: ############################################################
13221: ############################################################
13222:
13223: =pod
13224:
1.648 raeburn 13225: =item * &DrawXYGraph()
1.137 matthew 13226:
1.138 matthew 13227: Facilitates the plotting of data in an XY graph.
13228: Puts plot definition data into the users environment in order for
13229: graph.png to plot it. Returns an <img> tag for the plot.
13230:
13231: Inputs:
13232:
13233: =over 4
13234:
13235: =item $Title: string, the title of the plot
13236:
13237: =item $xlabel: string, text describing the X-axis of the plot
13238:
13239: =item $ylabel: string, text describing the Y-axis of the plot
13240:
13241: =item $Max: scalar, the maximum Y value to use in the plot
13242: If $Max is < any data point, the graph will not be rendered.
13243:
13244: =item $colors: Array ref containing the hex color codes for the data to be
13245: plotted in. If undefined, default values will be used.
13246:
13247: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13248:
13249: =item $Ydata: Array ref containing Array refs.
1.185 www 13250: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13251:
13252: =item %Values: hash indicating or overriding any default values which are
13253: passed to graph.png.
13254: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13255:
13256: =back
13257:
13258: Returns:
13259:
13260: An <img> tag which references graph.png and the appropriate identifying
13261: information for the plot.
13262:
1.137 matthew 13263: =cut
13264:
13265: ############################################################
13266: ############################################################
13267: sub DrawXYGraph {
13268: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13269: #
13270: # Create the identifier for the graph
13271: my $identifier = &get_cgi_id();
13272: my $id = 'cgi.'.$identifier;
13273: #
13274: $Title = '' if (! defined($Title));
13275: $xlabel = '' if (! defined($xlabel));
13276: $ylabel = '' if (! defined($ylabel));
13277: my %ValuesHash =
13278: (
1.369 www 13279: $id.'.title' => &escape($Title),
13280: $id.'.xlabel' => &escape($xlabel),
13281: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13282: $id.'.y_max_value'=> $Max,
13283: $id.'.labels' => join(',',@$Xlabels),
13284: $id.'.PlotType' => 'XY',
13285: );
13286: #
13287: if (defined($colors) && ref($colors) eq 'ARRAY') {
13288: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13289: }
13290: #
13291: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13292: return '';
13293: }
13294: my $NumSets=1;
1.138 matthew 13295: foreach my $array (@{$Ydata}){
1.137 matthew 13296: next if (! ref($array));
13297: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13298: }
1.138 matthew 13299: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13300: #
13301: # Deal with other parameters
13302: while (my ($key,$value) = each(%Values)) {
13303: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13304: }
13305: #
1.646 raeburn 13306: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13307: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13308: }
13309:
13310: ############################################################
13311: ############################################################
13312:
13313: =pod
13314:
1.648 raeburn 13315: =item * &DrawXYYGraph()
1.138 matthew 13316:
13317: Facilitates the plotting of data in an XY graph with two Y axes.
13318: Puts plot definition data into the users environment in order for
13319: graph.png to plot it. Returns an <img> tag for the plot.
13320:
13321: Inputs:
13322:
13323: =over 4
13324:
13325: =item $Title: string, the title of the plot
13326:
13327: =item $xlabel: string, text describing the X-axis of the plot
13328:
13329: =item $ylabel: string, text describing the Y-axis of the plot
13330:
13331: =item $colors: Array ref containing the hex color codes for the data to be
13332: plotted in. If undefined, default values will be used.
13333:
13334: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13335:
13336: =item $Ydata1: The first data set
13337:
13338: =item $Min1: The minimum value of the left Y-axis
13339:
13340: =item $Max1: The maximum value of the left Y-axis
13341:
13342: =item $Ydata2: The second data set
13343:
13344: =item $Min2: The minimum value of the right Y-axis
13345:
13346: =item $Max2: The maximum value of the left Y-axis
13347:
13348: =item %Values: hash indicating or overriding any default values which are
13349: passed to graph.png.
13350: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13351:
13352: =back
13353:
13354: Returns:
13355:
13356: An <img> tag which references graph.png and the appropriate identifying
13357: information for the plot.
1.136 matthew 13358:
13359: =cut
13360:
13361: ############################################################
13362: ############################################################
1.137 matthew 13363: sub DrawXYYGraph {
13364: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13365: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13366: #
13367: # Create the identifier for the graph
13368: my $identifier = &get_cgi_id();
13369: my $id = 'cgi.'.$identifier;
13370: #
13371: $Title = '' if (! defined($Title));
13372: $xlabel = '' if (! defined($xlabel));
13373: $ylabel = '' if (! defined($ylabel));
13374: my %ValuesHash =
13375: (
1.369 www 13376: $id.'.title' => &escape($Title),
13377: $id.'.xlabel' => &escape($xlabel),
13378: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13379: $id.'.labels' => join(',',@$Xlabels),
13380: $id.'.PlotType' => 'XY',
13381: $id.'.NumSets' => 2,
1.137 matthew 13382: $id.'.two_axes' => 1,
13383: $id.'.y1_max_value' => $Max1,
13384: $id.'.y1_min_value' => $Min1,
13385: $id.'.y2_max_value' => $Max2,
13386: $id.'.y2_min_value' => $Min2,
1.136 matthew 13387: );
13388: #
1.137 matthew 13389: if (defined($colors) && ref($colors) eq 'ARRAY') {
13390: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13391: }
13392: #
13393: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13394: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13395: return '';
13396: }
13397: my $NumSets=1;
1.137 matthew 13398: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13399: next if (! ref($array));
13400: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13401: }
13402: #
13403: # Deal with other parameters
13404: while (my ($key,$value) = each(%Values)) {
13405: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13406: }
13407: #
1.646 raeburn 13408: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13409: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13410: }
13411:
13412: ############################################################
13413: ############################################################
13414:
13415: =pod
13416:
1.157 matthew 13417: =back
13418:
1.139 matthew 13419: =head1 Statistics helper routines?
13420:
13421: Bad place for them but what the hell.
13422:
1.157 matthew 13423: =over 4
13424:
1.648 raeburn 13425: =item * &chartlink()
1.139 matthew 13426:
13427: Returns a link to the chart for a specific student.
13428:
13429: Inputs:
13430:
13431: =over 4
13432:
13433: =item $linktext: The text of the link
13434:
13435: =item $sname: The students username
13436:
13437: =item $sdomain: The students domain
13438:
13439: =back
13440:
1.157 matthew 13441: =back
13442:
1.139 matthew 13443: =cut
13444:
13445: ############################################################
13446: ############################################################
13447: sub chartlink {
13448: my ($linktext, $sname, $sdomain) = @_;
13449: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13450: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13451: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13452: '">'.$linktext.'</a>';
1.153 matthew 13453: }
13454:
13455: #######################################################
13456: #######################################################
13457:
13458: =pod
13459:
13460: =head1 Course Environment Routines
1.157 matthew 13461:
13462: =over 4
1.153 matthew 13463:
1.648 raeburn 13464: =item * &restore_course_settings()
1.153 matthew 13465:
1.648 raeburn 13466: =item * &store_course_settings()
1.153 matthew 13467:
13468: Restores/Store indicated form parameters from the course environment.
13469: Will not overwrite existing values of the form parameters.
13470:
13471: Inputs:
13472: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13473:
13474: a hash ref describing the data to be stored. For example:
13475:
13476: %Save_Parameters = ('Status' => 'scalar',
13477: 'chartoutputmode' => 'scalar',
13478: 'chartoutputdata' => 'scalar',
13479: 'Section' => 'array',
1.373 raeburn 13480: 'Group' => 'array',
1.153 matthew 13481: 'StudentData' => 'array',
13482: 'Maps' => 'array');
13483:
13484: Returns: both routines return nothing
13485:
1.631 raeburn 13486: =back
13487:
1.153 matthew 13488: =cut
13489:
13490: #######################################################
13491: #######################################################
13492: sub store_course_settings {
1.496 albertel 13493: return &store_settings($env{'request.course.id'},@_);
13494: }
13495:
13496: sub store_settings {
1.153 matthew 13497: # save to the environment
13498: # appenv the same items, just to be safe
1.300 albertel 13499: my $udom = $env{'user.domain'};
13500: my $uname = $env{'user.name'};
1.496 albertel 13501: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13502: my %SaveHash;
13503: my %AppHash;
13504: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13505: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13506: my $envname = 'environment.'.$basename;
1.258 albertel 13507: if (exists($env{'form.'.$setting})) {
1.153 matthew 13508: # Save this value away
13509: if ($type eq 'scalar' &&
1.258 albertel 13510: (! exists($env{$envname}) ||
13511: $env{$envname} ne $env{'form.'.$setting})) {
13512: $SaveHash{$basename} = $env{'form.'.$setting};
13513: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13514: } elsif ($type eq 'array') {
13515: my $stored_form;
1.258 albertel 13516: if (ref($env{'form.'.$setting})) {
1.153 matthew 13517: $stored_form = join(',',
13518: map {
1.369 www 13519: &escape($_);
1.258 albertel 13520: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13521: } else {
13522: $stored_form =
1.369 www 13523: &escape($env{'form.'.$setting});
1.153 matthew 13524: }
13525: # Determine if the array contents are the same.
1.258 albertel 13526: if ($stored_form ne $env{$envname}) {
1.153 matthew 13527: $SaveHash{$basename} = $stored_form;
13528: $AppHash{$envname} = $stored_form;
13529: }
13530: }
13531: }
13532: }
13533: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13534: $udom,$uname);
1.153 matthew 13535: if ($put_result !~ /^(ok|delayed)/) {
13536: &Apache::lonnet::logthis('unable to save form parameters, '.
13537: 'got error:'.$put_result);
13538: }
13539: # Make sure these settings stick around in this session, too
1.646 raeburn 13540: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13541: return;
13542: }
13543:
13544: sub restore_course_settings {
1.499 albertel 13545: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13546: }
13547:
13548: sub restore_settings {
13549: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13550: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13551: next if (exists($env{'form.'.$setting}));
1.496 albertel 13552: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13553: '.'.$setting;
1.258 albertel 13554: if (exists($env{$envname})) {
1.153 matthew 13555: if ($type eq 'scalar') {
1.258 albertel 13556: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13557: } elsif ($type eq 'array') {
1.258 albertel 13558: $env{'form.'.$setting} = [
1.153 matthew 13559: map {
1.369 www 13560: &unescape($_);
1.258 albertel 13561: } split(',',$env{$envname})
1.153 matthew 13562: ];
13563: }
13564: }
13565: }
1.127 matthew 13566: }
13567:
1.618 raeburn 13568: #######################################################
13569: #######################################################
13570:
13571: =pod
13572:
13573: =head1 Domain E-mail Routines
13574:
13575: =over 4
13576:
1.648 raeburn 13577: =item * &build_recipient_list()
1.618 raeburn 13578:
1.1075.2.44 raeburn 13579: Build recipient lists for following types of e-mail:
1.766 raeburn 13580: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 13581: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13582: module change checking, student/employee ID conflict checks, as
13583: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13584: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13585:
13586: Inputs:
1.1075.2.44 raeburn 13587: defmail (scalar - email address of default recipient),
13588: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13589: requestsmail, updatesmail, or idconflictsmail).
13590:
1.619 raeburn 13591: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 13592:
13593: origmail (scalar - email address of recipient from loncapa.conf,
13594: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13595:
1.655 raeburn 13596: Returns: comma separated list of addresses to which to send e-mail.
13597:
13598: =back
1.618 raeburn 13599:
13600: =cut
13601:
13602: ############################################################
13603: ############################################################
13604: sub build_recipient_list {
1.619 raeburn 13605: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13606: my @recipients;
13607: my $otheremails;
13608: my %domconfig =
13609: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13610: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13611: if (exists($domconfig{'contacts'}{$mailing})) {
13612: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13613: my @contacts = ('adminemail','supportemail');
13614: foreach my $item (@contacts) {
13615: if ($domconfig{'contacts'}{$mailing}{$item}) {
13616: my $addr = $domconfig{'contacts'}{$item};
13617: if (!grep(/^\Q$addr\E$/,@recipients)) {
13618: push(@recipients,$addr);
13619: }
1.619 raeburn 13620: }
1.766 raeburn 13621: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13622: }
13623: }
1.766 raeburn 13624: } elsif ($origmail ne '') {
13625: push(@recipients,$origmail);
1.618 raeburn 13626: }
1.619 raeburn 13627: } elsif ($origmail ne '') {
13628: push(@recipients,$origmail);
1.618 raeburn 13629: }
1.688 raeburn 13630: if (defined($defmail)) {
13631: if ($defmail ne '') {
13632: push(@recipients,$defmail);
13633: }
1.618 raeburn 13634: }
13635: if ($otheremails) {
1.619 raeburn 13636: my @others;
13637: if ($otheremails =~ /,/) {
13638: @others = split(/,/,$otheremails);
1.618 raeburn 13639: } else {
1.619 raeburn 13640: push(@others,$otheremails);
13641: }
13642: foreach my $addr (@others) {
13643: if (!grep(/^\Q$addr\E$/,@recipients)) {
13644: push(@recipients,$addr);
13645: }
1.618 raeburn 13646: }
13647: }
1.619 raeburn 13648: my $recipientlist = join(',',@recipients);
1.618 raeburn 13649: return $recipientlist;
13650: }
13651:
1.127 matthew 13652: ############################################################
13653: ############################################################
1.154 albertel 13654:
1.655 raeburn 13655: =pod
13656:
13657: =head1 Course Catalog Routines
13658:
13659: =over 4
13660:
13661: =item * &gather_categories()
13662:
13663: Converts category definitions - keys of categories hash stored in
13664: coursecategories in configuration.db on the primary library server in a
13665: domain - to an array. Also generates javascript and idx hash used to
13666: generate Domain Coordinator interface for editing Course Categories.
13667:
13668: Inputs:
1.663 raeburn 13669:
1.655 raeburn 13670: categories (reference to hash of category definitions).
1.663 raeburn 13671:
1.655 raeburn 13672: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13673: categories and subcategories).
1.663 raeburn 13674:
1.655 raeburn 13675: idx (reference to hash of counters used in Domain Coordinator interface for
13676: editing Course Categories).
1.663 raeburn 13677:
1.655 raeburn 13678: jsarray (reference to array of categories used to create Javascript arrays for
13679: Domain Coordinator interface for editing Course Categories).
13680:
13681: Returns: nothing
13682:
13683: Side effects: populates cats, idx and jsarray.
13684:
13685: =cut
13686:
13687: sub gather_categories {
13688: my ($categories,$cats,$idx,$jsarray) = @_;
13689: my %counters;
13690: my $num = 0;
13691: foreach my $item (keys(%{$categories})) {
13692: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13693: if ($container eq '' && $depth == 0) {
13694: $cats->[$depth][$categories->{$item}] = $cat;
13695: } else {
13696: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13697: }
13698: my ($escitem,$tail) = split(/:/,$item,2);
13699: if ($counters{$tail} eq '') {
13700: $counters{$tail} = $num;
13701: $num ++;
13702: }
13703: if (ref($idx) eq 'HASH') {
13704: $idx->{$item} = $counters{$tail};
13705: }
13706: if (ref($jsarray) eq 'ARRAY') {
13707: push(@{$jsarray->[$counters{$tail}]},$item);
13708: }
13709: }
13710: return;
13711: }
13712:
13713: =pod
13714:
13715: =item * &extract_categories()
13716:
13717: Used to generate breadcrumb trails for course categories.
13718:
13719: Inputs:
1.663 raeburn 13720:
1.655 raeburn 13721: categories (reference to hash of category definitions).
1.663 raeburn 13722:
1.655 raeburn 13723: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13724: categories and subcategories).
1.663 raeburn 13725:
1.655 raeburn 13726: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13727:
1.655 raeburn 13728: allitems (reference to hash - key is category key
13729: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13730:
1.655 raeburn 13731: idx (reference to hash of counters used in Domain Coordinator interface for
13732: editing Course Categories).
1.663 raeburn 13733:
1.655 raeburn 13734: jsarray (reference to array of categories used to create Javascript arrays for
13735: Domain Coordinator interface for editing Course Categories).
13736:
1.665 raeburn 13737: subcats (reference to hash of arrays containing all subcategories within each
13738: category, -recursive)
13739:
1.655 raeburn 13740: Returns: nothing
13741:
13742: Side effects: populates trails and allitems hash references.
13743:
13744: =cut
13745:
13746: sub extract_categories {
1.665 raeburn 13747: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13748: if (ref($categories) eq 'HASH') {
13749: &gather_categories($categories,$cats,$idx,$jsarray);
13750: if (ref($cats->[0]) eq 'ARRAY') {
13751: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13752: my $name = $cats->[0][$i];
13753: my $item = &escape($name).'::0';
13754: my $trailstr;
13755: if ($name eq 'instcode') {
13756: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13757: } elsif ($name eq 'communities') {
13758: $trailstr = &mt('Communities');
1.655 raeburn 13759: } else {
13760: $trailstr = $name;
13761: }
13762: if ($allitems->{$item} eq '') {
13763: push(@{$trails},$trailstr);
13764: $allitems->{$item} = scalar(@{$trails})-1;
13765: }
13766: my @parents = ($name);
13767: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13768: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13769: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13770: if (ref($subcats) eq 'HASH') {
13771: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13772: }
13773: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13774: }
13775: } else {
13776: if (ref($subcats) eq 'HASH') {
13777: $subcats->{$item} = [];
1.655 raeburn 13778: }
13779: }
13780: }
13781: }
13782: }
13783: return;
13784: }
13785:
13786: =pod
13787:
1.1075.2.56 raeburn 13788: =item * &recurse_categories()
1.655 raeburn 13789:
13790: Recursively used to generate breadcrumb trails for course categories.
13791:
13792: Inputs:
1.663 raeburn 13793:
1.655 raeburn 13794: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13795: categories and subcategories).
1.663 raeburn 13796:
1.655 raeburn 13797: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13798:
13799: category (current course category, for which breadcrumb trail is being generated).
13800:
13801: trails (reference to array of breadcrumb trails for each category).
13802:
1.655 raeburn 13803: allitems (reference to hash - key is category key
13804: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13805:
1.655 raeburn 13806: parents (array containing containers directories for current category,
13807: back to top level).
13808:
13809: Returns: nothing
13810:
13811: Side effects: populates trails and allitems hash references
13812:
13813: =cut
13814:
13815: sub recurse_categories {
1.665 raeburn 13816: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13817: my $shallower = $depth - 1;
13818: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13819: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13820: my $name = $cats->[$depth]{$category}[$k];
13821: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13822: my $trailstr = join(' -> ',(@{$parents},$category));
13823: if ($allitems->{$item} eq '') {
13824: push(@{$trails},$trailstr);
13825: $allitems->{$item} = scalar(@{$trails})-1;
13826: }
13827: my $deeper = $depth+1;
13828: push(@{$parents},$category);
1.665 raeburn 13829: if (ref($subcats) eq 'HASH') {
13830: my $subcat = &escape($name).':'.$category.':'.$depth;
13831: for (my $j=@{$parents}; $j>=0; $j--) {
13832: my $higher;
13833: if ($j > 0) {
13834: $higher = &escape($parents->[$j]).':'.
13835: &escape($parents->[$j-1]).':'.$j;
13836: } else {
13837: $higher = &escape($parents->[$j]).'::'.$j;
13838: }
13839: push(@{$subcats->{$higher}},$subcat);
13840: }
13841: }
13842: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13843: $subcats);
1.655 raeburn 13844: pop(@{$parents});
13845: }
13846: } else {
13847: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13848: my $trailstr = join(' -> ',(@{$parents},$category));
13849: if ($allitems->{$item} eq '') {
13850: push(@{$trails},$trailstr);
13851: $allitems->{$item} = scalar(@{$trails})-1;
13852: }
13853: }
13854: return;
13855: }
13856:
1.663 raeburn 13857: =pod
13858:
1.1075.2.56 raeburn 13859: =item * &assign_categories_table()
1.663 raeburn 13860:
13861: Create a datatable for display of hierarchical categories in a domain,
13862: with checkboxes to allow a course to be categorized.
13863:
13864: Inputs:
13865:
13866: cathash - reference to hash of categories defined for the domain (from
13867: configuration.db)
13868:
13869: currcat - scalar with an & separated list of categories assigned to a course.
13870:
1.919 raeburn 13871: type - scalar contains course type (Course or Community).
13872:
1.663 raeburn 13873: Returns: $output (markup to be displayed)
13874:
13875: =cut
13876:
13877: sub assign_categories_table {
1.919 raeburn 13878: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13879: my $output;
13880: if (ref($cathash) eq 'HASH') {
13881: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13882: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13883: $maxdepth = scalar(@cats);
13884: if (@cats > 0) {
13885: my $itemcount = 0;
13886: if (ref($cats[0]) eq 'ARRAY') {
13887: my @currcategories;
13888: if ($currcat ne '') {
13889: @currcategories = split('&',$currcat);
13890: }
1.919 raeburn 13891: my $table;
1.663 raeburn 13892: for (my $i=0; $i<@{$cats[0]}; $i++) {
13893: my $parent = $cats[0][$i];
1.919 raeburn 13894: next if ($parent eq 'instcode');
13895: if ($type eq 'Community') {
13896: next unless ($parent eq 'communities');
13897: } else {
13898: next if ($parent eq 'communities');
13899: }
1.663 raeburn 13900: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13901: my $item = &escape($parent).'::0';
13902: my $checked = '';
13903: if (@currcategories > 0) {
13904: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13905: $checked = ' checked="checked"';
1.663 raeburn 13906: }
13907: }
1.919 raeburn 13908: my $parent_title = $parent;
13909: if ($parent eq 'communities') {
13910: $parent_title = &mt('Communities');
13911: }
13912: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13913: '<input type="checkbox" name="usecategory" value="'.
13914: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13915: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13916: my $depth = 1;
13917: push(@path,$parent);
1.919 raeburn 13918: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13919: pop(@path);
1.919 raeburn 13920: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13921: $itemcount ++;
13922: }
1.919 raeburn 13923: if ($itemcount) {
13924: $output = &Apache::loncommon::start_data_table().
13925: $table.
13926: &Apache::loncommon::end_data_table();
13927: }
1.663 raeburn 13928: }
13929: }
13930: }
13931: return $output;
13932: }
13933:
13934: =pod
13935:
1.1075.2.56 raeburn 13936: =item * &assign_category_rows()
1.663 raeburn 13937:
13938: Create a datatable row for display of nested categories in a domain,
13939: with checkboxes to allow a course to be categorized,called recursively.
13940:
13941: Inputs:
13942:
13943: itemcount - track row number for alternating colors
13944:
13945: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13946: categories and subcategories.
13947:
13948: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13949:
13950: parent - parent of current category item
13951:
13952: path - Array containing all categories back up through the hierarchy from the
13953: current category to the top level.
13954:
13955: currcategories - reference to array of current categories assigned to the course
13956:
13957: Returns: $output (markup to be displayed).
13958:
13959: =cut
13960:
13961: sub assign_category_rows {
13962: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13963: my ($text,$name,$item,$chgstr);
13964: if (ref($cats) eq 'ARRAY') {
13965: my $maxdepth = scalar(@{$cats});
13966: if (ref($cats->[$depth]) eq 'HASH') {
13967: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13968: my $numchildren = @{$cats->[$depth]{$parent}};
13969: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 13970: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13971: for (my $j=0; $j<$numchildren; $j++) {
13972: $name = $cats->[$depth]{$parent}[$j];
13973: $item = &escape($name).':'.&escape($parent).':'.$depth;
13974: my $deeper = $depth+1;
13975: my $checked = '';
13976: if (ref($currcategories) eq 'ARRAY') {
13977: if (@{$currcategories} > 0) {
13978: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13979: $checked = ' checked="checked"';
1.663 raeburn 13980: }
13981: }
13982: }
1.664 raeburn 13983: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13984: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13985: $item.'"'.$checked.' />'.$name.'</label></span>'.
13986: '<input type="hidden" name="catname" value="'.$name.'" />'.
13987: '</td><td>';
1.663 raeburn 13988: if (ref($path) eq 'ARRAY') {
13989: push(@{$path},$name);
13990: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13991: pop(@{$path});
13992: }
13993: $text .= '</td></tr>';
13994: }
13995: $text .= '</table></td>';
13996: }
13997: }
13998: }
13999: return $text;
14000: }
14001:
1.1075.2.69 raeburn 14002: =pod
14003:
14004: =back
14005:
14006: =cut
14007:
1.655 raeburn 14008: ############################################################
14009: ############################################################
14010:
14011:
1.443 albertel 14012: sub commit_customrole {
1.664 raeburn 14013: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14014: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14015: ($start?', '.&mt('starting').' '.localtime($start):'').
14016: ($end?', ending '.localtime($end):'').': <b>'.
14017: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14018: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14019: '</b><br />';
14020: return $output;
14021: }
14022:
14023: sub commit_standardrole {
1.1075.2.31 raeburn 14024: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14025: my ($output,$logmsg,$linefeed);
14026: if ($context eq 'auto') {
14027: $linefeed = "\n";
14028: } else {
14029: $linefeed = "<br />\n";
14030: }
1.443 albertel 14031: if ($three eq 'st') {
1.541 raeburn 14032: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 14033: $one,$two,$sec,$context,$credits);
1.541 raeburn 14034: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14035: ($result eq 'unknown_course') || ($result eq 'refused')) {
14036: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14037: } else {
1.541 raeburn 14038: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14039: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14040: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14041: if ($context eq 'auto') {
14042: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14043: } else {
14044: $output .= '<b>'.$result.'</b>'.$linefeed.
14045: &mt('Add to classlist').': <b>ok</b>';
14046: }
14047: $output .= $linefeed;
1.443 albertel 14048: }
14049: } else {
14050: $output = &mt('Assigning').' '.$three.' in '.$url.
14051: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14052: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14053: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14054: if ($context eq 'auto') {
14055: $output .= $result.$linefeed;
14056: } else {
14057: $output .= '<b>'.$result.'</b>'.$linefeed;
14058: }
1.443 albertel 14059: }
14060: return $output;
14061: }
14062:
14063: sub commit_studentrole {
1.1075.2.31 raeburn 14064: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
14065: $credits) = @_;
1.626 raeburn 14066: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 14067: if ($context eq 'auto') {
14068: $linefeed = "\n";
14069: } else {
14070: $linefeed = '<br />'."\n";
14071: }
1.443 albertel 14072: if (defined($one) && defined($two)) {
14073: my $cid=$one.'_'.$two;
14074: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
14075: my $secchange = 0;
14076: my $expire_role_result;
14077: my $modify_section_result;
1.628 raeburn 14078: if ($oldsec ne '-1') {
14079: if ($oldsec ne $sec) {
1.443 albertel 14080: $secchange = 1;
1.628 raeburn 14081: my $now = time;
1.443 albertel 14082: my $uurl='/'.$cid;
14083: $uurl=~s/\_/\//g;
14084: if ($oldsec) {
14085: $uurl.='/'.$oldsec;
14086: }
1.626 raeburn 14087: $oldsecurl = $uurl;
1.628 raeburn 14088: $expire_role_result =
1.652 raeburn 14089: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 14090: if ($env{'request.course.sec'} ne '') {
14091: if ($expire_role_result eq 'refused') {
14092: my @roles = ('st');
14093: my @statuses = ('previous');
14094: my @roledoms = ($one);
14095: my $withsec = 1;
14096: my %roleshash =
14097: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
14098: \@statuses,\@roles,\@roledoms,$withsec);
14099: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
14100: my ($oldstart,$oldend) =
14101: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
14102: if ($oldend > 0 && $oldend <= $now) {
14103: $expire_role_result = 'ok';
14104: }
14105: }
14106: }
14107: }
1.443 albertel 14108: $result = $expire_role_result;
14109: }
14110: }
14111: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 14112: $modify_section_result =
14113: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
14114: undef,undef,undef,$sec,
14115: $end,$start,'','',$cid,
14116: '',$context,$credits);
1.443 albertel 14117: if ($modify_section_result =~ /^ok/) {
14118: if ($secchange == 1) {
1.628 raeburn 14119: if ($sec eq '') {
14120: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14121: } else {
14122: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14123: }
1.443 albertel 14124: } elsif ($oldsec eq '-1') {
1.628 raeburn 14125: if ($sec eq '') {
14126: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14127: } else {
14128: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14129: }
1.443 albertel 14130: } else {
1.628 raeburn 14131: if ($sec eq '') {
14132: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14133: } else {
14134: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14135: }
1.443 albertel 14136: }
14137: } else {
1.628 raeburn 14138: if ($secchange) {
14139: $$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;
14140: } else {
14141: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14142: }
1.443 albertel 14143: }
14144: $result = $modify_section_result;
14145: } elsif ($secchange == 1) {
1.628 raeburn 14146: if ($oldsec eq '') {
1.1075.2.20 raeburn 14147: $$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 14148: } else {
14149: $$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;
14150: }
1.626 raeburn 14151: if ($expire_role_result eq 'refused') {
14152: my $newsecurl = '/'.$cid;
14153: $newsecurl =~ s/\_/\//g;
14154: if ($sec ne '') {
14155: $newsecurl.='/'.$sec;
14156: }
14157: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14158: if ($sec eq '') {
14159: $$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;
14160: } else {
14161: $$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;
14162: }
14163: }
14164: }
1.443 albertel 14165: }
14166: } else {
1.626 raeburn 14167: $$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 14168: $result = "error: incomplete course id\n";
14169: }
14170: return $result;
14171: }
14172:
1.1075.2.25 raeburn 14173: sub show_role_extent {
14174: my ($scope,$context,$role) = @_;
14175: $scope =~ s{^/}{};
14176: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14177: push(@courseroles,'co');
14178: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14179: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14180: $scope =~ s{/}{_};
14181: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14182: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14183: my ($audom,$auname) = split(/\//,$scope);
14184: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14185: &Apache::loncommon::plainname($auname,$audom).'</span>');
14186: } else {
14187: $scope =~ s{/$}{};
14188: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14189: &Apache::lonnet::domain($scope,'description').'</span>');
14190: }
14191: }
14192:
1.443 albertel 14193: ############################################################
14194: ############################################################
14195:
1.566 albertel 14196: sub check_clone {
1.578 raeburn 14197: my ($args,$linefeed) = @_;
1.566 albertel 14198: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14199: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14200: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14201: my $clonemsg;
14202: my $can_clone = 0;
1.944 raeburn 14203: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14204: if ($lctype ne 'community') {
14205: $lctype = 'course';
14206: }
1.566 albertel 14207: if ($clonehome eq 'no_host') {
1.944 raeburn 14208: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14209: $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'});
14210: } else {
14211: $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'});
14212: }
1.566 albertel 14213: } else {
14214: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14215: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14216: if ($clonedesc{'type'} ne 'Community') {
14217: $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'});
14218: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14219: }
14220: }
1.882 raeburn 14221: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14222: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14223: $can_clone = 1;
14224: } else {
1.1075.2.95 raeburn 14225: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 14226: $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95 raeburn 14227: if ($clonehash{'cloners'} eq '') {
14228: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
14229: if ($domdefs{'canclone'}) {
14230: unless ($domdefs{'canclone'} eq 'none') {
14231: if ($domdefs{'canclone'} eq 'domain') {
14232: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
14233: $can_clone = 1;
14234: }
14235: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14236: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
14237: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
14238: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
14239: $can_clone = 1;
14240: }
14241: }
14242: }
1.908 raeburn 14243: }
1.1075.2.95 raeburn 14244: } else {
14245: my @cloners = split(/,/,$clonehash{'cloners'});
14246: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 14247: $can_clone = 1;
1.1075.2.95 raeburn 14248: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 14249: $can_clone = 1;
1.1075.2.96 raeburn 14250: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14251: $can_clone = 1;
1.1075.2.95 raeburn 14252: }
14253: unless ($can_clone) {
1.1075.2.96 raeburn 14254: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14255: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1075.2.95 raeburn 14256: my (%gotdomdefaults,%gotcodedefaults);
14257: foreach my $cloner (@cloners) {
14258: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
14259: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
14260: my (%codedefaults,@code_order);
14261: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
14262: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
14263: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
14264: }
14265: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
14266: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
14267: }
14268: } else {
14269: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
14270: \%codedefaults,
14271: \@code_order);
14272: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
14273: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
14274: }
14275: if (@code_order > 0) {
14276: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
14277: $cloner,$clonehash{'internal.coursecode'},
14278: $args->{'crscode'})) {
14279: $can_clone = 1;
14280: last;
14281: }
14282: }
14283: }
14284: }
14285: }
1.1075.2.96 raeburn 14286: }
14287: }
14288: unless ($can_clone) {
14289: my $ccrole = 'cc';
14290: if ($args->{'crstype'} eq 'Community') {
14291: $ccrole = 'co';
14292: }
14293: my %roleshash =
14294: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14295: $args->{'ccdomain'},
14296: 'userroles',['active'],[$ccrole],
14297: [$args->{'clonedomain'}]);
14298: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
14299: $can_clone = 1;
14300: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
14301: $args->{'ccuname'},$args->{'ccdomain'})) {
14302: $can_clone = 1;
1.1075.2.95 raeburn 14303: }
14304: }
14305: unless ($can_clone) {
14306: if ($args->{'crstype'} eq 'Community') {
14307: $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'});
14308: } else {
14309: $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 14310: }
1.566 albertel 14311: }
1.578 raeburn 14312: }
1.566 albertel 14313: }
14314: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14315: }
14316:
1.444 albertel 14317: sub construct_course {
1.1075.2.59 raeburn 14318: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14319: my $outcome;
1.541 raeburn 14320: my $linefeed = '<br />'."\n";
14321: if ($context eq 'auto') {
14322: $linefeed = "\n";
14323: }
1.566 albertel 14324:
14325: #
14326: # Are we cloning?
14327: #
14328: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14329: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14330: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14331: if ($context ne 'auto') {
1.578 raeburn 14332: if ($clonemsg ne '') {
14333: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14334: }
1.566 albertel 14335: }
14336: $outcome .= $clonemsg.$linefeed;
14337:
14338: if (!$can_clone) {
14339: return (0,$outcome);
14340: }
14341: }
14342:
1.444 albertel 14343: #
14344: # Open course
14345: #
14346: my $crstype = lc($args->{'crstype'});
14347: my %cenv=();
14348: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14349: $args->{'cdescr'},
14350: $args->{'curl'},
14351: $args->{'course_home'},
14352: $args->{'nonstandard'},
14353: $args->{'crscode'},
14354: $args->{'ccuname'}.':'.
14355: $args->{'ccdomain'},
1.882 raeburn 14356: $args->{'crstype'},
1.885 raeburn 14357: $cnum,$context,$category);
1.444 albertel 14358:
14359: # Note: The testing routines depend on this being output; see
14360: # Utils::Course. This needs to at least be output as a comment
14361: # if anyone ever decides to not show this, and Utils::Course::new
14362: # will need to be suitably modified.
1.541 raeburn 14363: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14364: if ($$courseid =~ /^error:/) {
14365: return (0,$outcome);
14366: }
14367:
1.444 albertel 14368: #
14369: # Check if created correctly
14370: #
1.479 albertel 14371: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14372: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14373: if ($crsuhome eq 'no_host') {
14374: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14375: return (0,$outcome);
14376: }
1.541 raeburn 14377: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14378:
1.444 albertel 14379: #
1.566 albertel 14380: # Do the cloning
14381: #
14382: if ($can_clone && $cloneid) {
14383: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14384: if ($context ne 'auto') {
14385: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14386: }
14387: $outcome .= $clonemsg.$linefeed;
14388: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14389: # Copy all files
1.637 www 14390: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14391: # Restore URL
1.566 albertel 14392: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14393: # Restore title
1.566 albertel 14394: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14395: # Restore creation date, creator and creation context.
14396: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14397: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14398: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14399: # Mark as cloned
1.566 albertel 14400: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14401: # Need to clone grading mode
14402: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14403: $cenv{'grading'}=$newenv{'grading'};
14404: # Do not clone these environment entries
14405: &Apache::lonnet::del('environment',
14406: ['default_enrollment_start_date',
14407: 'default_enrollment_end_date',
14408: 'question.email',
14409: 'policy.email',
14410: 'comment.email',
14411: 'pch.users.denied',
1.725 raeburn 14412: 'plc.users.denied',
14413: 'hidefromcat',
1.1075.2.36 raeburn 14414: 'checkforpriv',
1.1075.2.59 raeburn 14415: 'categories',
14416: 'internal.uniquecode'],
1.638 www 14417: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 14418: if ($args->{'textbook'}) {
14419: $cenv{'internal.textbook'} = $args->{'textbook'};
14420: }
1.444 albertel 14421: }
1.566 albertel 14422:
1.444 albertel 14423: #
14424: # Set environment (will override cloned, if existing)
14425: #
14426: my @sections = ();
14427: my @xlists = ();
14428: if ($args->{'crstype'}) {
14429: $cenv{'type'}=$args->{'crstype'};
14430: }
14431: if ($args->{'crsid'}) {
14432: $cenv{'courseid'}=$args->{'crsid'};
14433: }
14434: if ($args->{'crscode'}) {
14435: $cenv{'internal.coursecode'}=$args->{'crscode'};
14436: }
14437: if ($args->{'crsquota'} ne '') {
14438: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14439: } else {
14440: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14441: }
14442: if ($args->{'ccuname'}) {
14443: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14444: ':'.$args->{'ccdomain'};
14445: } else {
14446: $cenv{'internal.courseowner'} = $args->{'curruser'};
14447: }
1.1075.2.31 raeburn 14448: if ($args->{'defaultcredits'}) {
14449: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14450: }
1.444 albertel 14451: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14452: if ($args->{'crssections'}) {
14453: $cenv{'internal.sectionnums'} = '';
14454: if ($args->{'crssections'} =~ m/,/) {
14455: @sections = split/,/,$args->{'crssections'};
14456: } else {
14457: $sections[0] = $args->{'crssections'};
14458: }
14459: if (@sections > 0) {
14460: foreach my $item (@sections) {
14461: my ($sec,$gp) = split/:/,$item;
14462: my $class = $args->{'crscode'}.$sec;
14463: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14464: $cenv{'internal.sectionnums'} .= $item.',';
14465: unless ($addcheck eq 'ok') {
14466: push @badclasses, $class;
14467: }
14468: }
14469: $cenv{'internal.sectionnums'} =~ s/,$//;
14470: }
14471: }
14472: # do not hide course coordinator from staff listing,
14473: # even if privileged
14474: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 14475: # add course coordinator's domain to domains to check for privileged users
14476: # if different to course domain
14477: if ($$crsudom ne $args->{'ccdomain'}) {
14478: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14479: }
1.444 albertel 14480: # add crosslistings
14481: if ($args->{'crsxlist'}) {
14482: $cenv{'internal.crosslistings'}='';
14483: if ($args->{'crsxlist'} =~ m/,/) {
14484: @xlists = split/,/,$args->{'crsxlist'};
14485: } else {
14486: $xlists[0] = $args->{'crsxlist'};
14487: }
14488: if (@xlists > 0) {
14489: foreach my $item (@xlists) {
14490: my ($xl,$gp) = split/:/,$item;
14491: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14492: $cenv{'internal.crosslistings'} .= $item.',';
14493: unless ($addcheck eq 'ok') {
14494: push @badclasses, $xl;
14495: }
14496: }
14497: $cenv{'internal.crosslistings'} =~ s/,$//;
14498: }
14499: }
14500: if ($args->{'autoadds'}) {
14501: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14502: }
14503: if ($args->{'autodrops'}) {
14504: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14505: }
14506: # check for notification of enrollment changes
14507: my @notified = ();
14508: if ($args->{'notify_owner'}) {
14509: if ($args->{'ccuname'} ne '') {
14510: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14511: }
14512: }
14513: if ($args->{'notify_dc'}) {
14514: if ($uname ne '') {
1.630 raeburn 14515: push(@notified,$uname.':'.$udom);
1.444 albertel 14516: }
14517: }
14518: if (@notified > 0) {
14519: my $notifylist;
14520: if (@notified > 1) {
14521: $notifylist = join(',',@notified);
14522: } else {
14523: $notifylist = $notified[0];
14524: }
14525: $cenv{'internal.notifylist'} = $notifylist;
14526: }
14527: if (@badclasses > 0) {
14528: my %lt=&Apache::lonlocal::texthash(
14529: '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',
14530: 'dnhr' => 'does not have rights to access enrollment in these classes',
14531: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14532: );
1.541 raeburn 14533: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14534: ' ('.$lt{'adby'}.')';
14535: if ($context eq 'auto') {
14536: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14537: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14538: foreach my $item (@badclasses) {
14539: if ($context eq 'auto') {
14540: $outcome .= " - $item\n";
14541: } else {
14542: $outcome .= "<li>$item</li>\n";
14543: }
14544: }
14545: if ($context eq 'auto') {
14546: $outcome .= $linefeed;
14547: } else {
1.566 albertel 14548: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14549: }
14550: }
1.444 albertel 14551: }
14552: if ($args->{'no_end_date'}) {
14553: $args->{'endaccess'} = 0;
14554: }
14555: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14556: $cenv{'internal.autoend'}=$args->{'enrollend'};
14557: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14558: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14559: if ($args->{'showphotos'}) {
14560: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14561: }
14562: $cenv{'internal.authtype'} = $args->{'authtype'};
14563: $cenv{'internal.autharg'} = $args->{'autharg'};
14564: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14565: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14566: 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');
14567: if ($context eq 'auto') {
14568: $outcome .= $krb_msg;
14569: } else {
1.566 albertel 14570: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14571: }
14572: $outcome .= $linefeed;
1.444 albertel 14573: }
14574: }
14575: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14576: if ($args->{'setpolicy'}) {
14577: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14578: }
14579: if ($args->{'setcontent'}) {
14580: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14581: }
14582: }
14583: if ($args->{'reshome'}) {
14584: $cenv{'reshome'}=$args->{'reshome'}.'/';
14585: $cenv{'reshome'}=~s/\/+$/\//;
14586: }
14587: #
14588: # course has keyed access
14589: #
14590: if ($args->{'setkeys'}) {
14591: $cenv{'keyaccess'}='yes';
14592: }
14593: # if specified, key authority is not course, but user
14594: # only active if keyaccess is yes
14595: if ($args->{'keyauth'}) {
1.487 albertel 14596: my ($user,$domain) = split(':',$args->{'keyauth'});
14597: $user = &LONCAPA::clean_username($user);
14598: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14599: if ($user ne '' && $domain ne '') {
1.487 albertel 14600: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14601: }
14602: }
14603:
1.1075.2.59 raeburn 14604: #
14605: # generate and store uniquecode (available to course requester), if course should have one.
14606: #
14607: if ($args->{'uniquecode'}) {
14608: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14609: if ($code) {
14610: $cenv{'internal.uniquecode'} = $code;
14611: my %crsinfo =
14612: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14613: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14614: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14615: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14616: }
14617: if (ref($coderef)) {
14618: $$coderef = $code;
14619: }
14620: }
14621: }
14622:
1.444 albertel 14623: if ($args->{'disresdis'}) {
14624: $cenv{'pch.roles.denied'}='st';
14625: }
14626: if ($args->{'disablechat'}) {
14627: $cenv{'plc.roles.denied'}='st';
14628: }
14629:
14630: # Record we've not yet viewed the Course Initialization Helper for this
14631: # course
14632: $cenv{'course.helper.not.run'} = 1;
14633: #
14634: # Use new Randomseed
14635: #
14636: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14637: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14638: #
14639: # The encryption code and receipt prefix for this course
14640: #
14641: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14642: $cenv{'internal.encpref'}=100+int(9*rand(99));
14643: #
14644: # By default, use standard grading
14645: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14646:
1.541 raeburn 14647: $outcome .= $linefeed.&mt('Setting environment').': '.
14648: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14649: #
14650: # Open all assignments
14651: #
14652: if ($args->{'openall'}) {
14653: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14654: my %storecontent = ($storeunder => time,
14655: $storeunder.'.type' => 'date_start');
14656:
14657: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14658: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14659: }
14660: #
14661: # Set first page
14662: #
14663: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14664: || ($cloneid)) {
1.445 albertel 14665: use LONCAPA::map;
1.444 albertel 14666: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14667:
14668: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14669: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14670:
1.444 albertel 14671: $outcome .= ($fatal?$errtext:'read ok').' - ';
14672: my $title; my $url;
14673: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14674: $title=&mt('Syllabus');
1.444 albertel 14675: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14676: } else {
1.963 raeburn 14677: $title=&mt('Table of Contents');
1.444 albertel 14678: $url='/adm/navmaps';
14679: }
1.445 albertel 14680:
14681: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14682: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14683:
14684: if ($errtext) { $fatal=2; }
1.541 raeburn 14685: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14686: }
1.566 albertel 14687:
14688: return (1,$outcome);
1.444 albertel 14689: }
14690:
1.1075.2.59 raeburn 14691: sub make_unique_code {
14692: my ($cdom,$cnum) = @_;
14693: # get lock on uniquecodes db
14694: my $lockhash = {
14695: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14696: ':'.$env{'user.domain'},
14697: };
14698: my $tries = 0;
14699: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14700: my ($code,$error);
14701:
14702: while (($gotlock ne 'ok') && ($tries<3)) {
14703: $tries ++;
14704: sleep 1;
14705: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14706: }
14707: if ($gotlock eq 'ok') {
14708: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14709: my $gotcode;
14710: my $attempts = 0;
14711: while ((!$gotcode) && ($attempts < 100)) {
14712: $code = &generate_code();
14713: if (!exists($currcodes{$code})) {
14714: $gotcode = 1;
14715: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14716: $error = 'nostore';
14717: }
14718: }
14719: $attempts ++;
14720: }
14721: my @del_lock = ($cnum."\0".'uniquecodes');
14722: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14723: } else {
14724: $error = 'nolock';
14725: }
14726: return ($code,$error);
14727: }
14728:
14729: sub generate_code {
14730: my $code;
14731: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14732: for (my $i=0; $i<6; $i++) {
14733: my $lettnum = int (rand 2);
14734: my $item = '';
14735: if ($lettnum) {
14736: $item = $letts[int( rand(18) )];
14737: } else {
14738: $item = 1+int( rand(8) );
14739: }
14740: $code .= $item;
14741: }
14742: return $code;
14743: }
14744:
1.444 albertel 14745: ############################################################
14746: ############################################################
14747:
1.953 droeschl 14748: #SD
14749: # only Community and Course, or anything else?
1.378 raeburn 14750: sub course_type {
14751: my ($cid) = @_;
14752: if (!defined($cid)) {
14753: $cid = $env{'request.course.id'};
14754: }
1.404 albertel 14755: if (defined($env{'course.'.$cid.'.type'})) {
14756: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14757: } else {
14758: return 'Course';
1.377 raeburn 14759: }
14760: }
1.156 albertel 14761:
1.406 raeburn 14762: sub group_term {
14763: my $crstype = &course_type();
14764: my %names = (
14765: 'Course' => 'group',
1.865 raeburn 14766: 'Community' => 'group',
1.406 raeburn 14767: );
14768: return $names{$crstype};
14769: }
14770:
1.902 raeburn 14771: sub course_types {
1.1075.2.59 raeburn 14772: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14773: my %typename = (
14774: official => 'Official course',
14775: unofficial => 'Unofficial course',
14776: community => 'Community',
1.1075.2.59 raeburn 14777: textbook => 'Textbook course',
1.902 raeburn 14778: );
14779: return (\@types,\%typename);
14780: }
14781:
1.156 albertel 14782: sub icon {
14783: my ($file)=@_;
1.505 albertel 14784: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14785: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14786: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14787: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14788: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14789: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14790: $curfext.".gif") {
14791: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14792: $curfext.".gif";
14793: }
14794: }
1.249 albertel 14795: return &lonhttpdurl($iconname);
1.154 albertel 14796: }
1.84 albertel 14797:
1.575 albertel 14798: sub lonhttpdurl {
1.692 www 14799: #
14800: # Had been used for "small fry" static images on separate port 8080.
14801: # Modify here if lightweight http functionality desired again.
14802: # Currently eliminated due to increasing firewall issues.
14803: #
1.575 albertel 14804: my ($url)=@_;
1.692 www 14805: return $url;
1.215 albertel 14806: }
14807:
1.213 albertel 14808: sub connection_aborted {
14809: my ($r)=@_;
14810: $r->print(" ");$r->rflush();
14811: my $c = $r->connection;
14812: return $c->aborted();
14813: }
14814:
1.221 foxr 14815: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14816: # strings as 'strings'.
14817: sub escape_single {
1.221 foxr 14818: my ($input) = @_;
1.223 albertel 14819: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14820: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14821: return $input;
14822: }
1.223 albertel 14823:
1.222 foxr 14824: # Same as escape_single, but escape's "'s This
14825: # can be used for "strings"
14826: sub escape_double {
14827: my ($input) = @_;
14828: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14829: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14830: return $input;
14831: }
1.223 albertel 14832:
1.222 foxr 14833: # Escapes the last element of a full URL.
14834: sub escape_url {
14835: my ($url) = @_;
1.238 raeburn 14836: my @urlslices = split(/\//, $url,-1);
1.369 www 14837: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 14838: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 14839: }
1.462 albertel 14840:
1.820 raeburn 14841: sub compare_arrays {
14842: my ($arrayref1,$arrayref2) = @_;
14843: my (@difference,%count);
14844: @difference = ();
14845: %count = ();
14846: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14847: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14848: foreach my $element (keys(%count)) {
14849: if ($count{$element} == 1) {
14850: push(@difference,$element);
14851: }
14852: }
14853: }
14854: return @difference;
14855: }
14856:
1.817 bisitz 14857: # -------------------------------------------------------- Initialize user login
1.462 albertel 14858: sub init_user_environment {
1.463 albertel 14859: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14860: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14861:
14862: my $public=($username eq 'public' && $domain eq 'public');
14863:
14864: # See if old ID present, if so, remove
14865:
1.1062 raeburn 14866: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14867: my $now=time;
14868:
14869: if ($public) {
14870: my $max_public=100;
14871: my $oldest;
14872: my $oldest_time=0;
14873: for(my $next=1;$next<=$max_public;$next++) {
14874: if (-e $lonids."/publicuser_$next.id") {
14875: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14876: if ($mtime<$oldest_time || !$oldest_time) {
14877: $oldest_time=$mtime;
14878: $oldest=$next;
14879: }
14880: } else {
14881: $cookie="publicuser_$next";
14882: last;
14883: }
14884: }
14885: if (!$cookie) { $cookie="publicuser_$oldest"; }
14886: } else {
1.463 albertel 14887: # if this isn't a robot, kill any existing non-robot sessions
14888: if (!$args->{'robot'}) {
14889: opendir(DIR,$lonids);
14890: while ($filename=readdir(DIR)) {
14891: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14892: unlink($lonids.'/'.$filename);
14893: }
1.462 albertel 14894: }
1.463 albertel 14895: closedir(DIR);
1.1075.2.84 raeburn 14896: # If there is a undeleted lockfile for the user's paste buffer remove it.
14897: my $namespace = 'nohist_courseeditor';
14898: my $lockingkey = 'paste'."\0".'locked_num';
14899: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
14900: $domain,$username);
14901: if (exists($lockhash{$lockingkey})) {
14902: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
14903: unless ($delresult eq 'ok') {
14904: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
14905: }
14906: }
1.462 albertel 14907: }
14908: # Give them a new cookie
1.463 albertel 14909: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14910: : $now.$$.int(rand(10000)));
1.463 albertel 14911: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14912:
14913: # Initialize roles
14914:
1.1062 raeburn 14915: ($userroles,$firstaccenv,$timerintenv) =
14916: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14917: }
14918: # ------------------------------------ Check browser type and MathML capability
14919:
1.1075.2.77 raeburn 14920: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14921: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14922:
14923: # ------------------------------------------------------------- Get environment
14924:
14925: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14926: my ($tmp) = keys(%userenv);
14927: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14928: } else {
14929: undef(%userenv);
14930: }
14931: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14932: $form->{'interface'}=$userenv{'interface'};
14933: }
14934: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14935:
14936: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14937: foreach my $option ('interface','localpath','localres') {
14938: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14939: }
14940: # --------------------------------------------------------- Write first profile
14941:
14942: {
14943: my %initial_env =
14944: ("user.name" => $username,
14945: "user.domain" => $domain,
14946: "user.home" => $authhost,
14947: "browser.type" => $clientbrowser,
14948: "browser.version" => $clientversion,
14949: "browser.mathml" => $clientmathml,
14950: "browser.unicode" => $clientunicode,
14951: "browser.os" => $clientos,
1.1075.2.42 raeburn 14952: "browser.mobile" => $clientmobile,
14953: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 14954: "browser.osversion" => $clientosversion,
1.462 albertel 14955: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14956: "request.course.fn" => '',
14957: "request.course.uri" => '',
14958: "request.course.sec" => '',
14959: "request.role" => 'cm',
14960: "request.role.adv" => $env{'user.adv'},
14961: "request.host" => $ENV{'REMOTE_ADDR'},);
14962:
14963: if ($form->{'localpath'}) {
14964: $initial_env{"browser.localpath"} = $form->{'localpath'};
14965: $initial_env{"browser.localres"} = $form->{'localres'};
14966: }
14967:
14968: if ($form->{'interface'}) {
14969: $form->{'interface'}=~s/\W//gs;
14970: $initial_env{"browser.interface"} = $form->{'interface'};
14971: $env{'browser.interface'}=$form->{'interface'};
14972: }
14973:
1.1075.2.54 raeburn 14974: if ($form->{'iptoken'}) {
14975: my $lonhost = $r->dir_config('lonHostID');
14976: $initial_env{"user.noloadbalance"} = $lonhost;
14977: $env{'user.noloadbalance'} = $lonhost;
14978: }
14979:
1.981 raeburn 14980: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14981: my %domdef;
14982: unless ($domain eq 'public') {
14983: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14984: }
1.980 raeburn 14985:
1.1075.2.7 raeburn 14986: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14987: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14988: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14989: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14990: }
14991:
1.1075.2.59 raeburn 14992: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14993: $userenv{'canrequest.'.$crstype} =
14994: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14995: 'reload','requestcourses',
14996: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14997: }
14998:
1.1075.2.14 raeburn 14999: $userenv{'canrequest.author'} =
15000: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
15001: 'reload','requestauthor',
15002: \%userenv,\%domdef,\%is_adv);
15003: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
15004: $domain,$username);
15005: my $reqstatus = $reqauthor{'author_status'};
15006: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
15007: if (ref($reqauthor{'author'}) eq 'HASH') {
15008: $userenv{'requestauthorqueued'} = $reqstatus.':'.
15009: $reqauthor{'author'}{'timestamp'};
15010: }
15011: }
15012:
1.462 albertel 15013: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15014:
1.462 albertel 15015: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15016: &GDBM_WRCREAT(),0640)) {
15017: &_add_to_env(\%disk_env,\%initial_env);
15018: &_add_to_env(\%disk_env,\%userenv,'environment.');
15019: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15020: if (ref($firstaccenv) eq 'HASH') {
15021: &_add_to_env(\%disk_env,$firstaccenv);
15022: }
15023: if (ref($timerintenv) eq 'HASH') {
15024: &_add_to_env(\%disk_env,$timerintenv);
15025: }
1.463 albertel 15026: if (ref($args->{'extra_env'})) {
15027: &_add_to_env(\%disk_env,$args->{'extra_env'});
15028: }
1.462 albertel 15029: untie(%disk_env);
15030: } else {
1.705 tempelho 15031: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
15032: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 15033: return 'error: '.$!;
15034: }
15035: }
15036: $env{'request.role'}='cm';
15037: $env{'request.role.adv'}=$env{'user.adv'};
15038: $env{'browser.type'}=$clientbrowser;
15039:
15040: return $cookie;
15041:
15042: }
15043:
15044: sub _add_to_env {
15045: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 15046: if (ref($env_data) eq 'HASH') {
15047: while (my ($key,$value) = each(%$env_data)) {
15048: $idf->{$prefix.$key} = $value;
15049: $env{$prefix.$key} = $value;
15050: }
1.462 albertel 15051: }
15052: }
15053:
1.685 tempelho 15054: # --- Get the symbolic name of a problem and the url
15055: sub get_symb {
15056: my ($request,$silent) = @_;
1.726 raeburn 15057: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 15058: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
15059: if ($symb eq '') {
15060: if (!$silent) {
1.1071 raeburn 15061: if (ref($request)) {
15062: $request->print("Unable to handle ambiguous references:$url:.");
15063: }
1.685 tempelho 15064: return ();
15065: }
15066: }
15067: &Apache::lonenc::check_decrypt(\$symb);
15068: return ($symb);
15069: }
15070:
15071: # --------------------------------------------------------------Get annotation
15072:
15073: sub get_annotation {
15074: my ($symb,$enc) = @_;
15075:
15076: my $key = $symb;
15077: if (!$enc) {
15078: $key =
15079: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
15080: }
15081: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
15082: return $annotation{$key};
15083: }
15084:
15085: sub clean_symb {
1.731 raeburn 15086: my ($symb,$delete_enc) = @_;
1.685 tempelho 15087:
15088: &Apache::lonenc::check_decrypt(\$symb);
15089: my $enc = $env{'request.enc'};
1.731 raeburn 15090: if ($delete_enc) {
1.730 raeburn 15091: delete($env{'request.enc'});
15092: }
1.685 tempelho 15093:
15094: return ($symb,$enc);
15095: }
1.462 albertel 15096:
1.1075.2.69 raeburn 15097: ############################################################
15098: ############################################################
15099:
15100: =pod
15101:
15102: =head1 Routines for building display used to search for courses
15103:
15104:
15105: =over 4
15106:
15107: =item * &build_filters()
15108:
15109: Create markup for a table used to set filters to use when selecting
15110: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
15111: and quotacheck.pl
15112:
15113:
15114: Inputs:
15115:
15116: filterlist - anonymous array of fields to include as potential filters
15117:
15118: crstype - course type
15119:
15120: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
15121: to pop-open a course selector (will contain "extra element").
15122:
15123: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
15124:
15125: filter - anonymous hash of criteria and their values
15126:
15127: action - form action
15128:
15129: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
15130:
15131: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
15132:
15133: cloneruname - username of owner of new course who wants to clone
15134:
15135: clonerudom - domain of owner of new course who wants to clone
15136:
15137: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
15138:
15139: codetitlesref - reference to array of titles of components in institutional codes (official courses)
15140:
15141: codedom - domain
15142:
15143: formname - value of form element named "form".
15144:
15145: fixeddom - domain, if fixed.
15146:
15147: prevphase - value to assign to form element named "phase" when going back to the previous screen
15148:
15149: cnameelement - name of form element in form on opener page which will receive title of selected course
15150:
15151: cnumelement - name of form element in form on opener page which will receive courseID of selected course
15152:
15153: cdomelement - name of form element in form on opener page which will receive domain of selected course
15154:
15155: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
15156:
15157: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
15158:
15159: clonewarning - warning message about missing information for intended course owner when DC creates a course
15160:
15161:
15162: Returns: $output - HTML for display of search criteria, and hidden form elements.
15163:
15164:
15165: Side Effects: None
15166:
15167: =cut
15168:
15169: # ---------------------------------------------- search for courses based on last activity etc.
15170:
15171: sub build_filters {
15172: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
15173: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
15174: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
15175: $cnameelement,$cnumelement,$cdomelement,$setroles,
15176: $clonetext,$clonewarning) = @_;
15177: my ($list,$jscript);
15178: my $onchange = 'javascript:updateFilters(this)';
15179: my ($domainselectform,$sincefilterform,$createdfilterform,
15180: $ownerdomselectform,$persondomselectform,$instcodeform,
15181: $typeselectform,$instcodetitle);
15182: if ($formname eq '') {
15183: $formname = $caller;
15184: }
15185: foreach my $item (@{$filterlist}) {
15186: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
15187: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
15188: if ($item eq 'domainfilter') {
15189: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
15190: } elsif ($item eq 'coursefilter') {
15191: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
15192: } elsif ($item eq 'ownerfilter') {
15193: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15194: } elsif ($item eq 'ownerdomfilter') {
15195: $filter->{'ownerdomfilter'} =
15196: &LONCAPA::clean_domain($filter->{$item});
15197: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
15198: 'ownerdomfilter',1);
15199: } elsif ($item eq 'personfilter') {
15200: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15201: } elsif ($item eq 'persondomfilter') {
15202: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15203: 'persondomfilter',1);
15204: } else {
15205: $filter->{$item} =~ s/\W//g;
15206: }
15207: if (!$filter->{$item}) {
15208: $filter->{$item} = '';
15209: }
15210: }
15211: if ($item eq 'domainfilter') {
15212: my $allow_blank = 1;
15213: if ($formname eq 'portform') {
15214: $allow_blank=0;
15215: } elsif ($formname eq 'studentform') {
15216: $allow_blank=0;
15217: }
15218: if ($fixeddom) {
15219: $domainselectform = '<input type="hidden" name="domainfilter"'.
15220: ' value="'.$codedom.'" />'.
15221: &Apache::lonnet::domain($codedom,'description');
15222: } else {
15223: $domainselectform = &select_dom_form($filter->{$item},
15224: 'domainfilter',
15225: $allow_blank,'',$onchange);
15226: }
15227: } else {
15228: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15229: }
15230: }
15231:
15232: # last course activity filter and selection
15233: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15234:
15235: # course created filter and selection
15236: if (exists($filter->{'createdfilter'})) {
15237: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15238: }
15239:
15240: my %lt = &Apache::lonlocal::texthash(
15241: 'cac' => "$crstype Activity",
15242: 'ccr' => "$crstype Created",
15243: 'cde' => "$crstype Title",
15244: 'cdo' => "$crstype Domain",
15245: 'ins' => 'Institutional Code',
15246: 'inc' => 'Institutional Categorization',
15247: 'cow' => "$crstype Owner/Co-owner",
15248: 'cop' => "$crstype Personnel Includes",
15249: 'cog' => 'Type',
15250: );
15251:
15252: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15253: my $typeval = 'Course';
15254: if ($crstype eq 'Community') {
15255: $typeval = 'Community';
15256: }
15257: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15258: } else {
15259: $typeselectform = '<select name="type" size="1"';
15260: if ($onchange) {
15261: $typeselectform .= ' onchange="'.$onchange.'"';
15262: }
15263: $typeselectform .= '>'."\n";
15264: foreach my $posstype ('Course','Community') {
15265: $typeselectform.='<option value="'.$posstype.'"'.
15266: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
15267: }
15268: $typeselectform.="</select>";
15269: }
15270:
15271: my ($cloneableonlyform,$cloneabletitle);
15272: if (exists($filter->{'cloneableonly'})) {
15273: my $cloneableon = '';
15274: my $cloneableoff = ' checked="checked"';
15275: if ($filter->{'cloneableonly'}) {
15276: $cloneableon = $cloneableoff;
15277: $cloneableoff = '';
15278: }
15279: $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>';
15280: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 15281: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 15282: } else {
15283: $cloneabletitle = &mt('Cloneable by you');
15284: }
15285: }
15286: my $officialjs;
15287: if ($crstype eq 'Course') {
15288: if (exists($filter->{'instcodefilter'})) {
15289: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15290: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15291: if ($codedom) {
15292: $officialjs = 1;
15293: ($instcodeform,$jscript,$$numtitlesref) =
15294: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15295: $officialjs,$codetitlesref);
15296: if ($jscript) {
15297: $jscript = '<script type="text/javascript">'."\n".
15298: '// <![CDATA['."\n".
15299: $jscript."\n".
15300: '// ]]>'."\n".
15301: '</script>'."\n";
15302: }
15303: }
15304: if ($instcodeform eq '') {
15305: $instcodeform =
15306: '<input type="text" name="instcodefilter" size="10" value="'.
15307: $list->{'instcodefilter'}.'" />';
15308: $instcodetitle = $lt{'ins'};
15309: } else {
15310: $instcodetitle = $lt{'inc'};
15311: }
15312: if ($fixeddom) {
15313: $instcodetitle .= '<br />('.$codedom.')';
15314: }
15315: }
15316: }
15317: my $output = qq|
15318: <form method="post" name="filterpicker" action="$action">
15319: <input type="hidden" name="form" value="$formname" />
15320: |;
15321: if ($formname eq 'modifycourse') {
15322: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15323: '<input type="hidden" name="prevphase" value="'.
15324: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 15325: } elsif ($formname eq 'quotacheck') {
15326: $output .= qq|
15327: <input type="hidden" name="sortby" value="" />
15328: <input type="hidden" name="sortorder" value="" />
15329: |;
15330: } else {
1.1075.2.69 raeburn 15331: my $name_input;
15332: if ($cnameelement ne '') {
15333: $name_input = '<input type="hidden" name="cnameelement" value="'.
15334: $cnameelement.'" />';
15335: }
15336: $output .= qq|
15337: <input type="hidden" name="cnumelement" value="$cnumelement" />
15338: <input type="hidden" name="cdomelement" value="$cdomelement" />
15339: $name_input
15340: $roleelement
15341: $multelement
15342: $typeelement
15343: |;
15344: if ($formname eq 'portform') {
15345: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15346: }
15347: }
15348: if ($fixeddom) {
15349: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15350: }
15351: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15352: if ($sincefilterform) {
15353: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15354: .$sincefilterform
15355: .&Apache::lonhtmlcommon::row_closure();
15356: }
15357: if ($createdfilterform) {
15358: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15359: .$createdfilterform
15360: .&Apache::lonhtmlcommon::row_closure();
15361: }
15362: if ($domainselectform) {
15363: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15364: .$domainselectform
15365: .&Apache::lonhtmlcommon::row_closure();
15366: }
15367: if ($typeselectform) {
15368: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15369: $output .= $typeselectform;
15370: } else {
15371: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15372: .$typeselectform
15373: .&Apache::lonhtmlcommon::row_closure();
15374: }
15375: }
15376: if ($instcodeform) {
15377: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15378: .$instcodeform
15379: .&Apache::lonhtmlcommon::row_closure();
15380: }
15381: if (exists($filter->{'ownerfilter'})) {
15382: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15383: '<table><tr><td>'.&mt('Username').'<br />'.
15384: '<input type="text" name="ownerfilter" size="20" value="'.
15385: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15386: $ownerdomselectform.'</td></tr></table>'.
15387: &Apache::lonhtmlcommon::row_closure();
15388: }
15389: if (exists($filter->{'personfilter'})) {
15390: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15391: '<table><tr><td>'.&mt('Username').'<br />'.
15392: '<input type="text" name="personfilter" size="20" value="'.
15393: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15394: $persondomselectform.'</td></tr></table>'.
15395: &Apache::lonhtmlcommon::row_closure();
15396: }
15397: if (exists($filter->{'coursefilter'})) {
15398: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15399: .'<input type="text" name="coursefilter" size="25" value="'
15400: .$list->{'coursefilter'}.'" />'
15401: .&Apache::lonhtmlcommon::row_closure();
15402: }
15403: if ($cloneableonlyform) {
15404: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15405: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15406: }
15407: if (exists($filter->{'descriptfilter'})) {
15408: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15409: .'<input type="text" name="descriptfilter" size="40" value="'
15410: .$list->{'descriptfilter'}.'" />'
15411: .&Apache::lonhtmlcommon::row_closure(1);
15412: }
15413: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15414: '<input type="hidden" name="updater" value="" />'."\n".
15415: '<input type="submit" name="gosearch" value="'.
15416: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15417: return $jscript.$clonewarning.$output;
15418: }
15419:
15420: =pod
15421:
15422: =item * &timebased_select_form()
15423:
15424: Create markup for a dropdown list used to select a time-based
15425: filter e.g., Course Activity, Course Created, when searching for courses
15426: or communities
15427:
15428: Inputs:
15429:
15430: item - name of form element (sincefilter or createdfilter)
15431:
15432: filter - anonymous hash of criteria and their values
15433:
15434: Returns: HTML for a select box contained a blank, then six time selections,
15435: with value set in incoming form variables currently selected.
15436:
15437: Side Effects: None
15438:
15439: =cut
15440:
15441: sub timebased_select_form {
15442: my ($item,$filter) = @_;
15443: if (ref($filter) eq 'HASH') {
15444: $filter->{$item} =~ s/[^\d-]//g;
15445: if (!$filter->{$item}) { $filter->{$item}=-1; }
15446: return &select_form(
15447: $filter->{$item},
15448: $item,
15449: { '-1' => '',
15450: '86400' => &mt('today'),
15451: '604800' => &mt('last week'),
15452: '2592000' => &mt('last month'),
15453: '7776000' => &mt('last three months'),
15454: '15552000' => &mt('last six months'),
15455: '31104000' => &mt('last year'),
15456: 'select_form_order' =>
15457: ['-1','86400','604800','2592000','7776000',
15458: '15552000','31104000']});
15459: }
15460: }
15461:
15462: =pod
15463:
15464: =item * &js_changer()
15465:
15466: Create script tag containing Javascript used to submit course search form
15467: when course type or domain is changed, and also to hide 'Searching ...' on
15468: page load completion for page showing search result.
15469:
15470: Inputs: None
15471:
15472: Returns: markup containing updateFilters() and hideSearching() javascript functions.
15473:
15474: Side Effects: None
15475:
15476: =cut
15477:
15478: sub js_changer {
15479: return <<ENDJS;
15480: <script type="text/javascript">
15481: // <![CDATA[
15482: function updateFilters(caller) {
15483: if (typeof(caller) != "undefined") {
15484: document.filterpicker.updater.value = caller.name;
15485: }
15486: document.filterpicker.submit();
15487: }
15488:
15489: function hideSearching() {
15490: if (document.getElementById('searching')) {
15491: document.getElementById('searching').style.display = 'none';
15492: }
15493: return;
15494: }
15495:
15496: // ]]>
15497: </script>
15498:
15499: ENDJS
15500: }
15501:
15502: =pod
15503:
15504: =item * &search_courses()
15505:
15506: Process selected filters form course search form and pass to lonnet::courseiddump
15507: to retrieve a hash for which keys are courseIDs which match the selected filters.
15508:
15509: Inputs:
15510:
15511: dom - domain being searched
15512:
15513: type - course type ('Course' or 'Community' or '.' if any).
15514:
15515: filter - anonymous hash of criteria and their values
15516:
15517: numtitles - for institutional codes - number of categories
15518:
15519: cloneruname - optional username of new course owner
15520:
15521: clonerudom - optional domain of new course owner
15522:
1.1075.2.95 raeburn 15523: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69 raeburn 15524: (used when DC is using course creation form)
15525:
15526: codetitles - reference to array of titles of components in institutional codes (official courses).
15527:
1.1075.2.95 raeburn 15528: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
15529: (and so can clone automatically)
15530:
15531: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
15532:
15533: reqinstcode - institutional code of new course, where search_courses is used to identify potential
15534: courses to clone
1.1075.2.69 raeburn 15535:
15536: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15537:
15538:
15539: Side Effects: None
15540:
15541: =cut
15542:
15543:
15544: sub search_courses {
1.1075.2.95 raeburn 15545: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
15546: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69 raeburn 15547: my (%courses,%showcourses,$cloner);
15548: if (($filter->{'ownerfilter'} ne '') ||
15549: ($filter->{'ownerdomfilter'} ne '')) {
15550: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15551: $filter->{'ownerdomfilter'};
15552: }
15553: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15554: if (!$filter->{$item}) {
15555: $filter->{$item}='.';
15556: }
15557: }
15558: my $now = time;
15559: my $timefilter =
15560: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15561: my ($createdbefore,$createdafter);
15562: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15563: $createdbefore = $now;
15564: $createdafter = $now-$filter->{'createdfilter'};
15565: }
15566: my ($instcodefilter,$regexpok);
15567: if ($numtitles) {
15568: if ($env{'form.official'} eq 'on') {
15569: $instcodefilter =
15570: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15571: $regexpok = 1;
15572: } elsif ($env{'form.official'} eq 'off') {
15573: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15574: unless ($instcodefilter eq '') {
15575: $regexpok = -1;
15576: }
15577: }
15578: } else {
15579: $instcodefilter = $filter->{'instcodefilter'};
15580: }
15581: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15582: if ($type eq '') { $type = '.'; }
15583:
15584: if (($clonerudom ne '') && ($cloneruname ne '')) {
15585: $cloner = $cloneruname.':'.$clonerudom;
15586: }
15587: %courses = &Apache::lonnet::courseiddump($dom,
15588: $filter->{'descriptfilter'},
15589: $timefilter,
15590: $instcodefilter,
15591: $filter->{'combownerfilter'},
15592: $filter->{'coursefilter'},
15593: undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95 raeburn 15594: undef,undef,$cloner,$cc_clone,
1.1075.2.69 raeburn 15595: $filter->{'cloneableonly'},
15596: $createdbefore,$createdafter,undef,
1.1075.2.95 raeburn 15597: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69 raeburn 15598: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15599: my $ccrole;
15600: if ($type eq 'Community') {
15601: $ccrole = 'co';
15602: } else {
15603: $ccrole = 'cc';
15604: }
15605: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15606: $filter->{'persondomfilter'},
15607: 'userroles',undef,
15608: [$ccrole,'in','ad','ep','ta','cr'],
15609: $dom);
15610: foreach my $role (keys(%rolehash)) {
15611: my ($cnum,$cdom,$courserole) = split(':',$role);
15612: my $cid = $cdom.'_'.$cnum;
15613: if (exists($courses{$cid})) {
15614: if (ref($courses{$cid}) eq 'HASH') {
15615: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15616: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15617: push (@{$courses{$cid}{roles}},$courserole);
15618: }
15619: } else {
15620: $courses{$cid}{roles} = [$courserole];
15621: }
15622: $showcourses{$cid} = $courses{$cid};
15623: }
15624: }
15625: }
15626: %courses = %showcourses;
15627: }
15628: return %courses;
15629: }
15630:
15631: =pod
15632:
15633: =back
15634:
1.1075.2.88 raeburn 15635: =head1 Routines for version requirements for current course.
15636:
15637: =over 4
15638:
15639: =item * &check_release_required()
15640:
15641: Compares required LON-CAPA version with version on server, and
15642: if required version is newer looks for a server with the required version.
15643:
15644: Looks first at servers in user's owen domain; if none suitable, looks at
15645: servers in course's domain are permitted to host sessions for user's domain.
15646:
15647: Inputs:
15648:
15649: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15650:
15651: $courseid - Course ID of current course
15652:
15653: $rolecode - User's current role in course (for switchserver query string).
15654:
15655: $required - LON-CAPA version needed by course (format: Major.Minor).
15656:
15657:
15658: Returns:
15659:
15660: $switchserver - query string tp append to /adm/switchserver call (if
15661: current server's LON-CAPA version is too old.
15662:
15663: $warning - Message is displayed if no suitable server could be found.
15664:
15665: =cut
15666:
15667: sub check_release_required {
15668: my ($loncaparev,$courseid,$rolecode,$required) = @_;
15669: my ($switchserver,$warning);
15670: if ($required ne '') {
15671: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
15672: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15673: if ($reqdmajor ne '' && $reqdminor ne '') {
15674: my $otherserver;
15675: if (($major eq '' && $minor eq '') ||
15676: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
15677: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
15678: my $switchlcrev =
15679: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
15680: $userdomserver);
15681: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15682: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
15683: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
15684: my $cdom = $env{'course.'.$courseid.'.domain'};
15685: if ($cdom ne $env{'user.domain'}) {
15686: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
15687: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
15688: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15689: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
15690: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
15691: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
15692: my $canhost =
15693: &Apache::lonnet::can_host_session($env{'user.domain'},
15694: $coursedomserver,
15695: $remoterev,
15696: $udomdefaults{'remotesessions'},
15697: $defdomdefaults{'hostedsessions'});
15698:
15699: if ($canhost) {
15700: $otherserver = $coursedomserver;
15701: } else {
15702: $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.");
15703: }
15704: } else {
15705: $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).");
15706: }
15707: } else {
15708: $otherserver = $userdomserver;
15709: }
15710: }
15711: if ($otherserver ne '') {
15712: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
15713: }
15714: }
15715: }
15716: return ($switchserver,$warning);
15717: }
15718:
15719: =pod
15720:
15721: =item * &check_release_result()
15722:
15723: Inputs:
15724:
15725: $switchwarning - Warning message if no suitable server found to host session.
15726:
15727: $switchserver - query string to append to /adm/switchserver containing lonHostID
15728: and current role.
15729:
15730: Returns: HTML to display with information about requirement to switch server.
15731: Either displaying warning with link to Roles/Courses screen or
15732: display link to switchserver.
15733:
1.1075.2.69 raeburn 15734: =cut
15735:
1.1075.2.88 raeburn 15736: sub check_release_result {
15737: my ($switchwarning,$switchserver) = @_;
15738: my $output = &start_page('Selected course unavailable on this server').
15739: '<p class="LC_warning">';
15740: if ($switchwarning) {
15741: $output .= $switchwarning.'<br /><a href="/adm/roles">';
15742: if (&show_course()) {
15743: $output .= &mt('Display courses');
15744: } else {
15745: $output .= &mt('Display roles');
15746: }
15747: $output .= '</a>';
15748: } elsif ($switchserver) {
15749: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
15750: '<br />'.
15751: '<a href="/adm/switchserver?'.$switchserver.'">'.
15752: &mt('Switch Server').
15753: '</a>';
15754: }
15755: $output .= '</p>'.&end_page();
15756: return $output;
15757: }
15758:
15759: =pod
15760:
15761: =item * &needs_coursereinit()
15762:
15763: Determine if course contents stored for user's session needs to be
15764: refreshed, because content has changed since "Big Hash" last tied.
15765:
15766: Check for change is made if time last checked is more than 10 minutes ago
15767: (by default).
15768:
15769: Inputs:
15770:
15771: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15772:
15773: $interval (optional) - Time which may elapse (in s) between last check for content
15774: change in current course. (default: 600 s).
15775:
15776: Returns: an array; first element is:
15777:
15778: =over 4
15779:
15780: 'switch' - if content updates mean user's session
15781: needs to be switched to a server running a newer LON-CAPA version
15782:
15783: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
15784: on current server hosting user's session
15785:
15786: '' - if no action required.
15787:
15788: =back
15789:
15790: If first item element is 'switch':
15791:
15792: second item is $switchwarning - Warning message if no suitable server found to host session.
15793:
15794: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
15795: and current role.
15796:
15797: otherwise: no other elements returned.
15798:
15799: =back
15800:
15801: =cut
15802:
15803: sub needs_coursereinit {
15804: my ($loncaparev,$interval) = @_;
15805: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
15806: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
15807: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
15808: my $now = time;
15809: if ($interval eq '') {
15810: $interval = 600;
15811: }
15812: if (($now-$env{'request.course.timechecked'})>$interval) {
15813: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
15814: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
15815: if ($lastchange > $env{'request.course.tied'}) {
15816: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15817: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
15818: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
15819: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
15820: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
15821: $curr_reqd_hash{'internal.releaserequired'}});
15822: my ($switchserver,$switchwarning) =
15823: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
15824: $curr_reqd_hash{'internal.releaserequired'});
15825: if ($switchwarning ne '' || $switchserver ne '') {
15826: return ('switch',$switchwarning,$switchserver);
15827: }
15828: }
15829: }
15830: return ('update');
15831: }
15832: }
15833: return ();
15834: }
1.1075.2.69 raeburn 15835:
1.1075.2.11 raeburn 15836: sub update_content_constraints {
15837: my ($cdom,$cnum,$chome,$cid) = @_;
15838: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15839: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15840: my %checkresponsetypes;
15841: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15842: my ($item,$name,$value) = split(/:/,$key);
15843: if ($item eq 'resourcetag') {
15844: if ($name eq 'responsetype') {
15845: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15846: }
15847: }
15848: }
15849: my $navmap = Apache::lonnavmaps::navmap->new();
15850: if (defined($navmap)) {
15851: my %allresponses;
15852: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15853: my %responses = $res->responseTypes();
15854: foreach my $key (keys(%responses)) {
15855: next unless(exists($checkresponsetypes{$key}));
15856: $allresponses{$key} += $responses{$key};
15857: }
15858: }
15859: foreach my $key (keys(%allresponses)) {
15860: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15861: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15862: ($reqdmajor,$reqdminor) = ($major,$minor);
15863: }
15864: }
15865: undef($navmap);
15866: }
15867: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15868: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15869: }
15870: return;
15871: }
15872:
1.1075.2.27 raeburn 15873: sub allmaps_incourse {
15874: my ($cdom,$cnum,$chome,$cid) = @_;
15875: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15876: $cid = $env{'request.course.id'};
15877: $cdom = $env{'course.'.$cid.'.domain'};
15878: $cnum = $env{'course.'.$cid.'.num'};
15879: $chome = $env{'course.'.$cid.'.home'};
15880: }
15881: my %allmaps = ();
15882: my $lastchange =
15883: &Apache::lonnet::get_coursechange($cdom,$cnum);
15884: if ($lastchange > $env{'request.course.tied'}) {
15885: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15886: unless ($ferr) {
15887: &update_content_constraints($cdom,$cnum,$chome,$cid);
15888: }
15889: }
15890: my $navmap = Apache::lonnavmaps::navmap->new();
15891: if (defined($navmap)) {
15892: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15893: $allmaps{$res->src()} = 1;
15894: }
15895: }
15896: return \%allmaps;
15897: }
15898:
1.1075.2.11 raeburn 15899: sub parse_supplemental_title {
15900: my ($title) = @_;
15901:
15902: my ($foldertitle,$renametitle);
15903: if ($title =~ /&&&/) {
15904: $title = &HTML::Entites::decode($title);
15905: }
15906: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15907: $renametitle=$4;
15908: my ($time,$uname,$udom) = ($1,$2,$3);
15909: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15910: my $name = &plainname($uname,$udom);
15911: $name = &HTML::Entities::encode($name,'"<>&\'');
15912: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15913: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15914: $name.': <br />'.$foldertitle;
15915: }
15916: if (wantarray) {
15917: return ($title,$foldertitle,$renametitle);
15918: }
15919: return $title;
15920: }
15921:
1.1075.2.43 raeburn 15922: sub recurse_supplemental {
15923: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15924: if ($suppmap) {
15925: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15926: if ($fatal) {
15927: $errors ++;
15928: } else {
15929: if ($#LONCAPA::map::resources > 0) {
15930: foreach my $res (@LONCAPA::map::resources) {
15931: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15932: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 15933: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15934: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 15935: } else {
15936: $numfiles ++;
15937: }
15938: }
15939: }
15940: }
15941: }
15942: }
15943: return ($numfiles,$errors);
15944: }
15945:
1.1075.2.18 raeburn 15946: sub symb_to_docspath {
15947: my ($symb) = @_;
15948: return unless ($symb);
15949: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15950: if ($resurl=~/\.(sequence|page)$/) {
15951: $mapurl=$resurl;
15952: } elsif ($resurl eq 'adm/navmaps') {
15953: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15954: }
15955: my $mapresobj;
15956: my $navmap = Apache::lonnavmaps::navmap->new();
15957: if (ref($navmap)) {
15958: $mapresobj = $navmap->getResourceByUrl($mapurl);
15959: }
15960: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15961: my $type=$2;
15962: my $path;
15963: if (ref($mapresobj)) {
15964: my $pcslist = $mapresobj->map_hierarchy();
15965: if ($pcslist ne '') {
15966: foreach my $pc (split(/,/,$pcslist)) {
15967: next if ($pc <= 1);
15968: my $res = $navmap->getByMapPc($pc);
15969: if (ref($res)) {
15970: my $thisurl = $res->src();
15971: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15972: my $thistitle = $res->title();
15973: $path .= '&'.
15974: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 15975: &escape($thistitle).
1.1075.2.18 raeburn 15976: ':'.$res->randompick().
15977: ':'.$res->randomout().
15978: ':'.$res->encrypted().
15979: ':'.$res->randomorder().
15980: ':'.$res->is_page();
15981: }
15982: }
15983: }
15984: $path =~ s/^\&//;
15985: my $maptitle = $mapresobj->title();
15986: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15987: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15988: }
15989: $path .= (($path ne '')? '&' : '').
15990: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15991: &escape($maptitle).
1.1075.2.18 raeburn 15992: ':'.$mapresobj->randompick().
15993: ':'.$mapresobj->randomout().
15994: ':'.$mapresobj->encrypted().
15995: ':'.$mapresobj->randomorder().
15996: ':'.$mapresobj->is_page();
15997: } else {
15998: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15999: my $ispage = (($type eq 'page')? 1 : '');
16000: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 16001: $maptitle = 'Main Content';
1.1075.2.18 raeburn 16002: }
16003: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 16004: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 16005: }
16006: unless ($mapurl eq 'default') {
16007: $path = 'default&'.
1.1075.2.46 raeburn 16008: &escape('Main Content').
1.1075.2.18 raeburn 16009: ':::::&'.$path;
16010: }
16011: return $path;
16012: }
16013:
1.1075.2.14 raeburn 16014: sub captcha_display {
16015: my ($context,$lonhost) = @_;
16016: my ($output,$error);
16017: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
16018: if ($captcha eq 'original') {
16019: $output = &create_captcha();
16020: unless ($output) {
16021: $error = 'captcha';
16022: }
16023: } elsif ($captcha eq 'recaptcha') {
16024: $output = &create_recaptcha($pubkey);
16025: unless ($output) {
16026: $error = 'recaptcha';
16027: }
16028: }
1.1075.2.66 raeburn 16029: return ($output,$error,$captcha);
1.1075.2.14 raeburn 16030: }
16031:
16032: sub captcha_response {
16033: my ($context,$lonhost) = @_;
16034: my ($captcha_chk,$captcha_error);
16035: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
16036: if ($captcha eq 'original') {
16037: ($captcha_chk,$captcha_error) = &check_captcha();
16038: } elsif ($captcha eq 'recaptcha') {
16039: $captcha_chk = &check_recaptcha($privkey);
16040: } else {
16041: $captcha_chk = 1;
16042: }
16043: return ($captcha_chk,$captcha_error);
16044: }
16045:
16046: sub get_captcha_config {
16047: my ($context,$lonhost) = @_;
16048: my ($captcha,$pubkey,$privkey,$hashtocheck);
16049: my $hostname = &Apache::lonnet::hostname($lonhost);
16050: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
16051: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16052: if ($context eq 'usercreation') {
16053: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
16054: if (ref($domconfig{$context}) eq 'HASH') {
16055: $hashtocheck = $domconfig{$context}{'cancreate'};
16056: if (ref($hashtocheck) eq 'HASH') {
16057: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
16058: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
16059: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
16060: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
16061: }
16062: if ($privkey && $pubkey) {
16063: $captcha = 'recaptcha';
16064: } else {
16065: $captcha = 'original';
16066: }
16067: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
16068: $captcha = 'original';
16069: }
16070: }
16071: } else {
16072: $captcha = 'captcha';
16073: }
16074: } elsif ($context eq 'login') {
16075: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
16076: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
16077: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
16078: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
16079: if ($privkey && $pubkey) {
16080: $captcha = 'recaptcha';
16081: } else {
16082: $captcha = 'original';
16083: }
16084: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
16085: $captcha = 'original';
16086: }
16087: }
16088: return ($captcha,$pubkey,$privkey);
16089: }
16090:
16091: sub create_captcha {
16092: my %captcha_params = &captcha_settings();
16093: my ($output,$maxtries,$tries) = ('',10,0);
16094: while ($tries < $maxtries) {
16095: $tries ++;
16096: my $captcha = Authen::Captcha->new (
16097: output_folder => $captcha_params{'output_dir'},
16098: data_folder => $captcha_params{'db_dir'},
16099: );
16100: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
16101:
16102: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
16103: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
16104: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.66 raeburn 16105: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
16106: '<br />'.
16107: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 16108: last;
16109: }
16110: }
16111: return $output;
16112: }
16113:
16114: sub captcha_settings {
16115: my %captcha_params = (
16116: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
16117: www_output_dir => "/captchaspool",
16118: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
16119: numchars => '5',
16120: );
16121: return %captcha_params;
16122: }
16123:
16124: sub check_captcha {
16125: my ($captcha_chk,$captcha_error);
16126: my $code = $env{'form.code'};
16127: my $md5sum = $env{'form.crypt'};
16128: my %captcha_params = &captcha_settings();
16129: my $captcha = Authen::Captcha->new(
16130: output_folder => $captcha_params{'output_dir'},
16131: data_folder => $captcha_params{'db_dir'},
16132: );
1.1075.2.26 raeburn 16133: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 16134: my %captcha_hash = (
16135: 0 => 'Code not checked (file error)',
16136: -1 => 'Failed: code expired',
16137: -2 => 'Failed: invalid code (not in database)',
16138: -3 => 'Failed: invalid code (code does not match crypt)',
16139: );
16140: if ($captcha_chk != 1) {
16141: $captcha_error = $captcha_hash{$captcha_chk}
16142: }
16143: return ($captcha_chk,$captcha_error);
16144: }
16145:
16146: sub create_recaptcha {
16147: my ($pubkey) = @_;
1.1075.2.51 raeburn 16148: my $use_ssl;
16149: if ($ENV{'SERVER_PORT'} == 443) {
16150: $use_ssl = 1;
16151: }
1.1075.2.14 raeburn 16152: my $captcha = Captcha::reCAPTCHA->new;
16153: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51 raeburn 16154: $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.92 raeburn 16155: &mt('If the text is hard to read, [_1] will replace them.',
1.1075.2.39 raeburn 16156: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14 raeburn 16157: '<br /><br />';
16158: }
16159:
16160: sub check_recaptcha {
16161: my ($privkey) = @_;
16162: my $captcha_chk;
16163: my $captcha = Captcha::reCAPTCHA->new;
16164: my $captcha_result =
16165: $captcha->check_answer(
16166: $privkey,
16167: $ENV{'REMOTE_ADDR'},
16168: $env{'form.recaptcha_challenge_field'},
16169: $env{'form.recaptcha_response_field'},
16170: );
16171: if ($captcha_result->{is_valid}) {
16172: $captcha_chk = 1;
16173: }
16174: return $captcha_chk;
16175: }
16176:
1.1075.2.64 raeburn 16177: sub emailusername_info {
1.1075.2.103 raeburn 16178: my @fields = ('firstname','lastname','institution','web','location','officialemail','id');
1.1075.2.64 raeburn 16179: my %titles = &Apache::lonlocal::texthash (
16180: lastname => 'Last Name',
16181: firstname => 'First Name',
16182: institution => 'School/college/university',
16183: location => "School's city, state/province, country",
16184: web => "School's web address",
16185: officialemail => 'E-mail address at institution (if different)',
1.1075.2.103 raeburn 16186: id => 'Student/Employee ID',
1.1075.2.64 raeburn 16187: );
16188: return (\@fields,\%titles);
16189: }
16190:
1.1075.2.56 raeburn 16191: sub cleanup_html {
16192: my ($incoming) = @_;
16193: my $outgoing;
16194: if ($incoming ne '') {
16195: $outgoing = $incoming;
16196: $outgoing =~ s/;/;/g;
16197: $outgoing =~ s/\#/#/g;
16198: $outgoing =~ s/\&/&/g;
16199: $outgoing =~ s/</</g;
16200: $outgoing =~ s/>/>/g;
16201: $outgoing =~ s/\(/(/g;
16202: $outgoing =~ s/\)/)/g;
16203: $outgoing =~ s/"/"/g;
16204: $outgoing =~ s/'/'/g;
16205: $outgoing =~ s/\$/$/g;
16206: $outgoing =~ s{/}{/}g;
16207: $outgoing =~ s/=/=/g;
16208: $outgoing =~ s/\\/\/g
16209: }
16210: return $outgoing;
16211: }
16212:
1.1075.2.74 raeburn 16213: # Checks for critical messages and returns a redirect url if one exists.
16214: # $interval indicates how often to check for messages.
16215: sub critical_redirect {
16216: my ($interval) = @_;
16217: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16218: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16219: $env{'user.name'});
16220: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
16221: my $redirecturl;
16222: if ($what[0]) {
16223: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16224: $redirecturl='/adm/email?critical=display';
16225: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16226: return (1, $url);
16227: }
16228: }
16229: }
16230: return ();
16231: }
16232:
1.1075.2.64 raeburn 16233: # Use:
16234: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16235: #
16236: ##################################################
16237: # password associated functions #
16238: ##################################################
16239: sub des_keys {
16240: # Make a new key for DES encryption.
16241: # Each key has two parts which are returned separately.
16242: # Please note: Each key must be passed through the &hex function
16243: # before it is output to the web browser. The hex versions cannot
16244: # be used to decrypt.
16245: my @hexstr=('0','1','2','3','4','5','6','7',
16246: '8','9','a','b','c','d','e','f');
16247: my $lkey='';
16248: for (0..7) {
16249: $lkey.=$hexstr[rand(15)];
16250: }
16251: my $ukey='';
16252: for (0..7) {
16253: $ukey.=$hexstr[rand(15)];
16254: }
16255: return ($lkey,$ukey);
16256: }
16257:
16258: sub des_decrypt {
16259: my ($key,$cyphertext) = @_;
16260: my $keybin=pack("H16",$key);
16261: my $cypher;
16262: if ($Crypt::DES::VERSION>=2.03) {
16263: $cypher=new Crypt::DES $keybin;
16264: } else {
16265: $cypher=new DES $keybin;
16266: }
16267: my $plaintext=
16268: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
16269: $plaintext.=
16270: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
16271: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
16272: return $plaintext;
16273: }
16274:
1.112 bowersj2 16275: 1;
16276: __END__;
1.41 ng 16277:
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