Annotation of loncom/interface/loncommon.pm, revision 1.1075.2.102
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.102! raeburn 4: # $Id: loncommon.pm,v 1.1075.2.101 2016/08/05 22:24:31 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.
9875: (b) endreserve: end date of reservation period.
9876:
9877: sorted_future - ref to array of student_schedulable slots reservable in
9878: the future, ordered by start date of reservation period.
9879:
9880: future_reservable - ref to hash of student_schedulable slots reservable
9881: in the future.
9882:
9883: Keys in inner hash are:
9884: (a) symb: either blank or symb to which slot use is restricted.
9885: (b) startreserve: start date of reservation period.
9886:
9887: =back
9888:
9889: =cut
9890:
9891: sub get_future_slots {
9892: my ($cnum,$cdom,$now,$symb) = @_;
9893: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9894: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9895: foreach my $slot (keys(%slots)) {
9896: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9897: if ($symb) {
9898: next if (($slots{$slot}->{'symb'} ne '') &&
9899: ($slots{$slot}->{'symb'} ne $symb));
9900: }
9901: if (($slots{$slot}->{'starttime'} > $now) &&
9902: ($slots{$slot}->{'endtime'} > $now)) {
9903: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9904: my $userallowed = 0;
9905: if ($slots{$slot}->{'allowedsections'}) {
9906: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9907: if (!defined($env{'request.role.sec'})
9908: && grep(/^No section assigned$/,@allowed_sec)) {
9909: $userallowed=1;
9910: } else {
9911: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9912: $userallowed=1;
9913: }
9914: }
9915: unless ($userallowed) {
9916: if (defined($env{'request.course.groups'})) {
9917: my @groups = split(/:/,$env{'request.course.groups'});
9918: foreach my $group (@groups) {
9919: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9920: $userallowed=1;
9921: last;
9922: }
9923: }
9924: }
9925: }
9926: }
9927: if ($slots{$slot}->{'allowedusers'}) {
9928: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9929: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9930: if (grep(/^\Q$user\E$/,@allowed_users)) {
9931: $userallowed = 1;
9932: }
9933: }
9934: next unless($userallowed);
9935: }
9936: my $startreserve = $slots{$slot}->{'startreserve'};
9937: my $endreserve = $slots{$slot}->{'endreserve'};
9938: my $symb = $slots{$slot}->{'symb'};
9939: if (($startreserve < $now) &&
9940: (!$endreserve || $endreserve > $now)) {
9941: my $lastres = $endreserve;
9942: if (!$lastres) {
9943: $lastres = $slots{$slot}->{'starttime'};
9944: }
9945: $reservable_now{$slot} = {
9946: symb => $symb,
9947: endreserve => $lastres
9948: };
9949: } elsif (($startreserve > $now) &&
9950: (!$endreserve || $endreserve > $startreserve)) {
9951: $future_reservable{$slot} = {
9952: symb => $symb,
9953: startreserve => $startreserve
9954: };
9955: }
9956: }
9957: }
9958: my @unsorted_reservable = keys(%reservable_now);
9959: if (@unsorted_reservable > 0) {
9960: @sorted_reservable =
9961: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9962: }
9963: my @unsorted_future = keys(%future_reservable);
9964: if (@unsorted_future > 0) {
9965: @sorted_future =
9966: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9967: }
9968: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9969: }
1.780 raeburn 9970:
9971: =pod
9972:
1.1057 foxr 9973: =back
9974:
1.549 albertel 9975: =head1 HTTP Helpers
9976:
9977: =over 4
9978:
1.648 raeburn 9979: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9980:
1.258 albertel 9981: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9982: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9983: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9984:
9985: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9986: $possible_names is an ref to an array of form element names. As an example:
9987: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9988: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9989:
9990: =cut
1.1 albertel 9991:
1.6 albertel 9992: sub get_unprocessed_cgi {
1.25 albertel 9993: my ($query,$possible_names)= @_;
1.26 matthew 9994: # $Apache::lonxml::debug=1;
1.356 albertel 9995: foreach my $pair (split(/&/,$query)) {
9996: my ($name, $value) = split(/=/,$pair);
1.369 www 9997: $name = &unescape($name);
1.25 albertel 9998: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9999: $value =~ tr/+/ /;
10000: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 10001: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 10002: }
1.16 harris41 10003: }
1.6 albertel 10004: }
10005:
1.112 bowersj2 10006: =pod
10007:
1.648 raeburn 10008: =item * &cacheheader()
1.112 bowersj2 10009:
10010: returns cache-controlling header code
10011:
10012: =cut
10013:
1.7 albertel 10014: sub cacheheader {
1.258 albertel 10015: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 10016: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
10017: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 10018: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
10019: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 10020: return $output;
1.7 albertel 10021: }
10022:
1.112 bowersj2 10023: =pod
10024:
1.648 raeburn 10025: =item * &no_cache($r)
1.112 bowersj2 10026:
10027: specifies header code to not have cache
10028:
10029: =cut
10030:
1.9 albertel 10031: sub no_cache {
1.216 albertel 10032: my ($r) = @_;
10033: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 10034: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 10035: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
10036: $r->no_cache(1);
10037: $r->header_out("Expires" => $date);
10038: $r->header_out("Pragma" => "no-cache");
1.123 www 10039: }
10040:
10041: sub content_type {
1.181 albertel 10042: my ($r,$type,$charset) = @_;
1.299 foxr 10043: if ($r) {
10044: # Note that printout.pl calls this with undef for $r.
10045: &no_cache($r);
10046: }
1.258 albertel 10047: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 10048: unless ($charset) {
10049: $charset=&Apache::lonlocal::current_encoding;
10050: }
10051: if ($charset) { $type.='; charset='.$charset; }
10052: if ($r) {
10053: $r->content_type($type);
10054: } else {
10055: print("Content-type: $type\n\n");
10056: }
1.9 albertel 10057: }
1.25 albertel 10058:
1.112 bowersj2 10059: =pod
10060:
1.648 raeburn 10061: =item * &add_to_env($name,$value)
1.112 bowersj2 10062:
1.258 albertel 10063: adds $name to the %env hash with value
1.112 bowersj2 10064: $value, if $name already exists, the entry is converted to an array
10065: reference and $value is added to the array.
10066:
10067: =cut
10068:
1.25 albertel 10069: sub add_to_env {
10070: my ($name,$value)=@_;
1.258 albertel 10071: if (defined($env{$name})) {
10072: if (ref($env{$name})) {
1.25 albertel 10073: #already have multiple values
1.258 albertel 10074: push(@{ $env{$name} },$value);
1.25 albertel 10075: } else {
10076: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 10077: my $first=$env{$name};
10078: undef($env{$name});
10079: push(@{ $env{$name} },$first,$value);
1.25 albertel 10080: }
10081: } else {
1.258 albertel 10082: $env{$name}=$value;
1.25 albertel 10083: }
1.31 albertel 10084: }
1.149 albertel 10085:
10086: =pod
10087:
1.648 raeburn 10088: =item * &get_env_multiple($name)
1.149 albertel 10089:
1.258 albertel 10090: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 10091: values may be defined and end up as an array ref.
10092:
10093: returns an array of values
10094:
10095: =cut
10096:
10097: sub get_env_multiple {
10098: my ($name) = @_;
10099: my @values;
1.258 albertel 10100: if (defined($env{$name})) {
1.149 albertel 10101: # exists is it an array
1.258 albertel 10102: if (ref($env{$name})) {
10103: @values=@{ $env{$name} };
1.149 albertel 10104: } else {
1.258 albertel 10105: $values[0]=$env{$name};
1.149 albertel 10106: }
10107: }
10108: return(@values);
10109: }
10110:
1.660 raeburn 10111: sub ask_for_embedded_content {
10112: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 10113: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1075.2.11 raeburn 10114: %currsubfile,%unused,$rem);
1.1071 raeburn 10115: my $counter = 0;
10116: my $numnew = 0;
1.987 raeburn 10117: my $numremref = 0;
10118: my $numinvalid = 0;
10119: my $numpathchg = 0;
10120: my $numexisting = 0;
1.1071 raeburn 10121: my $numunused = 0;
10122: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1075.2.53 raeburn 10123: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 10124: my $heading = &mt('Upload embedded files');
10125: my $buttontext = &mt('Upload');
10126:
1.1075.2.11 raeburn 10127: if ($env{'request.course.id'}) {
1.1075.2.35 raeburn 10128: if ($actionurl eq '/adm/dependencies') {
10129: $navmap = Apache::lonnavmaps::navmap->new();
10130: }
10131: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
10132: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1075.2.11 raeburn 10133: }
1.1075.2.35 raeburn 10134: if (($actionurl eq '/adm/portfolio') ||
10135: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 10136: my $current_path='/';
10137: if ($env{'form.currentpath'}) {
10138: $current_path = $env{'form.currentpath'};
10139: }
10140: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1075.2.35 raeburn 10141: $udom = $cdom;
10142: $uname = $cnum;
1.984 raeburn 10143: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
10144: } else {
10145: $udom = $env{'user.domain'};
10146: $uname = $env{'user.name'};
10147: $url = '/userfiles/portfolio';
10148: }
1.987 raeburn 10149: $toplevel = $url.'/';
1.984 raeburn 10150: $url .= $current_path;
10151: $getpropath = 1;
1.987 raeburn 10152: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10153: ($actionurl eq '/adm/imsimport')) {
1.1022 www 10154: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 10155: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 10156: $toplevel = $url;
1.984 raeburn 10157: if ($rest ne '') {
1.987 raeburn 10158: $url .= $rest;
10159: }
10160: } elsif ($actionurl eq '/adm/coursedocs') {
10161: if (ref($args) eq 'HASH') {
1.1071 raeburn 10162: $url = $args->{'docs_url'};
10163: $toplevel = $url;
1.1075.2.11 raeburn 10164: if ($args->{'context'} eq 'paste') {
10165: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
10166: ($path) =
10167: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10168: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10169: $fileloc =~ s{^/}{};
10170: }
1.1071 raeburn 10171: }
10172: } elsif ($actionurl eq '/adm/dependencies') {
10173: if ($env{'request.course.id'} ne '') {
10174: if (ref($args) eq 'HASH') {
10175: $url = $args->{'docs_url'};
10176: $title = $args->{'docs_title'};
1.1075.2.35 raeburn 10177: $toplevel = $url;
10178: unless ($toplevel =~ m{^/}) {
10179: $toplevel = "/$url";
10180: }
1.1075.2.11 raeburn 10181: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1075.2.35 raeburn 10182: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
10183: $path = $1;
10184: } else {
10185: ($path) =
10186: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
10187: }
1.1075.2.79 raeburn 10188: if ($toplevel=~/^\/*(uploaded|editupload)/) {
10189: $fileloc = $toplevel;
10190: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
10191: my ($udom,$uname,$fname) =
10192: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
10193: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
10194: } else {
10195: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
10196: }
1.1071 raeburn 10197: $fileloc =~ s{^/}{};
10198: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
10199: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
10200: }
1.987 raeburn 10201: }
1.1075.2.35 raeburn 10202: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10203: $udom = $cdom;
10204: $uname = $cnum;
10205: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
10206: $toplevel = $url;
10207: $path = $url;
10208: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
10209: $fileloc =~ s{^/}{};
10210: }
10211: foreach my $file (keys(%{$allfiles})) {
10212: my $embed_file;
10213: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
10214: $embed_file = $1;
10215: } else {
10216: $embed_file = $file;
10217: }
1.1075.2.55 raeburn 10218: my ($absolutepath,$cleaned_file);
10219: if ($embed_file =~ m{^\w+://}) {
10220: $cleaned_file = $embed_file;
1.1075.2.47 raeburn 10221: $newfiles{$cleaned_file} = 1;
10222: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10223: } else {
1.1075.2.55 raeburn 10224: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10225: if ($embed_file =~ m{^/}) {
10226: $absolutepath = $embed_file;
10227: }
1.1075.2.47 raeburn 10228: if ($cleaned_file =~ m{/}) {
10229: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10230: $path = &check_for_traversal($path,$url,$toplevel);
10231: my $item = $fname;
10232: if ($path ne '') {
10233: $item = $path.'/'.$fname;
10234: $subdependencies{$path}{$fname} = 1;
10235: } else {
10236: $dependencies{$item} = 1;
10237: }
10238: if ($absolutepath) {
10239: $mapping{$item} = $absolutepath;
10240: } else {
10241: $mapping{$item} = $embed_file;
10242: }
10243: } else {
10244: $dependencies{$embed_file} = 1;
10245: if ($absolutepath) {
1.1075.2.47 raeburn 10246: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10247: } else {
1.1075.2.47 raeburn 10248: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10249: }
10250: }
1.984 raeburn 10251: }
10252: }
1.1071 raeburn 10253: my $dirptr = 16384;
1.984 raeburn 10254: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10255: $currsubfile{$path} = {};
1.1075.2.35 raeburn 10256: if (($actionurl eq '/adm/portfolio') ||
10257: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10258: my ($sublistref,$listerror) =
10259: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10260: if (ref($sublistref) eq 'ARRAY') {
10261: foreach my $line (@{$sublistref}) {
10262: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10263: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10264: }
1.984 raeburn 10265: }
1.987 raeburn 10266: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10267: if (opendir(my $dir,$url.'/'.$path)) {
10268: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10269: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10270: }
1.1075.2.11 raeburn 10271: } elsif (($actionurl eq '/adm/dependencies') ||
10272: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10273: ($args->{'context'} eq 'paste')) ||
10274: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10275: if ($env{'request.course.id'} ne '') {
1.1075.2.35 raeburn 10276: my $dir;
10277: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10278: $dir = $fileloc;
10279: } else {
10280: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10281: }
1.1071 raeburn 10282: if ($dir ne '') {
10283: my ($sublistref,$listerror) =
10284: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10285: if (ref($sublistref) eq 'ARRAY') {
10286: foreach my $line (@{$sublistref}) {
10287: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10288: undef,$mtime)=split(/\&/,$line,12);
10289: unless (($testdir&$dirptr) ||
10290: ($file_name =~ /^\.\.?$/)) {
10291: $currsubfile{$path}{$file_name} = [$size,$mtime];
10292: }
10293: }
10294: }
10295: }
1.984 raeburn 10296: }
10297: }
10298: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10299: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10300: my $item = $path.'/'.$file;
10301: unless ($mapping{$item} eq $item) {
10302: $pathchanges{$item} = 1;
10303: }
10304: $existing{$item} = 1;
10305: $numexisting ++;
10306: } else {
10307: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10308: }
10309: }
1.1071 raeburn 10310: if ($actionurl eq '/adm/dependencies') {
10311: foreach my $path (keys(%currsubfile)) {
10312: if (ref($currsubfile{$path}) eq 'HASH') {
10313: foreach my $file (keys(%{$currsubfile{$path}})) {
10314: unless ($subdependencies{$path}{$file}) {
1.1075.2.11 raeburn 10315: next if (($rem ne '') &&
10316: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10317: (ref($navmap) &&
10318: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10319: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10320: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10321: $unused{$path.'/'.$file} = 1;
10322: }
10323: }
10324: }
10325: }
10326: }
1.984 raeburn 10327: }
1.987 raeburn 10328: my %currfile;
1.1075.2.35 raeburn 10329: if (($actionurl eq '/adm/portfolio') ||
10330: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10331: my ($dirlistref,$listerror) =
10332: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10333: if (ref($dirlistref) eq 'ARRAY') {
10334: foreach my $line (@{$dirlistref}) {
10335: my ($file_name,$rest) = split(/\&/,$line,2);
10336: $currfile{$file_name} = 1;
10337: }
1.984 raeburn 10338: }
1.987 raeburn 10339: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10340: if (opendir(my $dir,$url)) {
1.987 raeburn 10341: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10342: map {$currfile{$_} = 1;} @dir_list;
10343: }
1.1075.2.11 raeburn 10344: } elsif (($actionurl eq '/adm/dependencies') ||
10345: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1075.2.35 raeburn 10346: ($args->{'context'} eq 'paste')) ||
10347: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10348: if ($env{'request.course.id'} ne '') {
10349: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10350: if ($dir ne '') {
10351: my ($dirlistref,$listerror) =
10352: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10353: if (ref($dirlistref) eq 'ARRAY') {
10354: foreach my $line (@{$dirlistref}) {
10355: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10356: $size,undef,$mtime)=split(/\&/,$line,12);
10357: unless (($testdir&$dirptr) ||
10358: ($file_name =~ /^\.\.?$/)) {
10359: $currfile{$file_name} = [$size,$mtime];
10360: }
10361: }
10362: }
10363: }
10364: }
1.984 raeburn 10365: }
10366: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10367: if (exists($currfile{$file})) {
1.987 raeburn 10368: unless ($mapping{$file} eq $file) {
10369: $pathchanges{$file} = 1;
10370: }
10371: $existing{$file} = 1;
10372: $numexisting ++;
10373: } else {
1.984 raeburn 10374: $newfiles{$file} = 1;
10375: }
10376: }
1.1071 raeburn 10377: foreach my $file (keys(%currfile)) {
10378: unless (($file eq $filename) ||
10379: ($file eq $filename.'.bak') ||
10380: ($dependencies{$file})) {
1.1075.2.11 raeburn 10381: if ($actionurl eq '/adm/dependencies') {
1.1075.2.35 raeburn 10382: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10383: next if (($rem ne '') &&
10384: (($env{"httpref.$rem".$file} ne '') ||
10385: (ref($navmap) &&
10386: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10387: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10388: ($navmap->getResourceByUrl($rem.$1)))))));
10389: }
1.1075.2.11 raeburn 10390: }
1.1071 raeburn 10391: $unused{$file} = 1;
10392: }
10393: }
1.1075.2.11 raeburn 10394: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10395: ($args->{'context'} eq 'paste')) {
10396: $counter = scalar(keys(%existing));
10397: $numpathchg = scalar(keys(%pathchanges));
10398: return ($output,$counter,$numpathchg,\%existing);
1.1075.2.35 raeburn 10399: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10400: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10401: $counter = scalar(keys(%existing));
10402: $numpathchg = scalar(keys(%pathchanges));
10403: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1075.2.11 raeburn 10404: }
1.984 raeburn 10405: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10406: if ($actionurl eq '/adm/dependencies') {
10407: next if ($embed_file =~ m{^\w+://});
10408: }
1.660 raeburn 10409: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10410: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10411: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10412: unless ($mapping{$embed_file} eq $embed_file) {
1.1075.2.35 raeburn 10413: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10414: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10415: }
1.1075.2.35 raeburn 10416: $upload_output .= '</td>';
1.1071 raeburn 10417: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1075.2.35 raeburn 10418: $upload_output.='<td align="right">'.
10419: '<span class="LC_info LC_fontsize_medium">'.
10420: &mt("URL points to web address").'</span>';
1.987 raeburn 10421: $numremref++;
1.660 raeburn 10422: } elsif ($args->{'error_on_invalid_names'}
10423: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1075.2.35 raeburn 10424: $upload_output.='<td align="right"><span class="LC_warning">'.
10425: &mt('Invalid characters').'</span>';
1.987 raeburn 10426: $numinvalid++;
1.660 raeburn 10427: } else {
1.1075.2.35 raeburn 10428: $upload_output .= '<td>'.
10429: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10430: $embed_file,\%mapping,
1.1071 raeburn 10431: $allfiles,$codebase,'upload');
10432: $counter ++;
10433: $numnew ++;
1.987 raeburn 10434: }
10435: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10436: }
10437: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10438: if ($actionurl eq '/adm/dependencies') {
10439: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10440: $modify_output .= &start_data_table_row().
10441: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10442: '<img src="'.&icon($embed_file).'" border="0" />'.
10443: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10444: '<td>'.$size.'</td>'.
10445: '<td>'.$mtime.'</td>'.
10446: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10447: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10448: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10449: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10450: &embedded_file_element('upload_embedded',$counter,
10451: $embed_file,\%mapping,
10452: $allfiles,$codebase,'modify').
10453: '</div></td>'.
10454: &end_data_table_row()."\n";
10455: $counter ++;
10456: } else {
10457: $upload_output .= &start_data_table_row().
1.1075.2.35 raeburn 10458: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10459: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10460: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10461: &Apache::loncommon::end_data_table_row()."\n";
10462: }
10463: }
10464: my $delidx = $counter;
10465: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10466: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10467: $delete_output .= &start_data_table_row().
10468: '<td><img src="'.&icon($oldfile).'" />'.
10469: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10470: '<td>'.$size.'</td>'.
10471: '<td>'.$mtime.'</td>'.
10472: '<td><label><input type="checkbox" name="del_upload_dep" '.
10473: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10474: &embedded_file_element('upload_embedded',$delidx,
10475: $oldfile,\%mapping,$allfiles,
10476: $codebase,'delete').'</td>'.
10477: &end_data_table_row()."\n";
10478: $numunused ++;
10479: $delidx ++;
1.987 raeburn 10480: }
10481: if ($upload_output) {
10482: $upload_output = &start_data_table().
10483: $upload_output.
10484: &end_data_table()."\n";
10485: }
1.1071 raeburn 10486: if ($modify_output) {
10487: $modify_output = &start_data_table().
10488: &start_data_table_header_row().
10489: '<th>'.&mt('File').'</th>'.
10490: '<th>'.&mt('Size (KB)').'</th>'.
10491: '<th>'.&mt('Modified').'</th>'.
10492: '<th>'.&mt('Upload replacement?').'</th>'.
10493: &end_data_table_header_row().
10494: $modify_output.
10495: &end_data_table()."\n";
10496: }
10497: if ($delete_output) {
10498: $delete_output = &start_data_table().
10499: &start_data_table_header_row().
10500: '<th>'.&mt('File').'</th>'.
10501: '<th>'.&mt('Size (KB)').'</th>'.
10502: '<th>'.&mt('Modified').'</th>'.
10503: '<th>'.&mt('Delete?').'</th>'.
10504: &end_data_table_header_row().
10505: $delete_output.
10506: &end_data_table()."\n";
10507: }
1.987 raeburn 10508: my $applies = 0;
10509: if ($numremref) {
10510: $applies ++;
10511: }
10512: if ($numinvalid) {
10513: $applies ++;
10514: }
10515: if ($numexisting) {
10516: $applies ++;
10517: }
1.1071 raeburn 10518: if ($counter || $numunused) {
1.987 raeburn 10519: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10520: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10521: $state.'<h3>'.$heading.'</h3>';
10522: if ($actionurl eq '/adm/dependencies') {
10523: if ($numnew) {
10524: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10525: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10526: $upload_output.'<br />'."\n";
10527: }
10528: if ($numexisting) {
10529: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10530: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10531: $modify_output.'<br />'."\n";
10532: $buttontext = &mt('Save changes');
10533: }
10534: if ($numunused) {
10535: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10536: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10537: $delete_output.'<br />'."\n";
10538: $buttontext = &mt('Save changes');
10539: }
10540: } else {
10541: $output .= $upload_output.'<br />'."\n";
10542: }
10543: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10544: $counter.'" />'."\n";
10545: if ($actionurl eq '/adm/dependencies') {
10546: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10547: $numnew.'" />'."\n";
10548: } elsif ($actionurl eq '') {
1.987 raeburn 10549: $output .= '<input type="hidden" name="phase" value="three" />';
10550: }
10551: } elsif ($applies) {
10552: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10553: if ($applies > 1) {
10554: $output .=
1.1075.2.35 raeburn 10555: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10556: if ($numremref) {
10557: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10558: }
10559: if ($numinvalid) {
10560: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10561: }
10562: if ($numexisting) {
10563: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10564: }
10565: $output .= '</ul><br />';
10566: } elsif ($numremref) {
10567: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10568: } elsif ($numinvalid) {
10569: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10570: } elsif ($numexisting) {
10571: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10572: }
10573: $output .= $upload_output.'<br />';
10574: }
10575: my ($pathchange_output,$chgcount);
1.1071 raeburn 10576: $chgcount = $counter;
1.987 raeburn 10577: if (keys(%pathchanges) > 0) {
10578: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10579: if ($counter) {
1.987 raeburn 10580: $output .= &embedded_file_element('pathchange',$chgcount,
10581: $embed_file,\%mapping,
1.1071 raeburn 10582: $allfiles,$codebase,'change');
1.987 raeburn 10583: } else {
10584: $pathchange_output .=
10585: &start_data_table_row().
10586: '<td><input type ="checkbox" name="namechange" value="'.
10587: $chgcount.'" checked="checked" /></td>'.
10588: '<td>'.$mapping{$embed_file}.'</td>'.
10589: '<td>'.$embed_file.
10590: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10591: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10592: '</td>'.&end_data_table_row();
1.660 raeburn 10593: }
1.987 raeburn 10594: $numpathchg ++;
10595: $chgcount ++;
1.660 raeburn 10596: }
10597: }
1.1075.2.35 raeburn 10598: if (($counter) || ($numunused)) {
1.987 raeburn 10599: if ($numpathchg) {
10600: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10601: $numpathchg.'" />'."\n";
10602: }
10603: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10604: ($actionurl eq '/adm/imsimport')) {
10605: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10606: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10607: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10608: } elsif ($actionurl eq '/adm/dependencies') {
10609: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10610: }
1.1075.2.35 raeburn 10611: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10612: } elsif ($numpathchg) {
10613: my %pathchange = ();
10614: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10615: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10616: $output .= '<p>'.&mt('or').'</p>';
1.1075.2.35 raeburn 10617: }
1.987 raeburn 10618: }
1.1071 raeburn 10619: return ($output,$counter,$numpathchg);
1.987 raeburn 10620: }
10621:
1.1075.2.47 raeburn 10622: =pod
10623:
10624: =item * clean_path($name)
10625:
10626: Performs clean-up of directories, subdirectories and filename in an
10627: embedded object, referenced in an HTML file which is being uploaded
10628: to a course or portfolio, where
10629: "Upload embedded images/multimedia files if HTML file" checkbox was
10630: checked.
10631:
10632: Clean-up is similar to replacements in lonnet::clean_filename()
10633: except each / between sub-directory and next level is preserved.
10634:
10635: =cut
10636:
10637: sub clean_path {
10638: my ($embed_file) = @_;
10639: $embed_file =~s{^/+}{};
10640: my @contents;
10641: if ($embed_file =~ m{/}) {
10642: @contents = split(/\//,$embed_file);
10643: } else {
10644: @contents = ($embed_file);
10645: }
10646: my $lastidx = scalar(@contents)-1;
10647: for (my $i=0; $i<=$lastidx; $i++) {
10648: $contents[$i]=~s{\\}{/}g;
10649: $contents[$i]=~s/\s+/\_/g;
10650: $contents[$i]=~s{[^/\w\.\-]}{}g;
10651: if ($i == $lastidx) {
10652: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10653: }
10654: }
10655: if ($lastidx > 0) {
10656: return join('/',@contents);
10657: } else {
10658: return $contents[0];
10659: }
10660: }
10661:
1.987 raeburn 10662: sub embedded_file_element {
1.1071 raeburn 10663: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10664: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10665: (ref($codebase) eq 'HASH'));
10666: my $output;
1.1071 raeburn 10667: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10668: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10669: }
10670: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10671: &escape($embed_file).'" />';
10672: unless (($context eq 'upload_embedded') &&
10673: ($mapping->{$embed_file} eq $embed_file)) {
10674: $output .='
10675: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10676: }
10677: my $attrib;
10678: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10679: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10680: }
10681: $output .=
10682: "\n\t\t".
10683: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10684: $attrib.'" />';
10685: if (exists($codebase->{$mapping->{$embed_file}})) {
10686: $output .=
10687: "\n\t\t".
10688: '<input name="codebase_'.$num.'" type="hidden" value="'.
10689: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10690: }
1.987 raeburn 10691: return $output;
1.660 raeburn 10692: }
10693:
1.1071 raeburn 10694: sub get_dependency_details {
10695: my ($currfile,$currsubfile,$embed_file) = @_;
10696: my ($size,$mtime,$showsize,$showmtime);
10697: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10698: if ($embed_file =~ m{/}) {
10699: my ($path,$fname) = split(/\//,$embed_file);
10700: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10701: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10702: }
10703: } else {
10704: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10705: ($size,$mtime) = @{$currfile->{$embed_file}};
10706: }
10707: }
10708: $showsize = $size/1024.0;
10709: $showsize = sprintf("%.1f",$showsize);
10710: if ($mtime > 0) {
10711: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10712: }
10713: }
10714: return ($showsize,$showmtime);
10715: }
10716:
10717: sub ask_embedded_js {
10718: return <<"END";
10719: <script type="text/javascript"">
10720: // <![CDATA[
10721: function toggleBrowse(counter) {
10722: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10723: var fileid = document.getElementById('embedded_item_'+counter);
10724: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10725: if (chkboxid.checked == true) {
10726: uploaddivid.style.display='block';
10727: } else {
10728: uploaddivid.style.display='none';
10729: fileid.value = '';
10730: }
10731: }
10732: // ]]>
10733: </script>
10734:
10735: END
10736: }
10737:
1.661 raeburn 10738: sub upload_embedded {
10739: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10740: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10741: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10742: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10743: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10744: my $orig_uploaded_filename =
10745: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10746: foreach my $type ('orig','ref','attrib','codebase') {
10747: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10748: $env{'form.embedded_'.$type.'_'.$i} =
10749: &unescape($env{'form.embedded_'.$type.'_'.$i});
10750: }
10751: }
1.661 raeburn 10752: my ($path,$fname) =
10753: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10754: # no path, whole string is fname
10755: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10756: $fname = &Apache::lonnet::clean_filename($fname);
10757: # See if there is anything left
10758: next if ($fname eq '');
10759:
10760: # Check if file already exists as a file or directory.
10761: my ($state,$msg);
10762: if ($context eq 'portfolio') {
10763: my $port_path = $dirpath;
10764: if ($group ne '') {
10765: $port_path = "groups/$group/$port_path";
10766: }
1.987 raeburn 10767: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10768: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10769: $dir_root,$port_path,$disk_quota,
10770: $current_disk_usage,$uname,$udom);
10771: if ($state eq 'will_exceed_quota'
1.984 raeburn 10772: || $state eq 'file_locked') {
1.661 raeburn 10773: $output .= $msg;
10774: next;
10775: }
10776: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10777: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10778: if ($state eq 'exists') {
10779: $output .= $msg;
10780: next;
10781: }
10782: }
10783: # Check if extension is valid
10784: if (($fname =~ /\.(\w+)$/) &&
10785: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1075.2.53 raeburn 10786: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10787: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10788: next;
10789: } elsif (($fname =~ /\.(\w+)$/) &&
10790: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10791: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10792: next;
10793: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1075.2.34 raeburn 10794: $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 10795: next;
10796: }
10797: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1075.2.35 raeburn 10798: my $subdir = $path;
10799: $subdir =~ s{/+$}{};
1.661 raeburn 10800: if ($context eq 'portfolio') {
1.984 raeburn 10801: my $result;
10802: if ($state eq 'existingfile') {
10803: $result=
10804: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1075.2.35 raeburn 10805: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10806: } else {
1.984 raeburn 10807: $result=
10808: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10809: $dirpath.
1.1075.2.35 raeburn 10810: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10811: if ($result !~ m|^/uploaded/|) {
10812: $output .= '<span class="LC_error">'
10813: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10814: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10815: .'</span><br />';
10816: next;
10817: } else {
1.987 raeburn 10818: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10819: $path.$fname.'</span>').'<br />';
1.984 raeburn 10820: }
1.661 raeburn 10821: }
1.1075.2.35 raeburn 10822: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
10823: my $extendedsubdir = $dirpath.'/'.$subdir;
10824: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10825: my $result =
1.1075.2.35 raeburn 10826: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10827: if ($result !~ m|^/uploaded/|) {
10828: $output .= '<span class="LC_error">'
10829: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10830: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10831: .'</span><br />';
10832: next;
10833: } else {
10834: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10835: $path.$fname.'</span>').'<br />';
1.1075.2.35 raeburn 10836: if ($context eq 'syllabus') {
10837: &Apache::lonnet::make_public_indefinitely($result);
10838: }
1.987 raeburn 10839: }
1.661 raeburn 10840: } else {
10841: # Save the file
10842: my $target = $env{'form.embedded_item_'.$i};
10843: my $fullpath = $dir_root.$dirpath.'/'.$path;
10844: my $dest = $fullpath.$fname;
10845: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10846: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10847: my $count;
10848: my $filepath = $dir_root;
1.1027 raeburn 10849: foreach my $subdir (@parts) {
10850: $filepath .= "/$subdir";
10851: if (!-e $filepath) {
1.661 raeburn 10852: mkdir($filepath,0770);
10853: }
10854: }
10855: my $fh;
10856: if (!open($fh,'>'.$dest)) {
10857: &Apache::lonnet::logthis('Failed to create '.$dest);
10858: $output .= '<span class="LC_error">'.
1.1071 raeburn 10859: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10860: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10861: '</span><br />';
10862: } else {
10863: if (!print $fh $env{'form.embedded_item_'.$i}) {
10864: &Apache::lonnet::logthis('Failed to write to '.$dest);
10865: $output .= '<span class="LC_error">'.
1.1071 raeburn 10866: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10867: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10868: '</span><br />';
10869: } else {
1.987 raeburn 10870: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10871: $url.'</span>').'<br />';
10872: unless ($context eq 'testbank') {
10873: $footer .= &mt('View embedded file: [_1]',
10874: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10875: }
10876: }
10877: close($fh);
10878: }
10879: }
10880: if ($env{'form.embedded_ref_'.$i}) {
10881: $pathchange{$i} = 1;
10882: }
10883: }
10884: if ($output) {
10885: $output = '<p>'.$output.'</p>';
10886: }
10887: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10888: $returnflag = 'ok';
1.1071 raeburn 10889: my $numpathchgs = scalar(keys(%pathchange));
10890: if ($numpathchgs > 0) {
1.987 raeburn 10891: if ($context eq 'portfolio') {
10892: $output .= '<p>'.&mt('or').'</p>';
10893: } elsif ($context eq 'testbank') {
1.1071 raeburn 10894: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10895: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10896: $returnflag = 'modify_orightml';
10897: }
10898: }
1.1071 raeburn 10899: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10900: }
10901:
10902: sub modify_html_form {
10903: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10904: my $end = 0;
10905: my $modifyform;
10906: if ($context eq 'upload_embedded') {
10907: return unless (ref($pathchange) eq 'HASH');
10908: if ($env{'form.number_embedded_items'}) {
10909: $end += $env{'form.number_embedded_items'};
10910: }
10911: if ($env{'form.number_pathchange_items'}) {
10912: $end += $env{'form.number_pathchange_items'};
10913: }
10914: if ($end) {
10915: for (my $i=0; $i<$end; $i++) {
10916: if ($i < $env{'form.number_embedded_items'}) {
10917: next unless($pathchange->{$i});
10918: }
10919: $modifyform .=
10920: &start_data_table_row().
10921: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10922: 'checked="checked" /></td>'.
10923: '<td>'.$env{'form.embedded_ref_'.$i}.
10924: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10925: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10926: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10927: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10928: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10929: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10930: '<td>'.$env{'form.embedded_orig_'.$i}.
10931: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10932: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10933: &end_data_table_row();
1.1071 raeburn 10934: }
1.987 raeburn 10935: }
10936: } else {
10937: $modifyform = $pathchgtable;
10938: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10939: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10940: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10941: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10942: }
10943: }
10944: if ($modifyform) {
1.1071 raeburn 10945: if ($actionurl eq '/adm/dependencies') {
10946: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10947: }
1.987 raeburn 10948: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10949: '<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".
10950: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10951: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10952: '</ol></p>'."\n".'<p>'.
10953: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10954: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10955: &start_data_table()."\n".
10956: &start_data_table_header_row().
10957: '<th>'.&mt('Change?').'</th>'.
10958: '<th>'.&mt('Current reference').'</th>'.
10959: '<th>'.&mt('Required reference').'</th>'.
10960: &end_data_table_header_row()."\n".
10961: $modifyform.
10962: &end_data_table().'<br />'."\n".$hiddenstate.
10963: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10964: '</form>'."\n";
10965: }
10966: return;
10967: }
10968:
10969: sub modify_html_refs {
1.1075.2.35 raeburn 10970: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10971: my $container;
10972: if ($context eq 'portfolio') {
10973: $container = $env{'form.container'};
10974: } elsif ($context eq 'coursedoc') {
10975: $container = $env{'form.primaryurl'};
1.1071 raeburn 10976: } elsif ($context eq 'manage_dependencies') {
10977: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10978: $container = "/$container";
1.1075.2.35 raeburn 10979: } elsif ($context eq 'syllabus') {
10980: $container = $url;
1.987 raeburn 10981: } else {
1.1027 raeburn 10982: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10983: }
10984: my (%allfiles,%codebase,$output,$content);
10985: my @changes = &get_env_multiple('form.namechange');
1.1075.2.35 raeburn 10986: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10987: if (wantarray) {
10988: return ('',0,0);
10989: } else {
10990: return;
10991: }
10992: }
10993: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 10994: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10995: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10996: if (wantarray) {
10997: return ('',0,0);
10998: } else {
10999: return;
11000: }
11001: }
1.987 raeburn 11002: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 11003: if ($content eq '-1') {
11004: if (wantarray) {
11005: return ('',0,0);
11006: } else {
11007: return;
11008: }
11009: }
1.987 raeburn 11010: } else {
1.1071 raeburn 11011: unless ($container =~ /^\Q$dir_root\E/) {
11012: if (wantarray) {
11013: return ('',0,0);
11014: } else {
11015: return;
11016: }
11017: }
1.987 raeburn 11018: if (open(my $fh,"<$container")) {
11019: $content = join('', <$fh>);
11020: close($fh);
11021: } else {
1.1071 raeburn 11022: if (wantarray) {
11023: return ('',0,0);
11024: } else {
11025: return;
11026: }
1.987 raeburn 11027: }
11028: }
11029: my ($count,$codebasecount) = (0,0);
11030: my $mm = new File::MMagic;
11031: my $mime_type = $mm->checktype_contents($content);
11032: if ($mime_type eq 'text/html') {
11033: my $parse_result =
11034: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
11035: \%codebase,\$content);
11036: if ($parse_result eq 'ok') {
11037: foreach my $i (@changes) {
11038: my $orig = &unescape($env{'form.embedded_orig_'.$i});
11039: my $ref = &unescape($env{'form.embedded_ref_'.$i});
11040: if ($allfiles{$ref}) {
11041: my $newname = $orig;
11042: my ($attrib_regexp,$codebase);
1.1006 raeburn 11043: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 11044: if ($attrib_regexp =~ /:/) {
11045: $attrib_regexp =~ s/\:/|/g;
11046: }
11047: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11048: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11049: $count += $numchg;
1.1075.2.35 raeburn 11050: $allfiles{$newname} = $allfiles{$ref};
1.1075.2.48 raeburn 11051: delete($allfiles{$ref});
1.987 raeburn 11052: }
11053: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 11054: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 11055: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
11056: $codebasecount ++;
11057: }
11058: }
11059: }
1.1075.2.35 raeburn 11060: my $skiprewrites;
1.987 raeburn 11061: if ($count || $codebasecount) {
11062: my $saveresult;
1.1071 raeburn 11063: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1075.2.35 raeburn 11064: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 11065: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11066: if ($url eq $container) {
11067: my ($fname) = ($container =~ m{/([^/]+)$});
11068: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11069: $count,'<span class="LC_filename">'.
1.1071 raeburn 11070: $fname.'</span>').'</p>';
1.987 raeburn 11071: } else {
11072: $output = '<p class="LC_error">'.
11073: &mt('Error: update failed for: [_1].',
11074: '<span class="LC_filename">'.
11075: $container.'</span>').'</p>';
11076: }
1.1075.2.35 raeburn 11077: if ($context eq 'syllabus') {
11078: unless ($saveresult eq 'ok') {
11079: $skiprewrites = 1;
11080: }
11081: }
1.987 raeburn 11082: } else {
11083: if (open(my $fh,">$container")) {
11084: print $fh $content;
11085: close($fh);
11086: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
11087: $count,'<span class="LC_filename">'.
11088: $container.'</span>').'</p>';
1.661 raeburn 11089: } else {
1.987 raeburn 11090: $output = '<p class="LC_error">'.
11091: &mt('Error: could not update [_1].',
11092: '<span class="LC_filename">'.
11093: $container.'</span>').'</p>';
1.661 raeburn 11094: }
11095: }
11096: }
1.1075.2.35 raeburn 11097: if (($context eq 'syllabus') && (!$skiprewrites)) {
11098: my ($actionurl,$state);
11099: $actionurl = "/public/$udom/$uname/syllabus";
11100: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
11101: &ask_for_embedded_content($actionurl,$state,\%allfiles,
11102: \%codebase,
11103: {'context' => 'rewrites',
11104: 'ignore_remote_references' => 1,});
11105: if (ref($mapping) eq 'HASH') {
11106: my $rewrites = 0;
11107: foreach my $key (keys(%{$mapping})) {
11108: next if ($key =~ m{^https?://});
11109: my $ref = $mapping->{$key};
11110: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
11111: my $attrib;
11112: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
11113: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
11114: }
11115: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
11116: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
11117: $rewrites += $numchg;
11118: }
11119: }
11120: if ($rewrites) {
11121: my $saveresult;
11122: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
11123: if ($url eq $container) {
11124: my ($fname) = ($container =~ m{/([^/]+)$});
11125: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
11126: $count,'<span class="LC_filename">'.
11127: $fname.'</span>').'</p>';
11128: } else {
11129: $output .= '<p class="LC_error">'.
11130: &mt('Error: could not update links in [_1].',
11131: '<span class="LC_filename">'.
11132: $container.'</span>').'</p>';
11133:
11134: }
11135: }
11136: }
11137: }
1.987 raeburn 11138: } else {
11139: &logthis('Failed to parse '.$container.
11140: ' to modify references: '.$parse_result);
1.661 raeburn 11141: }
11142: }
1.1071 raeburn 11143: if (wantarray) {
11144: return ($output,$count,$codebasecount);
11145: } else {
11146: return $output;
11147: }
1.661 raeburn 11148: }
11149:
11150: sub check_for_existing {
11151: my ($path,$fname,$element) = @_;
11152: my ($state,$msg);
11153: if (-d $path.'/'.$fname) {
11154: $state = 'exists';
11155: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11156: } elsif (-e $path.'/'.$fname) {
11157: $state = 'exists';
11158: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
11159: }
11160: if ($state eq 'exists') {
11161: $msg = '<span class="LC_error">'.$msg.'</span><br />';
11162: }
11163: return ($state,$msg);
11164: }
11165:
11166: sub check_for_upload {
11167: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
11168: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 11169: my $filesize = length($env{'form.'.$element});
11170: if (!$filesize) {
11171: my $msg = '<span class="LC_error">'.
11172: &mt('Unable to upload [_1]. (size = [_2] bytes)',
11173: '<span class="LC_filename">'.$fname.'</span>',
11174: $filesize).'<br />'.
1.1007 raeburn 11175: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 11176: '</span>';
11177: return ('zero_bytes',$msg);
11178: }
11179: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 11180: my $getpropath = 1;
1.1021 raeburn 11181: my ($dirlistref,$listerror) =
11182: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 11183: my $found_file = 0;
11184: my $locked_file = 0;
1.991 raeburn 11185: my @lockers;
11186: my $navmap;
11187: if ($env{'request.course.id'}) {
11188: $navmap = Apache::lonnavmaps::navmap->new();
11189: }
1.1021 raeburn 11190: if (ref($dirlistref) eq 'ARRAY') {
11191: foreach my $line (@{$dirlistref}) {
11192: my ($file_name,$rest)=split(/\&/,$line,2);
11193: if ($file_name eq $fname){
11194: $file_name = $path.$file_name;
11195: if ($group ne '') {
11196: $file_name = $group.$file_name;
11197: }
11198: $found_file = 1;
11199: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
11200: foreach my $lock (@lockers) {
11201: if (ref($lock) eq 'ARRAY') {
11202: my ($symb,$crsid) = @{$lock};
11203: if ($crsid eq $env{'request.course.id'}) {
11204: if (ref($navmap)) {
11205: my $res = $navmap->getBySymb($symb);
11206: foreach my $part (@{$res->parts()}) {
11207: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
11208: unless (($slot_status == $res->RESERVED) ||
11209: ($slot_status == $res->RESERVED_LOCATION)) {
11210: $locked_file = 1;
11211: }
1.991 raeburn 11212: }
1.1021 raeburn 11213: } else {
11214: $locked_file = 1;
1.991 raeburn 11215: }
11216: } else {
11217: $locked_file = 1;
11218: }
11219: }
1.1021 raeburn 11220: }
11221: } else {
11222: my @info = split(/\&/,$rest);
11223: my $currsize = $info[6]/1000;
11224: if ($currsize < $filesize) {
11225: my $extra = $filesize - $currsize;
11226: if (($current_disk_usage + $extra) > $disk_quota) {
1.1075.2.69 raeburn 11227: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11228: &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 11229: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11230: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11231: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11232: return ('will_exceed_quota',$msg);
11233: }
1.984 raeburn 11234: }
11235: }
1.661 raeburn 11236: }
11237: }
11238: }
11239: if (($current_disk_usage + $filesize) > $disk_quota){
1.1075.2.69 raeburn 11240: my $msg = '<p class="LC_warning">'.
11241: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
11242: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11243: return ('will_exceed_quota',$msg);
11244: } elsif ($found_file) {
11245: if ($locked_file) {
1.1075.2.69 raeburn 11246: my $msg = '<p class="LC_warning">';
1.661 raeburn 11247: $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 11248: $msg .= '</p>';
1.661 raeburn 11249: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11250: return ('file_locked',$msg);
11251: } else {
1.1075.2.69 raeburn 11252: my $msg = '<p class="LC_error">';
1.984 raeburn 11253: $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 11254: $msg .= '</p>';
1.984 raeburn 11255: return ('existingfile',$msg);
1.661 raeburn 11256: }
11257: }
11258: }
11259:
1.987 raeburn 11260: sub check_for_traversal {
11261: my ($path,$url,$toplevel) = @_;
11262: my @parts=split(/\//,$path);
11263: my $cleanpath;
11264: my $fullpath = $url;
11265: for (my $i=0;$i<@parts;$i++) {
11266: next if ($parts[$i] eq '.');
11267: if ($parts[$i] eq '..') {
11268: $fullpath =~ s{([^/]+/)$}{};
11269: } else {
11270: $fullpath .= $parts[$i].'/';
11271: }
11272: }
11273: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11274: $cleanpath = $1;
11275: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11276: my $curr_toprel = $1;
11277: my @parts = split(/\//,$curr_toprel);
11278: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11279: my @urlparts = split(/\//,$url_toprel);
11280: my $doubledots;
11281: my $startdiff = -1;
11282: for (my $i=0; $i<@urlparts; $i++) {
11283: if ($startdiff == -1) {
11284: unless ($urlparts[$i] eq $parts[$i]) {
11285: $startdiff = $i;
11286: $doubledots .= '../';
11287: }
11288: } else {
11289: $doubledots .= '../';
11290: }
11291: }
11292: if ($startdiff > -1) {
11293: $cleanpath = $doubledots;
11294: for (my $i=$startdiff; $i<@parts; $i++) {
11295: $cleanpath .= $parts[$i].'/';
11296: }
11297: }
11298: }
11299: $cleanpath =~ s{(/)$}{};
11300: return $cleanpath;
11301: }
1.31 albertel 11302:
1.1053 raeburn 11303: sub is_archive_file {
11304: my ($mimetype) = @_;
11305: if (($mimetype eq 'application/octet-stream') ||
11306: ($mimetype eq 'application/x-stuffit') ||
11307: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11308: return 1;
11309: }
11310: return;
11311: }
11312:
11313: sub decompress_form {
1.1065 raeburn 11314: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11315: my %lt = &Apache::lonlocal::texthash (
11316: this => 'This file is an archive file.',
1.1067 raeburn 11317: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11318: itsc => 'Its contents are as follows:',
1.1053 raeburn 11319: youm => 'You may wish to extract its contents.',
11320: extr => 'Extract contents',
1.1067 raeburn 11321: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11322: proa => 'Process automatically?',
1.1053 raeburn 11323: yes => 'Yes',
11324: no => 'No',
1.1067 raeburn 11325: fold => 'Title for folder containing movie',
11326: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11327: );
1.1065 raeburn 11328: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11329: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11330: my $info = &list_archive_contents($fileloc,\@paths);
11331: if (@paths) {
11332: foreach my $path (@paths) {
11333: $path =~ s{^/}{};
1.1067 raeburn 11334: if ($path =~ m{^([^/]+)/$}) {
11335: $topdir = $1;
11336: }
1.1065 raeburn 11337: if ($path =~ m{^([^/]+)/}) {
11338: $toplevel{$1} = $path;
11339: } else {
11340: $toplevel{$path} = $path;
11341: }
11342: }
11343: }
1.1067 raeburn 11344: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1075.2.59 raeburn 11345: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11346: "$topdir/media/",
11347: "$topdir/media/$topdir.mp4",
11348: "$topdir/media/FirstFrame.png",
11349: "$topdir/media/player.swf",
11350: "$topdir/media/swfobject.js",
11351: "$topdir/media/expressInstall.swf");
1.1075.2.81 raeburn 11352: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1075.2.59 raeburn 11353: "$topdir/$topdir.mp4",
11354: "$topdir/$topdir\_config.xml",
11355: "$topdir/$topdir\_controller.swf",
11356: "$topdir/$topdir\_embed.css",
11357: "$topdir/$topdir\_First_Frame.png",
11358: "$topdir/$topdir\_player.html",
11359: "$topdir/$topdir\_Thumbnails.png",
11360: "$topdir/playerProductInstall.swf",
11361: "$topdir/scripts/",
11362: "$topdir/scripts/config_xml.js",
11363: "$topdir/scripts/handlebars.js",
11364: "$topdir/scripts/jquery-1.7.1.min.js",
11365: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11366: "$topdir/scripts/modernizr.js",
11367: "$topdir/scripts/player-min.js",
11368: "$topdir/scripts/swfobject.js",
11369: "$topdir/skins/",
11370: "$topdir/skins/configuration_express.xml",
11371: "$topdir/skins/express_show/",
11372: "$topdir/skins/express_show/player-min.css",
11373: "$topdir/skins/express_show/spritesheet.png");
1.1075.2.81 raeburn 11374: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11375: "$topdir/$topdir.mp4",
11376: "$topdir/$topdir\_config.xml",
11377: "$topdir/$topdir\_controller.swf",
11378: "$topdir/$topdir\_embed.css",
11379: "$topdir/$topdir\_First_Frame.png",
11380: "$topdir/$topdir\_player.html",
11381: "$topdir/$topdir\_Thumbnails.png",
11382: "$topdir/playerProductInstall.swf",
11383: "$topdir/scripts/",
11384: "$topdir/scripts/config_xml.js",
11385: "$topdir/scripts/techsmith-smart-player.min.js",
11386: "$topdir/skins/",
11387: "$topdir/skins/configuration_express.xml",
11388: "$topdir/skins/express_show/",
11389: "$topdir/skins/express_show/spritesheet.min.css",
11390: "$topdir/skins/express_show/spritesheet.png",
11391: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1075.2.59 raeburn 11392: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11393: if (@diffs == 0) {
1.1075.2.59 raeburn 11394: $is_camtasia = 6;
11395: } else {
1.1075.2.81 raeburn 11396: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1075.2.59 raeburn 11397: if (@diffs == 0) {
11398: $is_camtasia = 8;
1.1075.2.81 raeburn 11399: } else {
11400: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11401: if (@diffs == 0) {
11402: $is_camtasia = 8;
11403: }
1.1075.2.59 raeburn 11404: }
1.1067 raeburn 11405: }
11406: }
11407: my $output;
11408: if ($is_camtasia) {
11409: $output = <<"ENDCAM";
11410: <script type="text/javascript" language="Javascript">
11411: // <![CDATA[
11412:
11413: function camtasiaToggle() {
11414: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11415: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1075.2.59 raeburn 11416: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11417: document.getElementById('camtasia_titles').style.display='block';
11418: } else {
11419: document.getElementById('camtasia_titles').style.display='none';
11420: }
11421: }
11422: }
11423: return;
11424: }
11425:
11426: // ]]>
11427: </script>
11428: <p>$lt{'camt'}</p>
11429: ENDCAM
1.1065 raeburn 11430: } else {
1.1067 raeburn 11431: $output = '<p>'.$lt{'this'};
11432: if ($info eq '') {
11433: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11434: } else {
11435: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11436: '<div><pre>'.$info.'</pre></div>';
11437: }
1.1065 raeburn 11438: }
1.1067 raeburn 11439: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11440: my $duplicates;
11441: my $num = 0;
11442: if (ref($dirlist) eq 'ARRAY') {
11443: foreach my $item (@{$dirlist}) {
11444: if (ref($item) eq 'ARRAY') {
11445: if (exists($toplevel{$item->[0]})) {
11446: $duplicates .=
11447: &start_data_table_row().
11448: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11449: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11450: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11451: 'value="1" />'.&mt('Yes').'</label>'.
11452: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11453: '<td>'.$item->[0].'</td>';
11454: if ($item->[2]) {
11455: $duplicates .= '<td>'.&mt('Directory').'</td>';
11456: } else {
11457: $duplicates .= '<td>'.&mt('File').'</td>';
11458: }
11459: $duplicates .= '<td>'.$item->[3].'</td>'.
11460: '<td>'.
11461: &Apache::lonlocal::locallocaltime($item->[4]).
11462: '</td>'.
11463: &end_data_table_row();
11464: $num ++;
11465: }
11466: }
11467: }
11468: }
11469: my $itemcount;
11470: if (@paths > 0) {
11471: $itemcount = scalar(@paths);
11472: } else {
11473: $itemcount = 1;
11474: }
1.1067 raeburn 11475: if ($is_camtasia) {
11476: $output .= $lt{'auto'}.'<br />'.
11477: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1075.2.59 raeburn 11478: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11479: $lt{'yes'}.'</label> <label>'.
11480: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11481: $lt{'no'}.'</label></span><br />'.
11482: '<div id="camtasia_titles" style="display:block">'.
11483: &Apache::lonhtmlcommon::start_pick_box().
11484: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11485: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11486: &Apache::lonhtmlcommon::row_closure().
11487: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11488: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11489: &Apache::lonhtmlcommon::row_closure(1).
11490: &Apache::lonhtmlcommon::end_pick_box().
11491: '</div>';
11492: }
1.1065 raeburn 11493: $output .=
11494: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11495: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11496: "\n";
1.1065 raeburn 11497: if ($duplicates ne '') {
11498: $output .= '<p><span class="LC_warning">'.
11499: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11500: &start_data_table().
11501: &start_data_table_header_row().
11502: '<th>'.&mt('Overwrite?').'</th>'.
11503: '<th>'.&mt('Name').'</th>'.
11504: '<th>'.&mt('Type').'</th>'.
11505: '<th>'.&mt('Size').'</th>'.
11506: '<th>'.&mt('Last modified').'</th>'.
11507: &end_data_table_header_row().
11508: $duplicates.
11509: &end_data_table().
11510: '</p>';
11511: }
1.1067 raeburn 11512: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11513: if (ref($hiddenelements) eq 'HASH') {
11514: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11515: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11516: }
11517: }
11518: $output .= <<"END";
1.1067 raeburn 11519: <br />
1.1053 raeburn 11520: <input type="submit" name="decompress" value="$lt{'extr'}" />
11521: </form>
11522: $noextract
11523: END
11524: return $output;
11525: }
11526:
1.1065 raeburn 11527: sub decompression_utility {
11528: my ($program) = @_;
11529: my @utilities = ('tar','gunzip','bunzip2','unzip');
11530: my $location;
11531: if (grep(/^\Q$program\E$/,@utilities)) {
11532: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11533: '/usr/sbin/') {
11534: if (-x $dir.$program) {
11535: $location = $dir.$program;
11536: last;
11537: }
11538: }
11539: }
11540: return $location;
11541: }
11542:
11543: sub list_archive_contents {
11544: my ($file,$pathsref) = @_;
11545: my (@cmd,$output);
11546: my $needsregexp;
11547: if ($file =~ /\.zip$/) {
11548: @cmd = (&decompression_utility('unzip'),"-l");
11549: $needsregexp = 1;
11550: } elsif (($file =~ m/\.tar\.gz$/) ||
11551: ($file =~ /\.tgz$/)) {
11552: @cmd = (&decompression_utility('tar'),"-ztf");
11553: } elsif ($file =~ /\.tar\.bz2$/) {
11554: @cmd = (&decompression_utility('tar'),"-jtf");
11555: } elsif ($file =~ m|\.tar$|) {
11556: @cmd = (&decompression_utility('tar'),"-tf");
11557: }
11558: if (@cmd) {
11559: undef($!);
11560: undef($@);
11561: if (open(my $fh,"-|", @cmd, $file)) {
11562: while (my $line = <$fh>) {
11563: $output .= $line;
11564: chomp($line);
11565: my $item;
11566: if ($needsregexp) {
11567: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11568: } else {
11569: $item = $line;
11570: }
11571: if ($item ne '') {
11572: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11573: push(@{$pathsref},$item);
11574: }
11575: }
11576: }
11577: close($fh);
11578: }
11579: }
11580: return $output;
11581: }
11582:
1.1053 raeburn 11583: sub decompress_uploaded_file {
11584: my ($file,$dir) = @_;
11585: &Apache::lonnet::appenv({'cgi.file' => $file});
11586: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11587: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11588: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11589: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11590: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11591: my $decompressed = $env{'cgi.decompressed'};
11592: &Apache::lonnet::delenv('cgi.file');
11593: &Apache::lonnet::delenv('cgi.dir');
11594: &Apache::lonnet::delenv('cgi.decompressed');
11595: return ($decompressed,$result);
11596: }
11597:
1.1055 raeburn 11598: sub process_decompression {
11599: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11600: my ($dir,$error,$warning,$output);
1.1075.2.69 raeburn 11601: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1075.2.34 raeburn 11602: $error = &mt('Filename not a supported archive file type.').
11603: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11604: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11605: } else {
11606: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11607: if ($docuhome eq 'no_host') {
11608: $error = &mt('Could not determine home server for course.');
11609: } else {
11610: my @ids=&Apache::lonnet::current_machine_ids();
11611: my $currdir = "$dir_root/$destination";
11612: if (grep(/^\Q$docuhome\E$/,@ids)) {
11613: $dir = &LONCAPA::propath($docudom,$docuname).
11614: "$dir_root/$destination";
11615: } else {
11616: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11617: "$dir_root/$docudom/$docuname/$destination";
11618: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11619: $error = &mt('Archive file not found.');
11620: }
11621: }
1.1065 raeburn 11622: my (@to_overwrite,@to_skip);
11623: if ($env{'form.archive_overwrite_total'} > 0) {
11624: my $total = $env{'form.archive_overwrite_total'};
11625: for (my $i=0; $i<$total; $i++) {
11626: if ($env{'form.archive_overwrite_'.$i} == 1) {
11627: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11628: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11629: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11630: }
11631: }
11632: }
11633: my $numskip = scalar(@to_skip);
11634: if (($numskip > 0) &&
11635: ($numskip == $env{'form.archive_itemcount'})) {
11636: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11637: } elsif ($dir eq '') {
1.1055 raeburn 11638: $error = &mt('Directory containing archive file unavailable.');
11639: } elsif (!$error) {
1.1065 raeburn 11640: my ($decompressed,$display);
11641: if ($numskip > 0) {
11642: my $tempdir = time.'_'.$$.int(rand(10000));
11643: mkdir("$dir/$tempdir",0755);
11644: system("mv $dir/$file $dir/$tempdir/$file");
11645: ($decompressed,$display) =
11646: &decompress_uploaded_file($file,"$dir/$tempdir");
11647: foreach my $item (@to_skip) {
11648: if (($item ne '') && ($item !~ /\.\./)) {
11649: if (-f "$dir/$tempdir/$item") {
11650: unlink("$dir/$tempdir/$item");
11651: } elsif (-d "$dir/$tempdir/$item") {
11652: system("rm -rf $dir/$tempdir/$item");
11653: }
11654: }
11655: }
11656: system("mv $dir/$tempdir/* $dir");
11657: rmdir("$dir/$tempdir");
11658: } else {
11659: ($decompressed,$display) =
11660: &decompress_uploaded_file($file,$dir);
11661: }
1.1055 raeburn 11662: if ($decompressed eq 'ok') {
1.1065 raeburn 11663: $output = '<p class="LC_info">'.
11664: &mt('Files extracted successfully from archive.').
11665: '</p>'."\n";
1.1055 raeburn 11666: my ($warning,$result,@contents);
11667: my ($newdirlistref,$newlisterror) =
11668: &Apache::lonnet::dirlist($currdir,$docudom,
11669: $docuname,1);
11670: my (%is_dir,%changes,@newitems);
11671: my $dirptr = 16384;
1.1065 raeburn 11672: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11673: foreach my $dir_line (@{$newdirlistref}) {
11674: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11675: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11676: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11677: push(@newitems,$item);
11678: if ($dirptr&$testdir) {
11679: $is_dir{$item} = 1;
11680: }
11681: $changes{$item} = 1;
11682: }
11683: }
11684: }
11685: if (keys(%changes) > 0) {
11686: foreach my $item (sort(@newitems)) {
11687: if ($changes{$item}) {
11688: push(@contents,$item);
11689: }
11690: }
11691: }
11692: if (@contents > 0) {
1.1067 raeburn 11693: my $wantform;
11694: unless ($env{'form.autoextract_camtasia'}) {
11695: $wantform = 1;
11696: }
1.1056 raeburn 11697: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11698: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11699: $currdir,\%is_dir,
11700: \%children,\%parent,
1.1056 raeburn 11701: \@contents,\%dirorder,
11702: \%titles,$wantform);
1.1055 raeburn 11703: if ($datatable ne '') {
11704: $output .= &archive_options_form('decompressed',$datatable,
11705: $count,$hiddenelem);
1.1065 raeburn 11706: my $startcount = 6;
1.1055 raeburn 11707: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11708: \%titles,\%children);
1.1055 raeburn 11709: }
1.1067 raeburn 11710: if ($env{'form.autoextract_camtasia'}) {
1.1075.2.59 raeburn 11711: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11712: my %displayed;
11713: my $total = 1;
11714: $env{'form.archive_directory'} = [];
11715: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11716: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11717: $path =~ s{/$}{};
11718: my $item;
11719: if ($path ne '') {
11720: $item = "$path/$titles{$i}";
11721: } else {
11722: $item = $titles{$i};
11723: }
11724: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11725: if ($item eq $contents[0]) {
11726: push(@{$env{'form.archive_directory'}},$i);
11727: $env{'form.archive_'.$i} = 'display';
11728: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11729: $displayed{'folder'} = $i;
1.1075.2.59 raeburn 11730: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11731: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11732: $env{'form.archive_'.$i} = 'display';
11733: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11734: $displayed{'web'} = $i;
11735: } else {
1.1075.2.59 raeburn 11736: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11737: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11738: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11739: push(@{$env{'form.archive_directory'}},$i);
11740: }
11741: $env{'form.archive_'.$i} = 'dependency';
11742: }
11743: $total ++;
11744: }
11745: for (my $i=1; $i<$total; $i++) {
11746: next if ($i == $displayed{'web'});
11747: next if ($i == $displayed{'folder'});
11748: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11749: }
11750: $env{'form.phase'} = 'decompress_cleanup';
11751: $env{'form.archivedelete'} = 1;
11752: $env{'form.archive_count'} = $total-1;
11753: $output .=
11754: &process_extracted_files('coursedocs',$docudom,
11755: $docuname,$destination,
11756: $dir_root,$hiddenelem);
11757: }
1.1055 raeburn 11758: } else {
11759: $warning = &mt('No new items extracted from archive file.');
11760: }
11761: } else {
11762: $output = $display;
11763: $error = &mt('An error occurred during extraction from the archive file.');
11764: }
11765: }
11766: }
11767: }
11768: if ($error) {
11769: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11770: $error.'</p>'."\n";
11771: }
11772: if ($warning) {
11773: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11774: }
11775: return $output;
11776: }
11777:
11778: sub get_extracted {
1.1056 raeburn 11779: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11780: $titles,$wantform) = @_;
1.1055 raeburn 11781: my $count = 0;
11782: my $depth = 0;
11783: my $datatable;
1.1056 raeburn 11784: my @hierarchy;
1.1055 raeburn 11785: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11786: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11787: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11788: foreach my $item (@{$contents}) {
11789: $count ++;
1.1056 raeburn 11790: @{$dirorder->{$count}} = @hierarchy;
11791: $titles->{$count} = $item;
1.1055 raeburn 11792: &archive_hierarchy($depth,$count,$parent,$children);
11793: if ($wantform) {
11794: $datatable .= &archive_row($is_dir->{$item},$item,
11795: $currdir,$depth,$count);
11796: }
11797: if ($is_dir->{$item}) {
11798: $depth ++;
1.1056 raeburn 11799: push(@hierarchy,$count);
11800: $parent->{$depth} = $count;
1.1055 raeburn 11801: $datatable .=
11802: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11803: \$depth,\$count,\@hierarchy,$dirorder,
11804: $children,$parent,$titles,$wantform);
1.1055 raeburn 11805: $depth --;
1.1056 raeburn 11806: pop(@hierarchy);
1.1055 raeburn 11807: }
11808: }
11809: return ($count,$datatable);
11810: }
11811:
11812: sub recurse_extracted_archive {
1.1056 raeburn 11813: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11814: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11815: my $result='';
1.1056 raeburn 11816: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11817: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11818: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11819: return $result;
11820: }
11821: my $dirptr = 16384;
11822: my ($newdirlistref,$newlisterror) =
11823: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11824: if (ref($newdirlistref) eq 'ARRAY') {
11825: foreach my $dir_line (@{$newdirlistref}) {
11826: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11827: unless ($item =~ /^\.+$/) {
11828: $$count ++;
1.1056 raeburn 11829: @{$dirorder->{$$count}} = @{$hierarchy};
11830: $titles->{$$count} = $item;
1.1055 raeburn 11831: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11832:
1.1055 raeburn 11833: my $is_dir;
11834: if ($dirptr&$testdir) {
11835: $is_dir = 1;
11836: }
11837: if ($wantform) {
11838: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11839: }
11840: if ($is_dir) {
11841: $$depth ++;
1.1056 raeburn 11842: push(@{$hierarchy},$$count);
11843: $parent->{$$depth} = $$count;
1.1055 raeburn 11844: $result .=
11845: &recurse_extracted_archive("$currdir/$item",$docudom,
11846: $docuname,$depth,$count,
1.1056 raeburn 11847: $hierarchy,$dirorder,$children,
11848: $parent,$titles,$wantform);
1.1055 raeburn 11849: $$depth --;
1.1056 raeburn 11850: pop(@{$hierarchy});
1.1055 raeburn 11851: }
11852: }
11853: }
11854: }
11855: return $result;
11856: }
11857:
11858: sub archive_hierarchy {
11859: my ($depth,$count,$parent,$children) =@_;
11860: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11861: if (exists($parent->{$depth})) {
11862: $children->{$parent->{$depth}} .= $count.':';
11863: }
11864: }
11865: return;
11866: }
11867:
11868: sub archive_row {
11869: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11870: my ($name) = ($item =~ m{([^/]+)$});
11871: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11872: 'display' => 'Add as file',
1.1055 raeburn 11873: 'dependency' => 'Include as dependency',
11874: 'discard' => 'Discard',
11875: );
11876: if ($is_dir) {
1.1059 raeburn 11877: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11878: }
1.1056 raeburn 11879: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11880: my $offset = 0;
1.1055 raeburn 11881: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11882: $offset ++;
1.1065 raeburn 11883: if ($action ne 'display') {
11884: $offset ++;
11885: }
1.1055 raeburn 11886: $output .= '<td><span class="LC_nobreak">'.
11887: '<label><input type="radio" name="archive_'.$count.
11888: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11889: my $text = $choices{$action};
11890: if ($is_dir) {
11891: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11892: if ($action eq 'display') {
1.1059 raeburn 11893: $text = &mt('Add as folder');
1.1055 raeburn 11894: }
1.1056 raeburn 11895: } else {
11896: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11897:
11898: }
11899: $output .= ' /> '.$choices{$action}.'</label></span>';
11900: if ($action eq 'dependency') {
11901: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11902: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11903: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11904: '<option value=""></option>'."\n".
11905: '</select>'."\n".
11906: '</div>';
1.1059 raeburn 11907: } elsif ($action eq 'display') {
11908: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11909: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11910: '</div>';
1.1055 raeburn 11911: }
1.1056 raeburn 11912: $output .= '</td>';
1.1055 raeburn 11913: }
11914: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11915: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11916: for (my $i=0; $i<$depth; $i++) {
11917: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11918: }
11919: if ($is_dir) {
11920: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11921: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11922: } else {
11923: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11924: }
11925: $output .= ' '.$name.'</td>'."\n".
11926: &end_data_table_row();
11927: return $output;
11928: }
11929:
11930: sub archive_options_form {
1.1065 raeburn 11931: my ($form,$display,$count,$hiddenelem) = @_;
11932: my %lt = &Apache::lonlocal::texthash(
11933: perm => 'Permanently remove archive file?',
11934: hows => 'How should each extracted item be incorporated in the course?',
11935: cont => 'Content actions for all',
11936: addf => 'Add as folder/file',
11937: incd => 'Include as dependency for a displayed file',
11938: disc => 'Discard',
11939: no => 'No',
11940: yes => 'Yes',
11941: save => 'Save',
11942: );
11943: my $output = <<"END";
11944: <form name="$form" method="post" action="">
11945: <p><span class="LC_nobreak">$lt{'perm'}
11946: <label>
11947: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11948: </label>
11949:
11950: <label>
11951: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11952: </span>
11953: </p>
11954: <input type="hidden" name="phase" value="decompress_cleanup" />
11955: <br />$lt{'hows'}
11956: <div class="LC_columnSection">
11957: <fieldset>
11958: <legend>$lt{'cont'}</legend>
11959: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11960: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11961: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11962: </fieldset>
11963: </div>
11964: END
11965: return $output.
1.1055 raeburn 11966: &start_data_table()."\n".
1.1065 raeburn 11967: $display."\n".
1.1055 raeburn 11968: &end_data_table()."\n".
11969: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11970: $hiddenelem.
1.1065 raeburn 11971: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11972: '</form>';
11973: }
11974:
11975: sub archive_javascript {
1.1056 raeburn 11976: my ($startcount,$numitems,$titles,$children) = @_;
11977: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11978: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11979: my $scripttag = <<START;
11980: <script type="text/javascript">
11981: // <![CDATA[
11982:
11983: function checkAll(form,prefix) {
11984: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11985: for (var i=0; i < form.elements.length; i++) {
11986: var id = form.elements[i].id;
11987: if ((id != '') && (id != undefined)) {
11988: if (idstr.test(id)) {
11989: if (form.elements[i].type == 'radio') {
11990: form.elements[i].checked = true;
1.1056 raeburn 11991: var nostart = i-$startcount;
1.1059 raeburn 11992: var offset = nostart%7;
11993: var count = (nostart-offset)/7;
1.1056 raeburn 11994: dependencyCheck(form,count,offset);
1.1055 raeburn 11995: }
11996: }
11997: }
11998: }
11999: }
12000:
12001: function propagateCheck(form,count) {
12002: if (count > 0) {
1.1059 raeburn 12003: var startelement = $startcount + ((count-1) * 7);
12004: for (var j=1; j<6; j++) {
12005: if ((j != 2) && (j != 4)) {
1.1056 raeburn 12006: var item = startelement + j;
12007: if (form.elements[item].type == 'radio') {
12008: if (form.elements[item].checked) {
12009: containerCheck(form,count,j);
12010: break;
12011: }
1.1055 raeburn 12012: }
12013: }
12014: }
12015: }
12016: }
12017:
12018: numitems = $numitems
1.1056 raeburn 12019: var titles = new Array(numitems);
12020: var parents = new Array(numitems);
1.1055 raeburn 12021: for (var i=0; i<numitems; i++) {
1.1056 raeburn 12022: parents[i] = new Array;
1.1055 raeburn 12023: }
1.1059 raeburn 12024: var maintitle = '$maintitle';
1.1055 raeburn 12025:
12026: START
12027:
1.1056 raeburn 12028: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
12029: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 12030: for (my $i=0; $i<@contents; $i ++) {
12031: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
12032: }
12033: }
12034:
1.1056 raeburn 12035: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
12036: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
12037: }
12038:
1.1055 raeburn 12039: $scripttag .= <<END;
12040:
12041: function containerCheck(form,count,offset) {
12042: if (count > 0) {
1.1056 raeburn 12043: dependencyCheck(form,count,offset);
1.1059 raeburn 12044: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 12045: form.elements[item].checked = true;
12046: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
12047: if (parents[count].length > 0) {
12048: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 12049: containerCheck(form,parents[count][j],offset);
12050: }
12051: }
12052: }
12053: }
12054: }
12055:
12056: function dependencyCheck(form,count,offset) {
12057: if (count > 0) {
1.1059 raeburn 12058: var chosen = (offset+$startcount)+7*(count-1);
12059: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 12060: var currtype = form.elements[depitem].type;
12061: if (form.elements[chosen].value == 'dependency') {
12062: document.getElementById('arc_depon_'+count).style.display='block';
12063: form.elements[depitem].options.length = 0;
12064: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1075.2.11 raeburn 12065: for (var i=1; i<=numitems; i++) {
12066: if (i == count) {
12067: continue;
12068: }
1.1059 raeburn 12069: var startelement = $startcount + (i-1) * 7;
12070: for (var j=1; j<6; j++) {
12071: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 12072: var item = startelement + j;
12073: if (form.elements[item].type == 'radio') {
12074: if (form.elements[item].checked) {
12075: if (form.elements[item].value == 'display') {
12076: var n = form.elements[depitem].options.length;
12077: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
12078: }
12079: }
12080: }
12081: }
12082: }
12083: }
12084: } else {
12085: document.getElementById('arc_depon_'+count).style.display='none';
12086: form.elements[depitem].options.length = 0;
12087: form.elements[depitem].options[0] = new Option('Select','',true,true);
12088: }
1.1059 raeburn 12089: titleCheck(form,count,offset);
1.1056 raeburn 12090: }
12091: }
12092:
12093: function propagateSelect(form,count,offset) {
12094: if (count > 0) {
1.1065 raeburn 12095: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 12096: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
12097: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12098: if (parents[count].length > 0) {
12099: for (var j=0; j<parents[count].length; j++) {
12100: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 12101: }
12102: }
12103: }
12104: }
12105: }
1.1056 raeburn 12106:
12107: function containerSelect(form,count,offset,picked) {
12108: if (count > 0) {
1.1065 raeburn 12109: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 12110: if (form.elements[item].type == 'radio') {
12111: if (form.elements[item].value == 'dependency') {
12112: if (form.elements[item+1].type == 'select-one') {
12113: for (var i=0; i<form.elements[item+1].options.length; i++) {
12114: if (form.elements[item+1].options[i].value == picked) {
12115: form.elements[item+1].selectedIndex = i;
12116: break;
12117: }
12118: }
12119: }
12120: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
12121: if (parents[count].length > 0) {
12122: for (var j=0; j<parents[count].length; j++) {
12123: containerSelect(form,parents[count][j],offset,picked);
12124: }
12125: }
12126: }
12127: }
12128: }
12129: }
12130: }
12131:
1.1059 raeburn 12132: function titleCheck(form,count,offset) {
12133: if (count > 0) {
12134: var chosen = (offset+$startcount)+7*(count-1);
12135: var depitem = $startcount + ((count-1) * 7) + 2;
12136: var currtype = form.elements[depitem].type;
12137: if (form.elements[chosen].value == 'display') {
12138: document.getElementById('arc_title_'+count).style.display='block';
12139: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
12140: document.getElementById('archive_title_'+count).value=maintitle;
12141: }
12142: } else {
12143: document.getElementById('arc_title_'+count).style.display='none';
12144: if (currtype == 'text') {
12145: document.getElementById('archive_title_'+count).value='';
12146: }
12147: }
12148: }
12149: return;
12150: }
12151:
1.1055 raeburn 12152: // ]]>
12153: </script>
12154: END
12155: return $scripttag;
12156: }
12157:
12158: sub process_extracted_files {
1.1067 raeburn 12159: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 12160: my $numitems = $env{'form.archive_count'};
12161: return unless ($numitems);
12162: my @ids=&Apache::lonnet::current_machine_ids();
12163: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 12164: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 12165: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
12166: if (grep(/^\Q$docuhome\E$/,@ids)) {
12167: $prefix = &LONCAPA::propath($docudom,$docuname);
12168: $pathtocheck = "$dir_root/$destination";
12169: $dir = $dir_root;
12170: $ishome = 1;
12171: } else {
12172: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
12173: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
12174: $dir = "$dir_root/$docudom/$docuname";
12175: }
12176: my $currdir = "$dir_root/$destination";
12177: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
12178: if ($env{'form.folderpath'}) {
12179: my @items = split('&',$env{'form.folderpath'});
12180: $folders{'0'} = $items[-2];
1.1075.2.17 raeburn 12181: if ($env{'form.folderpath'} =~ /\:1$/) {
12182: $containers{'0'}='page';
12183: } else {
12184: $containers{'0'}='sequence';
12185: }
1.1055 raeburn 12186: }
12187: my @archdirs = &get_env_multiple('form.archive_directory');
12188: if ($numitems) {
12189: for (my $i=1; $i<=$numitems; $i++) {
12190: my $path = $env{'form.archive_content_'.$i};
12191: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
12192: my $item = $1;
12193: $toplevelitems{$item} = $i;
12194: if (grep(/^\Q$i\E$/,@archdirs)) {
12195: $is_dir{$item} = 1;
12196: }
12197: }
12198: }
12199: }
1.1067 raeburn 12200: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 12201: if (keys(%toplevelitems) > 0) {
12202: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 12203: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
12204: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 12205: }
1.1066 raeburn 12206: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 12207: if ($numitems) {
12208: for (my $i=1; $i<=$numitems; $i++) {
1.1075.2.11 raeburn 12209: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 12210: my $path = $env{'form.archive_content_'.$i};
12211: if ($path =~ /^\Q$pathtocheck\E/) {
12212: if ($env{'form.archive_'.$i} eq 'discard') {
12213: if ($prefix ne '' && $path ne '') {
12214: if (-e $prefix.$path) {
1.1066 raeburn 12215: if ((@archdirs > 0) &&
12216: (grep(/^\Q$i\E$/,@archdirs))) {
12217: $todeletedir{$prefix.$path} = 1;
12218: } else {
12219: $todelete{$prefix.$path} = 1;
12220: }
1.1055 raeburn 12221: }
12222: }
12223: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12224: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12225: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12226: $docstitle = $env{'form.archive_title_'.$i};
12227: if ($docstitle eq '') {
12228: $docstitle = $title;
12229: }
1.1055 raeburn 12230: $outer = 0;
1.1056 raeburn 12231: if (ref($dirorder{$i}) eq 'ARRAY') {
12232: if (@{$dirorder{$i}} > 0) {
12233: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12234: if ($env{'form.archive_'.$item} eq 'display') {
12235: $outer = $item;
12236: last;
12237: }
12238: }
12239: }
12240: }
12241: my ($errtext,$fatal) =
12242: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12243: '/'.$folders{$outer}.'.'.
12244: $containers{$outer});
12245: next if ($fatal);
12246: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12247: if ($context eq 'coursedocs') {
1.1056 raeburn 12248: $mapinner{$i} = time;
1.1055 raeburn 12249: $folders{$i} = 'default_'.$mapinner{$i};
12250: $containers{$i} = 'sequence';
12251: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12252: $folders{$i}.'.'.$containers{$i};
12253: my $newidx = &LONCAPA::map::getresidx();
12254: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12255: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12256: push(@LONCAPA::map::order,$newidx);
12257: my ($outtext,$errtext) =
12258: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12259: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12260: '.'.$containers{$outer},1,1);
1.1056 raeburn 12261: $newseqid{$i} = $newidx;
1.1067 raeburn 12262: unless ($errtext) {
12263: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12264: }
1.1055 raeburn 12265: }
12266: } else {
12267: if ($context eq 'coursedocs') {
12268: my $newidx=&LONCAPA::map::getresidx();
12269: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12270: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12271: $title;
12272: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12273: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12274: }
12275: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12276: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12277: }
12278: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12279: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12280: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12281: unless ($ishome) {
12282: my $fetch = "$newdest{$i}/$title";
12283: $fetch =~ s/^\Q$prefix$dir\E//;
12284: $prompttofetch{$fetch} = 1;
12285: }
1.1055 raeburn 12286: }
12287: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12288: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12289: push(@LONCAPA::map::order, $newidx);
12290: my ($outtext,$errtext)=
12291: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12292: $docuname.'/'.$folders{$outer}.
1.1075.2.11 raeburn 12293: '.'.$containers{$outer},1,1);
1.1067 raeburn 12294: unless ($errtext) {
12295: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12296: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12297: }
12298: }
1.1055 raeburn 12299: }
12300: }
1.1075.2.11 raeburn 12301: }
12302: } else {
12303: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12304: }
12305: }
12306: for (my $i=1; $i<=$numitems; $i++) {
12307: next unless ($env{'form.archive_'.$i} eq 'dependency');
12308: my $path = $env{'form.archive_content_'.$i};
12309: if ($path =~ /^\Q$pathtocheck\E/) {
12310: my ($title) = ($path =~ m{/([^/]+)$});
12311: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12312: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12313: if (ref($dirorder{$i}) eq 'ARRAY') {
12314: my ($itemidx,$fullpath,$relpath);
12315: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12316: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12317: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1075.2.11 raeburn 12318: if ($dirorder{$i}->[$j] eq $container) {
12319: $itemidx = $j;
1.1056 raeburn 12320: }
12321: }
1.1075.2.11 raeburn 12322: }
12323: if ($itemidx eq '') {
12324: $itemidx = 0;
12325: }
12326: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12327: if ($mapinner{$referrer{$i}}) {
12328: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12329: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12330: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12331: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12332: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12333: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12334: if (!-e $fullpath) {
12335: mkdir($fullpath,0755);
1.1056 raeburn 12336: }
12337: }
1.1075.2.11 raeburn 12338: } else {
12339: last;
1.1056 raeburn 12340: }
1.1075.2.11 raeburn 12341: }
12342: }
12343: } elsif ($newdest{$referrer{$i}}) {
12344: $fullpath = $newdest{$referrer{$i}};
12345: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12346: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12347: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12348: last;
12349: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12350: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12351: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12352: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12353: if (!-e $fullpath) {
12354: mkdir($fullpath,0755);
1.1056 raeburn 12355: }
12356: }
1.1075.2.11 raeburn 12357: } else {
12358: last;
1.1056 raeburn 12359: }
1.1075.2.11 raeburn 12360: }
12361: }
12362: if ($fullpath ne '') {
12363: if (-e "$prefix$path") {
12364: system("mv $prefix$path $fullpath/$title");
12365: }
12366: if (-e "$fullpath/$title") {
12367: my $showpath;
12368: if ($relpath ne '') {
12369: $showpath = "$relpath/$title";
12370: } else {
12371: $showpath = "/$title";
1.1056 raeburn 12372: }
1.1075.2.11 raeburn 12373: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12374: }
12375: unless ($ishome) {
12376: my $fetch = "$fullpath/$title";
12377: $fetch =~ s/^\Q$prefix$dir\E//;
12378: $prompttofetch{$fetch} = 1;
1.1055 raeburn 12379: }
12380: }
12381: }
1.1075.2.11 raeburn 12382: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12383: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12384: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12385: }
12386: } else {
1.1075.2.11 raeburn 12387: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
1.1055 raeburn 12388: }
12389: }
12390: if (keys(%todelete)) {
12391: foreach my $key (keys(%todelete)) {
12392: unlink($key);
1.1066 raeburn 12393: }
12394: }
12395: if (keys(%todeletedir)) {
12396: foreach my $key (keys(%todeletedir)) {
12397: rmdir($key);
12398: }
12399: }
12400: foreach my $dir (sort(keys(%is_dir))) {
12401: if (($pathtocheck ne '') && ($dir ne '')) {
12402: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12403: }
12404: }
1.1067 raeburn 12405: if ($result ne '') {
12406: $output .= '<ul>'."\n".
12407: $result."\n".
12408: '</ul>';
12409: }
12410: unless ($ishome) {
12411: my $replicationfail;
12412: foreach my $item (keys(%prompttofetch)) {
12413: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12414: unless ($fetchresult eq 'ok') {
12415: $replicationfail .= '<li>'.$item.'</li>'."\n";
12416: }
12417: }
12418: if ($replicationfail) {
12419: $output .= '<p class="LC_error">'.
12420: &mt('Course home server failed to retrieve:').'<ul>'.
12421: $replicationfail.
12422: '</ul></p>';
12423: }
12424: }
1.1055 raeburn 12425: } else {
12426: $warning = &mt('No items found in archive.');
12427: }
12428: if ($error) {
12429: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12430: $error.'</p>'."\n";
12431: }
12432: if ($warning) {
12433: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12434: }
12435: return $output;
12436: }
12437:
1.1066 raeburn 12438: sub cleanup_empty_dirs {
12439: my ($path) = @_;
12440: if (($path ne '') && (-d $path)) {
12441: if (opendir(my $dirh,$path)) {
12442: my @dircontents = grep(!/^\./,readdir($dirh));
12443: my $numitems = 0;
12444: foreach my $item (@dircontents) {
12445: if (-d "$path/$item") {
1.1075.2.28 raeburn 12446: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12447: if (-e "$path/$item") {
12448: $numitems ++;
12449: }
12450: } else {
12451: $numitems ++;
12452: }
12453: }
12454: if ($numitems == 0) {
12455: rmdir($path);
12456: }
12457: closedir($dirh);
12458: }
12459: }
12460: return;
12461: }
12462:
1.41 ng 12463: =pod
1.45 matthew 12464:
1.1075.2.56 raeburn 12465: =item * &get_folder_hierarchy()
1.1068 raeburn 12466:
12467: Provides hierarchy of names of folders/sub-folders containing the current
12468: item,
12469:
12470: Inputs: 3
12471: - $navmap - navmaps object
12472:
12473: - $map - url for map (either the trigger itself, or map containing
12474: the resource, which is the trigger).
12475:
12476: - $showitem - 1 => show title for map itself; 0 => do not show.
12477:
12478: Outputs: 1 @pathitems - array of folder/subfolder names.
12479:
12480: =cut
12481:
12482: sub get_folder_hierarchy {
12483: my ($navmap,$map,$showitem) = @_;
12484: my @pathitems;
12485: if (ref($navmap)) {
12486: my $mapres = $navmap->getResourceByUrl($map);
12487: if (ref($mapres)) {
12488: my $pcslist = $mapres->map_hierarchy();
12489: if ($pcslist ne '') {
12490: my @pcs = split(/,/,$pcslist);
12491: foreach my $pc (@pcs) {
12492: if ($pc == 1) {
1.1075.2.38 raeburn 12493: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12494: } else {
12495: my $res = $navmap->getByMapPc($pc);
12496: if (ref($res)) {
12497: my $title = $res->compTitle();
12498: $title =~ s/\W+/_/g;
12499: if ($title ne '') {
12500: push(@pathitems,$title);
12501: }
12502: }
12503: }
12504: }
12505: }
1.1071 raeburn 12506: if ($showitem) {
12507: if ($mapres->{ID} eq '0.0') {
1.1075.2.38 raeburn 12508: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12509: } else {
12510: my $maptitle = $mapres->compTitle();
12511: $maptitle =~ s/\W+/_/g;
12512: if ($maptitle ne '') {
12513: push(@pathitems,$maptitle);
12514: }
1.1068 raeburn 12515: }
12516: }
12517: }
12518: }
12519: return @pathitems;
12520: }
12521:
12522: =pod
12523:
1.1015 raeburn 12524: =item * &get_turnedin_filepath()
12525:
12526: Determines path in a user's portfolio file for storage of files uploaded
12527: to a specific essayresponse or dropbox item.
12528:
12529: Inputs: 3 required + 1 optional.
12530: $symb is symb for resource, $uname and $udom are for current user (required).
12531: $caller is optional (can be "submission", if routine is called when storing
12532: an upoaded file when "Submit Answer" button was pressed).
12533:
12534: Returns array containing $path and $multiresp.
12535: $path is path in portfolio. $multiresp is 1 if this resource contains more
12536: than one file upload item. Callers of routine should append partid as a
12537: subdirectory to $path in cases where $multiresp is 1.
12538:
12539: Called by: homework/essayresponse.pm and homework/structuretags.pm
12540:
12541: =cut
12542:
12543: sub get_turnedin_filepath {
12544: my ($symb,$uname,$udom,$caller) = @_;
12545: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12546: my $turnindir;
12547: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12548: $turnindir = $userhash{'turnindir'};
12549: my ($path,$multiresp);
12550: if ($turnindir eq '') {
12551: if ($caller eq 'submission') {
12552: $turnindir = &mt('turned in');
12553: $turnindir =~ s/\W+/_/g;
12554: my %newhash = (
12555: 'turnindir' => $turnindir,
12556: );
12557: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12558: }
12559: }
12560: if ($turnindir ne '') {
12561: $path = '/'.$turnindir.'/';
12562: my ($multipart,$turnin,@pathitems);
12563: my $navmap = Apache::lonnavmaps::navmap->new();
12564: if (defined($navmap)) {
12565: my $mapres = $navmap->getResourceByUrl($map);
12566: if (ref($mapres)) {
12567: my $pcslist = $mapres->map_hierarchy();
12568: if ($pcslist ne '') {
12569: foreach my $pc (split(/,/,$pcslist)) {
12570: my $res = $navmap->getByMapPc($pc);
12571: if (ref($res)) {
12572: my $title = $res->compTitle();
12573: $title =~ s/\W+/_/g;
12574: if ($title ne '') {
1.1075.2.48 raeburn 12575: if (($pc > 1) && (length($title) > 12)) {
12576: $title = substr($title,0,12);
12577: }
1.1015 raeburn 12578: push(@pathitems,$title);
12579: }
12580: }
12581: }
12582: }
12583: my $maptitle = $mapres->compTitle();
12584: $maptitle =~ s/\W+/_/g;
12585: if ($maptitle ne '') {
1.1075.2.48 raeburn 12586: if (length($maptitle) > 12) {
12587: $maptitle = substr($maptitle,0,12);
12588: }
1.1015 raeburn 12589: push(@pathitems,$maptitle);
12590: }
12591: unless ($env{'request.state'} eq 'construct') {
12592: my $res = $navmap->getBySymb($symb);
12593: if (ref($res)) {
12594: my $partlist = $res->parts();
12595: my $totaluploads = 0;
12596: if (ref($partlist) eq 'ARRAY') {
12597: foreach my $part (@{$partlist}) {
12598: my @types = $res->responseType($part);
12599: my @ids = $res->responseIds($part);
12600: for (my $i=0; $i < scalar(@ids); $i++) {
12601: if ($types[$i] eq 'essay') {
12602: my $partid = $part.'_'.$ids[$i];
12603: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12604: $totaluploads ++;
12605: }
12606: }
12607: }
12608: }
12609: if ($totaluploads > 1) {
12610: $multiresp = 1;
12611: }
12612: }
12613: }
12614: }
12615: } else {
12616: return;
12617: }
12618: } else {
12619: return;
12620: }
12621: my $restitle=&Apache::lonnet::gettitle($symb);
12622: $restitle =~ s/\W+/_/g;
12623: if ($restitle eq '') {
12624: $restitle = ($resurl =~ m{/[^/]+$});
12625: if ($restitle eq '') {
12626: $restitle = time;
12627: }
12628: }
1.1075.2.48 raeburn 12629: if (length($restitle) > 12) {
12630: $restitle = substr($restitle,0,12);
12631: }
1.1015 raeburn 12632: push(@pathitems,$restitle);
12633: $path .= join('/',@pathitems);
12634: }
12635: return ($path,$multiresp);
12636: }
12637:
12638: =pod
12639:
1.464 albertel 12640: =back
1.41 ng 12641:
1.112 bowersj2 12642: =head1 CSV Upload/Handling functions
1.38 albertel 12643:
1.41 ng 12644: =over 4
12645:
1.648 raeburn 12646: =item * &upfile_store($r)
1.41 ng 12647:
12648: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12649: needs $env{'form.upfile'}
1.41 ng 12650: returns $datatoken to be put into hidden field
12651:
12652: =cut
1.31 albertel 12653:
12654: sub upfile_store {
12655: my $r=shift;
1.258 albertel 12656: $env{'form.upfile'}=~s/\r/\n/gs;
12657: $env{'form.upfile'}=~s/\f/\n/gs;
12658: $env{'form.upfile'}=~s/\n+/\n/gs;
12659: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12660:
1.258 albertel 12661: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12662: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12663: {
1.158 raeburn 12664: my $datafile = $r->dir_config('lonDaemons').
12665: '/tmp/'.$datatoken.'.tmp';
12666: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12667: print $fh $env{'form.upfile'};
1.158 raeburn 12668: close($fh);
12669: }
1.31 albertel 12670: }
12671: return $datatoken;
12672: }
12673:
1.56 matthew 12674: =pod
12675:
1.648 raeburn 12676: =item * &load_tmp_file($r)
1.41 ng 12677:
12678: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12679: needs $env{'form.datatoken'},
12680: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12681:
12682: =cut
1.31 albertel 12683:
12684: sub load_tmp_file {
12685: my $r=shift;
12686: my @studentdata=();
12687: {
1.158 raeburn 12688: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12689: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12690: if ( open(my $fh,"<$studentfile") ) {
12691: @studentdata=<$fh>;
12692: close($fh);
12693: }
1.31 albertel 12694: }
1.258 albertel 12695: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12696: }
12697:
1.56 matthew 12698: =pod
12699:
1.648 raeburn 12700: =item * &upfile_record_sep()
1.41 ng 12701:
12702: Separate uploaded file into records
12703: returns array of records,
1.258 albertel 12704: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12705:
12706: =cut
1.31 albertel 12707:
12708: sub upfile_record_sep {
1.258 albertel 12709: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12710: } else {
1.248 albertel 12711: my @records;
1.258 albertel 12712: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12713: if ($line=~/^\s*$/) { next; }
12714: push(@records,$line);
12715: }
12716: return @records;
1.31 albertel 12717: }
12718: }
12719:
1.56 matthew 12720: =pod
12721:
1.648 raeburn 12722: =item * &record_sep($record)
1.41 ng 12723:
1.258 albertel 12724: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12725:
12726: =cut
12727:
1.263 www 12728: sub takeleft {
12729: my $index=shift;
12730: return substr('0000'.$index,-4,4);
12731: }
12732:
1.31 albertel 12733: sub record_sep {
12734: my $record=shift;
12735: my %components=();
1.258 albertel 12736: if ($env{'form.upfiletype'} eq 'xml') {
12737: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12738: my $i=0;
1.356 albertel 12739: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12740: $field=~s/^(\"|\')//;
12741: $field=~s/(\"|\')$//;
1.263 www 12742: $components{&takeleft($i)}=$field;
1.31 albertel 12743: $i++;
12744: }
1.258 albertel 12745: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12746: my $i=0;
1.356 albertel 12747: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12748: $field=~s/^(\"|\')//;
12749: $field=~s/(\"|\')$//;
1.263 www 12750: $components{&takeleft($i)}=$field;
1.31 albertel 12751: $i++;
12752: }
12753: } else {
1.561 www 12754: my $separator=',';
1.480 banghart 12755: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12756: $separator=';';
1.480 banghart 12757: }
1.31 albertel 12758: my $i=0;
1.561 www 12759: # the character we are looking for to indicate the end of a quote or a record
12760: my $looking_for=$separator;
12761: # do not add the characters to the fields
12762: my $ignore=0;
12763: # we just encountered a separator (or the beginning of the record)
12764: my $just_found_separator=1;
12765: # store the field we are working on here
12766: my $field='';
12767: # work our way through all characters in record
12768: foreach my $character ($record=~/(.)/g) {
12769: if ($character eq $looking_for) {
12770: if ($character ne $separator) {
12771: # Found the end of a quote, again looking for separator
12772: $looking_for=$separator;
12773: $ignore=1;
12774: } else {
12775: # Found a separator, store away what we got
12776: $components{&takeleft($i)}=$field;
12777: $i++;
12778: $just_found_separator=1;
12779: $ignore=0;
12780: $field='';
12781: }
12782: next;
12783: }
12784: # single or double quotation marks after a separator indicate beginning of a quote
12785: # we are now looking for the end of the quote and need to ignore separators
12786: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12787: $looking_for=$character;
12788: next;
12789: }
12790: # ignore would be true after we reached the end of a quote
12791: if ($ignore) { next; }
12792: if (($just_found_separator) && ($character=~/\s/)) { next; }
12793: $field.=$character;
12794: $just_found_separator=0;
1.31 albertel 12795: }
1.561 www 12796: # catch the very last entry, since we never encountered the separator
12797: $components{&takeleft($i)}=$field;
1.31 albertel 12798: }
12799: return %components;
12800: }
12801:
1.144 matthew 12802: ######################################################
12803: ######################################################
12804:
1.56 matthew 12805: =pod
12806:
1.648 raeburn 12807: =item * &upfile_select_html()
1.41 ng 12808:
1.144 matthew 12809: Return HTML code to select a file from the users machine and specify
12810: the file type.
1.41 ng 12811:
12812: =cut
12813:
1.144 matthew 12814: ######################################################
12815: ######################################################
1.31 albertel 12816: sub upfile_select_html {
1.144 matthew 12817: my %Types = (
12818: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12819: semisv => &mt('Semicolon separated values'),
1.144 matthew 12820: space => &mt('Space separated'),
12821: tab => &mt('Tabulator separated'),
12822: # xml => &mt('HTML/XML'),
12823: );
12824: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12825: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12826: foreach my $type (sort(keys(%Types))) {
12827: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12828: }
12829: $Str .= "</select>\n";
12830: return $Str;
1.31 albertel 12831: }
12832:
1.301 albertel 12833: sub get_samples {
12834: my ($records,$toget) = @_;
12835: my @samples=({});
12836: my $got=0;
12837: foreach my $rec (@$records) {
12838: my %temp = &record_sep($rec);
12839: if (! grep(/\S/, values(%temp))) { next; }
12840: if (%temp) {
12841: $samples[$got]=\%temp;
12842: $got++;
12843: if ($got == $toget) { last; }
12844: }
12845: }
12846: return \@samples;
12847: }
12848:
1.144 matthew 12849: ######################################################
12850: ######################################################
12851:
1.56 matthew 12852: =pod
12853:
1.648 raeburn 12854: =item * &csv_print_samples($r,$records)
1.41 ng 12855:
12856: Prints a table of sample values from each column uploaded $r is an
12857: Apache Request ref, $records is an arrayref from
12858: &Apache::loncommon::upfile_record_sep
12859:
12860: =cut
12861:
1.144 matthew 12862: ######################################################
12863: ######################################################
1.31 albertel 12864: sub csv_print_samples {
12865: my ($r,$records) = @_;
1.662 bisitz 12866: my $samples = &get_samples($records,5);
1.301 albertel 12867:
1.594 raeburn 12868: $r->print(&mt('Samples').'<br />'.&start_data_table().
12869: &start_data_table_header_row());
1.356 albertel 12870: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12871: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12872: $r->print(&end_data_table_header_row());
1.301 albertel 12873: foreach my $hash (@$samples) {
1.594 raeburn 12874: $r->print(&start_data_table_row());
1.356 albertel 12875: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12876: $r->print('<td>');
1.356 albertel 12877: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12878: $r->print('</td>');
12879: }
1.594 raeburn 12880: $r->print(&end_data_table_row());
1.31 albertel 12881: }
1.594 raeburn 12882: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12883: }
12884:
1.144 matthew 12885: ######################################################
12886: ######################################################
12887:
1.56 matthew 12888: =pod
12889:
1.648 raeburn 12890: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12891:
12892: Prints a table to create associations between values and table columns.
1.144 matthew 12893:
1.41 ng 12894: $r is an Apache Request ref,
12895: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12896: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12897:
12898: =cut
12899:
1.144 matthew 12900: ######################################################
12901: ######################################################
1.31 albertel 12902: sub csv_print_select_table {
12903: my ($r,$records,$d) = @_;
1.301 albertel 12904: my $i=0;
12905: my $samples = &get_samples($records,1);
1.144 matthew 12906: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12907: &start_data_table().&start_data_table_header_row().
1.144 matthew 12908: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12909: '<th>'.&mt('Column').'</th>'.
12910: &end_data_table_header_row()."\n");
1.356 albertel 12911: foreach my $array_ref (@$d) {
12912: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12913: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12914:
1.875 bisitz 12915: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12916: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12917: $r->print('<option value="none"></option>');
1.356 albertel 12918: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12919: $r->print('<option value="'.$sample.'"'.
12920: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12921: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12922: }
1.594 raeburn 12923: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12924: $i++;
12925: }
1.594 raeburn 12926: $r->print(&end_data_table());
1.31 albertel 12927: $i--;
12928: return $i;
12929: }
1.56 matthew 12930:
1.144 matthew 12931: ######################################################
12932: ######################################################
12933:
1.56 matthew 12934: =pod
1.31 albertel 12935:
1.648 raeburn 12936: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12937:
12938: Prints a table of sample values from the upload and can make associate samples to internal names.
12939:
12940: $r is an Apache Request ref,
12941: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12942: $d is an array of 2 element arrays (internal name, displayed name)
12943:
12944: =cut
12945:
1.144 matthew 12946: ######################################################
12947: ######################################################
1.31 albertel 12948: sub csv_samples_select_table {
12949: my ($r,$records,$d) = @_;
12950: my $i=0;
1.144 matthew 12951: #
1.662 bisitz 12952: my $max_samples = 5;
12953: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12954: $r->print(&start_data_table().
12955: &start_data_table_header_row().'<th>'.
12956: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12957: &end_data_table_header_row());
1.301 albertel 12958:
12959: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12960: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12961: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12962: foreach my $option (@$d) {
12963: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12964: $r->print('<option value="'.$value.'"'.
1.253 albertel 12965: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12966: $display.'</option>');
1.31 albertel 12967: }
12968: $r->print('</select></td><td>');
1.662 bisitz 12969: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12970: if (defined($samples->[$line]{$key})) {
12971: $r->print($samples->[$line]{$key}."<br />\n");
12972: }
12973: }
1.594 raeburn 12974: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12975: $i++;
12976: }
1.594 raeburn 12977: $r->print(&end_data_table());
1.31 albertel 12978: $i--;
12979: return($i);
1.115 matthew 12980: }
12981:
1.144 matthew 12982: ######################################################
12983: ######################################################
12984:
1.115 matthew 12985: =pod
12986:
1.648 raeburn 12987: =item * &clean_excel_name($name)
1.115 matthew 12988:
12989: Returns a replacement for $name which does not contain any illegal characters.
12990:
12991: =cut
12992:
1.144 matthew 12993: ######################################################
12994: ######################################################
1.115 matthew 12995: sub clean_excel_name {
12996: my ($name) = @_;
12997: $name =~ s/[:\*\?\/\\]//g;
12998: if (length($name) > 31) {
12999: $name = substr($name,0,31);
13000: }
13001: return $name;
1.25 albertel 13002: }
1.84 albertel 13003:
1.85 albertel 13004: =pod
13005:
1.648 raeburn 13006: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 13007:
13008: Returns either 1 or undef
13009:
13010: 1 if the part is to be hidden, undef if it is to be shown
13011:
13012: Arguments are:
13013:
13014: $id the id of the part to be checked
13015: $symb, optional the symb of the resource to check
13016: $udom, optional the domain of the user to check for
13017: $uname, optional the username of the user to check for
13018:
13019: =cut
1.84 albertel 13020:
13021: sub check_if_partid_hidden {
13022: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 13023: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 13024: $symb,$udom,$uname);
1.141 albertel 13025: my $truth=1;
13026: #if the string starts with !, then the list is the list to show not hide
13027: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 13028: my @hiddenlist=split(/,/,$hiddenparts);
13029: foreach my $checkid (@hiddenlist) {
1.141 albertel 13030: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 13031: }
1.141 albertel 13032: return !$truth;
1.84 albertel 13033: }
1.127 matthew 13034:
1.138 matthew 13035:
13036: ############################################################
13037: ############################################################
13038:
13039: =pod
13040:
1.157 matthew 13041: =back
13042:
1.138 matthew 13043: =head1 cgi-bin script and graphing routines
13044:
1.157 matthew 13045: =over 4
13046:
1.648 raeburn 13047: =item * &get_cgi_id()
1.138 matthew 13048:
13049: Inputs: none
13050:
13051: Returns an id which can be used to pass environment variables
13052: to various cgi-bin scripts. These environment variables will
13053: be removed from the users environment after a given time by
13054: the routine &Apache::lonnet::transfer_profile_to_env.
13055:
13056: =cut
13057:
13058: ############################################################
13059: ############################################################
1.152 albertel 13060: my $uniq=0;
1.136 matthew 13061: sub get_cgi_id {
1.154 albertel 13062: $uniq=($uniq+1)%100000;
1.280 albertel 13063: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 13064: }
13065:
1.127 matthew 13066: ############################################################
13067: ############################################################
13068:
13069: =pod
13070:
1.648 raeburn 13071: =item * &DrawBarGraph()
1.127 matthew 13072:
1.138 matthew 13073: Facilitates the plotting of data in a (stacked) bar graph.
13074: Puts plot definition data into the users environment in order for
13075: graph.png to plot it. Returns an <img> tag for the plot.
13076: The bars on the plot are labeled '1','2',...,'n'.
13077:
13078: Inputs:
13079:
13080: =over 4
13081:
13082: =item $Title: string, the title of the plot
13083:
13084: =item $xlabel: string, text describing the X-axis of the plot
13085:
13086: =item $ylabel: string, text describing the Y-axis of the plot
13087:
13088: =item $Max: scalar, the maximum Y value to use in the plot
13089: If $Max is < any data point, the graph will not be rendered.
13090:
1.140 matthew 13091: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 13092: they are plotted. If undefined, default values will be used.
13093:
1.178 matthew 13094: =item $labels: array ref holding the labels to use on the x-axis for the bars.
13095:
1.138 matthew 13096: =item @Values: An array of array references. Each array reference holds data
13097: to be plotted in a stacked bar chart.
13098:
1.239 matthew 13099: =item If the final element of @Values is a hash reference the key/value
13100: pairs will be added to the graph definition.
13101:
1.138 matthew 13102: =back
13103:
13104: Returns:
13105:
13106: An <img> tag which references graph.png and the appropriate identifying
13107: information for the plot.
13108:
1.127 matthew 13109: =cut
13110:
13111: ############################################################
13112: ############################################################
1.134 matthew 13113: sub DrawBarGraph {
1.178 matthew 13114: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 13115: #
13116: if (! defined($colors)) {
13117: $colors = ['#33ff00',
13118: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
13119: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
13120: ];
13121: }
1.228 matthew 13122: my $extra_settings = {};
13123: if (ref($Values[-1]) eq 'HASH') {
13124: $extra_settings = pop(@Values);
13125: }
1.127 matthew 13126: #
1.136 matthew 13127: my $identifier = &get_cgi_id();
13128: my $id = 'cgi.'.$identifier;
1.129 matthew 13129: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 13130: return '';
13131: }
1.225 matthew 13132: #
13133: my @Labels;
13134: if (defined($labels)) {
13135: @Labels = @$labels;
13136: } else {
13137: for (my $i=0;$i<@{$Values[0]};$i++) {
13138: push (@Labels,$i+1);
13139: }
13140: }
13141: #
1.129 matthew 13142: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 13143: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 13144: my %ValuesHash;
13145: my $NumSets=1;
13146: foreach my $array (@Values) {
13147: next if (! ref($array));
1.136 matthew 13148: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 13149: join(',',@$array);
1.129 matthew 13150: }
1.127 matthew 13151: #
1.136 matthew 13152: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 13153: if ($NumBars < 3) {
13154: $width = 120+$NumBars*32;
1.220 matthew 13155: $xskip = 1;
1.225 matthew 13156: $bar_width = 30;
13157: } elsif ($NumBars < 5) {
13158: $width = 120+$NumBars*20;
13159: $xskip = 1;
13160: $bar_width = 20;
1.220 matthew 13161: } elsif ($NumBars < 10) {
1.136 matthew 13162: $width = 120+$NumBars*15;
13163: $xskip = 1;
13164: $bar_width = 15;
13165: } elsif ($NumBars <= 25) {
13166: $width = 120+$NumBars*11;
13167: $xskip = 5;
13168: $bar_width = 8;
13169: } elsif ($NumBars <= 50) {
13170: $width = 120+$NumBars*8;
13171: $xskip = 5;
13172: $bar_width = 4;
13173: } else {
13174: $width = 120+$NumBars*8;
13175: $xskip = 5;
13176: $bar_width = 4;
13177: }
13178: #
1.137 matthew 13179: $Max = 1 if ($Max < 1);
13180: if ( int($Max) < $Max ) {
13181: $Max++;
13182: $Max = int($Max);
13183: }
1.127 matthew 13184: $Title = '' if (! defined($Title));
13185: $xlabel = '' if (! defined($xlabel));
13186: $ylabel = '' if (! defined($ylabel));
1.369 www 13187: $ValuesHash{$id.'.title'} = &escape($Title);
13188: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
13189: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 13190: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 13191: $ValuesHash{$id.'.NumBars'} = $NumBars;
13192: $ValuesHash{$id.'.NumSets'} = $NumSets;
13193: $ValuesHash{$id.'.PlotType'} = 'bar';
13194: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13195: $ValuesHash{$id.'.height'} = $height;
13196: $ValuesHash{$id.'.width'} = $width;
13197: $ValuesHash{$id.'.xskip'} = $xskip;
13198: $ValuesHash{$id.'.bar_width'} = $bar_width;
13199: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 13200: #
1.228 matthew 13201: # Deal with other parameters
13202: while (my ($key,$value) = each(%$extra_settings)) {
13203: $ValuesHash{$id.'.'.$key} = $value;
13204: }
13205: #
1.646 raeburn 13206: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 13207: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13208: }
13209:
13210: ############################################################
13211: ############################################################
13212:
13213: =pod
13214:
1.648 raeburn 13215: =item * &DrawXYGraph()
1.137 matthew 13216:
1.138 matthew 13217: Facilitates the plotting of data in an XY graph.
13218: Puts plot definition data into the users environment in order for
13219: graph.png to plot it. Returns an <img> tag for the plot.
13220:
13221: Inputs:
13222:
13223: =over 4
13224:
13225: =item $Title: string, the title of the plot
13226:
13227: =item $xlabel: string, text describing the X-axis of the plot
13228:
13229: =item $ylabel: string, text describing the Y-axis of the plot
13230:
13231: =item $Max: scalar, the maximum Y value to use in the plot
13232: If $Max is < any data point, the graph will not be rendered.
13233:
13234: =item $colors: Array ref containing the hex color codes for the data to be
13235: plotted in. If undefined, default values will be used.
13236:
13237: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13238:
13239: =item $Ydata: Array ref containing Array refs.
1.185 www 13240: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13241:
13242: =item %Values: hash indicating or overriding any default values which are
13243: passed to graph.png.
13244: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13245:
13246: =back
13247:
13248: Returns:
13249:
13250: An <img> tag which references graph.png and the appropriate identifying
13251: information for the plot.
13252:
1.137 matthew 13253: =cut
13254:
13255: ############################################################
13256: ############################################################
13257: sub DrawXYGraph {
13258: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13259: #
13260: # Create the identifier for the graph
13261: my $identifier = &get_cgi_id();
13262: my $id = 'cgi.'.$identifier;
13263: #
13264: $Title = '' if (! defined($Title));
13265: $xlabel = '' if (! defined($xlabel));
13266: $ylabel = '' if (! defined($ylabel));
13267: my %ValuesHash =
13268: (
1.369 www 13269: $id.'.title' => &escape($Title),
13270: $id.'.xlabel' => &escape($xlabel),
13271: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13272: $id.'.y_max_value'=> $Max,
13273: $id.'.labels' => join(',',@$Xlabels),
13274: $id.'.PlotType' => 'XY',
13275: );
13276: #
13277: if (defined($colors) && ref($colors) eq 'ARRAY') {
13278: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13279: }
13280: #
13281: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13282: return '';
13283: }
13284: my $NumSets=1;
1.138 matthew 13285: foreach my $array (@{$Ydata}){
1.137 matthew 13286: next if (! ref($array));
13287: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13288: }
1.138 matthew 13289: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13290: #
13291: # Deal with other parameters
13292: while (my ($key,$value) = each(%Values)) {
13293: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13294: }
13295: #
1.646 raeburn 13296: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13297: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13298: }
13299:
13300: ############################################################
13301: ############################################################
13302:
13303: =pod
13304:
1.648 raeburn 13305: =item * &DrawXYYGraph()
1.138 matthew 13306:
13307: Facilitates the plotting of data in an XY graph with two Y axes.
13308: Puts plot definition data into the users environment in order for
13309: graph.png to plot it. Returns an <img> tag for the plot.
13310:
13311: Inputs:
13312:
13313: =over 4
13314:
13315: =item $Title: string, the title of the plot
13316:
13317: =item $xlabel: string, text describing the X-axis of the plot
13318:
13319: =item $ylabel: string, text describing the Y-axis of the plot
13320:
13321: =item $colors: Array ref containing the hex color codes for the data to be
13322: plotted in. If undefined, default values will be used.
13323:
13324: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13325:
13326: =item $Ydata1: The first data set
13327:
13328: =item $Min1: The minimum value of the left Y-axis
13329:
13330: =item $Max1: The maximum value of the left Y-axis
13331:
13332: =item $Ydata2: The second data set
13333:
13334: =item $Min2: The minimum value of the right Y-axis
13335:
13336: =item $Max2: The maximum value of the left Y-axis
13337:
13338: =item %Values: hash indicating or overriding any default values which are
13339: passed to graph.png.
13340: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13341:
13342: =back
13343:
13344: Returns:
13345:
13346: An <img> tag which references graph.png and the appropriate identifying
13347: information for the plot.
1.136 matthew 13348:
13349: =cut
13350:
13351: ############################################################
13352: ############################################################
1.137 matthew 13353: sub DrawXYYGraph {
13354: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13355: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13356: #
13357: # Create the identifier for the graph
13358: my $identifier = &get_cgi_id();
13359: my $id = 'cgi.'.$identifier;
13360: #
13361: $Title = '' if (! defined($Title));
13362: $xlabel = '' if (! defined($xlabel));
13363: $ylabel = '' if (! defined($ylabel));
13364: my %ValuesHash =
13365: (
1.369 www 13366: $id.'.title' => &escape($Title),
13367: $id.'.xlabel' => &escape($xlabel),
13368: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13369: $id.'.labels' => join(',',@$Xlabels),
13370: $id.'.PlotType' => 'XY',
13371: $id.'.NumSets' => 2,
1.137 matthew 13372: $id.'.two_axes' => 1,
13373: $id.'.y1_max_value' => $Max1,
13374: $id.'.y1_min_value' => $Min1,
13375: $id.'.y2_max_value' => $Max2,
13376: $id.'.y2_min_value' => $Min2,
1.136 matthew 13377: );
13378: #
1.137 matthew 13379: if (defined($colors) && ref($colors) eq 'ARRAY') {
13380: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13381: }
13382: #
13383: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13384: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13385: return '';
13386: }
13387: my $NumSets=1;
1.137 matthew 13388: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13389: next if (! ref($array));
13390: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13391: }
13392: #
13393: # Deal with other parameters
13394: while (my ($key,$value) = each(%Values)) {
13395: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13396: }
13397: #
1.646 raeburn 13398: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13399: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13400: }
13401:
13402: ############################################################
13403: ############################################################
13404:
13405: =pod
13406:
1.157 matthew 13407: =back
13408:
1.139 matthew 13409: =head1 Statistics helper routines?
13410:
13411: Bad place for them but what the hell.
13412:
1.157 matthew 13413: =over 4
13414:
1.648 raeburn 13415: =item * &chartlink()
1.139 matthew 13416:
13417: Returns a link to the chart for a specific student.
13418:
13419: Inputs:
13420:
13421: =over 4
13422:
13423: =item $linktext: The text of the link
13424:
13425: =item $sname: The students username
13426:
13427: =item $sdomain: The students domain
13428:
13429: =back
13430:
1.157 matthew 13431: =back
13432:
1.139 matthew 13433: =cut
13434:
13435: ############################################################
13436: ############################################################
13437: sub chartlink {
13438: my ($linktext, $sname, $sdomain) = @_;
13439: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13440: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13441: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13442: '">'.$linktext.'</a>';
1.153 matthew 13443: }
13444:
13445: #######################################################
13446: #######################################################
13447:
13448: =pod
13449:
13450: =head1 Course Environment Routines
1.157 matthew 13451:
13452: =over 4
1.153 matthew 13453:
1.648 raeburn 13454: =item * &restore_course_settings()
1.153 matthew 13455:
1.648 raeburn 13456: =item * &store_course_settings()
1.153 matthew 13457:
13458: Restores/Store indicated form parameters from the course environment.
13459: Will not overwrite existing values of the form parameters.
13460:
13461: Inputs:
13462: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13463:
13464: a hash ref describing the data to be stored. For example:
13465:
13466: %Save_Parameters = ('Status' => 'scalar',
13467: 'chartoutputmode' => 'scalar',
13468: 'chartoutputdata' => 'scalar',
13469: 'Section' => 'array',
1.373 raeburn 13470: 'Group' => 'array',
1.153 matthew 13471: 'StudentData' => 'array',
13472: 'Maps' => 'array');
13473:
13474: Returns: both routines return nothing
13475:
1.631 raeburn 13476: =back
13477:
1.153 matthew 13478: =cut
13479:
13480: #######################################################
13481: #######################################################
13482: sub store_course_settings {
1.496 albertel 13483: return &store_settings($env{'request.course.id'},@_);
13484: }
13485:
13486: sub store_settings {
1.153 matthew 13487: # save to the environment
13488: # appenv the same items, just to be safe
1.300 albertel 13489: my $udom = $env{'user.domain'};
13490: my $uname = $env{'user.name'};
1.496 albertel 13491: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13492: my %SaveHash;
13493: my %AppHash;
13494: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13495: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13496: my $envname = 'environment.'.$basename;
1.258 albertel 13497: if (exists($env{'form.'.$setting})) {
1.153 matthew 13498: # Save this value away
13499: if ($type eq 'scalar' &&
1.258 albertel 13500: (! exists($env{$envname}) ||
13501: $env{$envname} ne $env{'form.'.$setting})) {
13502: $SaveHash{$basename} = $env{'form.'.$setting};
13503: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13504: } elsif ($type eq 'array') {
13505: my $stored_form;
1.258 albertel 13506: if (ref($env{'form.'.$setting})) {
1.153 matthew 13507: $stored_form = join(',',
13508: map {
1.369 www 13509: &escape($_);
1.258 albertel 13510: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13511: } else {
13512: $stored_form =
1.369 www 13513: &escape($env{'form.'.$setting});
1.153 matthew 13514: }
13515: # Determine if the array contents are the same.
1.258 albertel 13516: if ($stored_form ne $env{$envname}) {
1.153 matthew 13517: $SaveHash{$basename} = $stored_form;
13518: $AppHash{$envname} = $stored_form;
13519: }
13520: }
13521: }
13522: }
13523: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13524: $udom,$uname);
1.153 matthew 13525: if ($put_result !~ /^(ok|delayed)/) {
13526: &Apache::lonnet::logthis('unable to save form parameters, '.
13527: 'got error:'.$put_result);
13528: }
13529: # Make sure these settings stick around in this session, too
1.646 raeburn 13530: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13531: return;
13532: }
13533:
13534: sub restore_course_settings {
1.499 albertel 13535: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13536: }
13537:
13538: sub restore_settings {
13539: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13540: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13541: next if (exists($env{'form.'.$setting}));
1.496 albertel 13542: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13543: '.'.$setting;
1.258 albertel 13544: if (exists($env{$envname})) {
1.153 matthew 13545: if ($type eq 'scalar') {
1.258 albertel 13546: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13547: } elsif ($type eq 'array') {
1.258 albertel 13548: $env{'form.'.$setting} = [
1.153 matthew 13549: map {
1.369 www 13550: &unescape($_);
1.258 albertel 13551: } split(',',$env{$envname})
1.153 matthew 13552: ];
13553: }
13554: }
13555: }
1.127 matthew 13556: }
13557:
1.618 raeburn 13558: #######################################################
13559: #######################################################
13560:
13561: =pod
13562:
13563: =head1 Domain E-mail Routines
13564:
13565: =over 4
13566:
1.648 raeburn 13567: =item * &build_recipient_list()
1.618 raeburn 13568:
1.1075.2.44 raeburn 13569: Build recipient lists for following types of e-mail:
1.766 raeburn 13570: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1075.2.44 raeburn 13571: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13572: module change checking, student/employee ID conflict checks, as
13573: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13574: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13575:
13576: Inputs:
1.1075.2.44 raeburn 13577: defmail (scalar - email address of default recipient),
13578: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13579: requestsmail, updatesmail, or idconflictsmail).
13580:
1.619 raeburn 13581: defdom (domain for which to retrieve configuration settings),
1.1075.2.44 raeburn 13582:
13583: origmail (scalar - email address of recipient from loncapa.conf,
13584: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13585:
1.655 raeburn 13586: Returns: comma separated list of addresses to which to send e-mail.
13587:
13588: =back
1.618 raeburn 13589:
13590: =cut
13591:
13592: ############################################################
13593: ############################################################
13594: sub build_recipient_list {
1.619 raeburn 13595: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13596: my @recipients;
13597: my $otheremails;
13598: my %domconfig =
13599: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13600: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13601: if (exists($domconfig{'contacts'}{$mailing})) {
13602: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13603: my @contacts = ('adminemail','supportemail');
13604: foreach my $item (@contacts) {
13605: if ($domconfig{'contacts'}{$mailing}{$item}) {
13606: my $addr = $domconfig{'contacts'}{$item};
13607: if (!grep(/^\Q$addr\E$/,@recipients)) {
13608: push(@recipients,$addr);
13609: }
1.619 raeburn 13610: }
1.766 raeburn 13611: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13612: }
13613: }
1.766 raeburn 13614: } elsif ($origmail ne '') {
13615: push(@recipients,$origmail);
1.618 raeburn 13616: }
1.619 raeburn 13617: } elsif ($origmail ne '') {
13618: push(@recipients,$origmail);
1.618 raeburn 13619: }
1.688 raeburn 13620: if (defined($defmail)) {
13621: if ($defmail ne '') {
13622: push(@recipients,$defmail);
13623: }
1.618 raeburn 13624: }
13625: if ($otheremails) {
1.619 raeburn 13626: my @others;
13627: if ($otheremails =~ /,/) {
13628: @others = split(/,/,$otheremails);
1.618 raeburn 13629: } else {
1.619 raeburn 13630: push(@others,$otheremails);
13631: }
13632: foreach my $addr (@others) {
13633: if (!grep(/^\Q$addr\E$/,@recipients)) {
13634: push(@recipients,$addr);
13635: }
1.618 raeburn 13636: }
13637: }
1.619 raeburn 13638: my $recipientlist = join(',',@recipients);
1.618 raeburn 13639: return $recipientlist;
13640: }
13641:
1.127 matthew 13642: ############################################################
13643: ############################################################
1.154 albertel 13644:
1.655 raeburn 13645: =pod
13646:
13647: =head1 Course Catalog Routines
13648:
13649: =over 4
13650:
13651: =item * &gather_categories()
13652:
13653: Converts category definitions - keys of categories hash stored in
13654: coursecategories in configuration.db on the primary library server in a
13655: domain - to an array. Also generates javascript and idx hash used to
13656: generate Domain Coordinator interface for editing Course Categories.
13657:
13658: Inputs:
1.663 raeburn 13659:
1.655 raeburn 13660: categories (reference to hash of category definitions).
1.663 raeburn 13661:
1.655 raeburn 13662: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13663: categories and subcategories).
1.663 raeburn 13664:
1.655 raeburn 13665: idx (reference to hash of counters used in Domain Coordinator interface for
13666: editing Course Categories).
1.663 raeburn 13667:
1.655 raeburn 13668: jsarray (reference to array of categories used to create Javascript arrays for
13669: Domain Coordinator interface for editing Course Categories).
13670:
13671: Returns: nothing
13672:
13673: Side effects: populates cats, idx and jsarray.
13674:
13675: =cut
13676:
13677: sub gather_categories {
13678: my ($categories,$cats,$idx,$jsarray) = @_;
13679: my %counters;
13680: my $num = 0;
13681: foreach my $item (keys(%{$categories})) {
13682: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13683: if ($container eq '' && $depth == 0) {
13684: $cats->[$depth][$categories->{$item}] = $cat;
13685: } else {
13686: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13687: }
13688: my ($escitem,$tail) = split(/:/,$item,2);
13689: if ($counters{$tail} eq '') {
13690: $counters{$tail} = $num;
13691: $num ++;
13692: }
13693: if (ref($idx) eq 'HASH') {
13694: $idx->{$item} = $counters{$tail};
13695: }
13696: if (ref($jsarray) eq 'ARRAY') {
13697: push(@{$jsarray->[$counters{$tail}]},$item);
13698: }
13699: }
13700: return;
13701: }
13702:
13703: =pod
13704:
13705: =item * &extract_categories()
13706:
13707: Used to generate breadcrumb trails for course categories.
13708:
13709: Inputs:
1.663 raeburn 13710:
1.655 raeburn 13711: categories (reference to hash of category definitions).
1.663 raeburn 13712:
1.655 raeburn 13713: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13714: categories and subcategories).
1.663 raeburn 13715:
1.655 raeburn 13716: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13717:
1.655 raeburn 13718: allitems (reference to hash - key is category key
13719: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13720:
1.655 raeburn 13721: idx (reference to hash of counters used in Domain Coordinator interface for
13722: editing Course Categories).
1.663 raeburn 13723:
1.655 raeburn 13724: jsarray (reference to array of categories used to create Javascript arrays for
13725: Domain Coordinator interface for editing Course Categories).
13726:
1.665 raeburn 13727: subcats (reference to hash of arrays containing all subcategories within each
13728: category, -recursive)
13729:
1.655 raeburn 13730: Returns: nothing
13731:
13732: Side effects: populates trails and allitems hash references.
13733:
13734: =cut
13735:
13736: sub extract_categories {
1.665 raeburn 13737: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13738: if (ref($categories) eq 'HASH') {
13739: &gather_categories($categories,$cats,$idx,$jsarray);
13740: if (ref($cats->[0]) eq 'ARRAY') {
13741: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13742: my $name = $cats->[0][$i];
13743: my $item = &escape($name).'::0';
13744: my $trailstr;
13745: if ($name eq 'instcode') {
13746: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13747: } elsif ($name eq 'communities') {
13748: $trailstr = &mt('Communities');
1.655 raeburn 13749: } else {
13750: $trailstr = $name;
13751: }
13752: if ($allitems->{$item} eq '') {
13753: push(@{$trails},$trailstr);
13754: $allitems->{$item} = scalar(@{$trails})-1;
13755: }
13756: my @parents = ($name);
13757: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13758: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13759: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13760: if (ref($subcats) eq 'HASH') {
13761: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13762: }
13763: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13764: }
13765: } else {
13766: if (ref($subcats) eq 'HASH') {
13767: $subcats->{$item} = [];
1.655 raeburn 13768: }
13769: }
13770: }
13771: }
13772: }
13773: return;
13774: }
13775:
13776: =pod
13777:
1.1075.2.56 raeburn 13778: =item * &recurse_categories()
1.655 raeburn 13779:
13780: Recursively used to generate breadcrumb trails for course categories.
13781:
13782: Inputs:
1.663 raeburn 13783:
1.655 raeburn 13784: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13785: categories and subcategories).
1.663 raeburn 13786:
1.655 raeburn 13787: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13788:
13789: category (current course category, for which breadcrumb trail is being generated).
13790:
13791: trails (reference to array of breadcrumb trails for each category).
13792:
1.655 raeburn 13793: allitems (reference to hash - key is category key
13794: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13795:
1.655 raeburn 13796: parents (array containing containers directories for current category,
13797: back to top level).
13798:
13799: Returns: nothing
13800:
13801: Side effects: populates trails and allitems hash references
13802:
13803: =cut
13804:
13805: sub recurse_categories {
1.665 raeburn 13806: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13807: my $shallower = $depth - 1;
13808: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13809: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13810: my $name = $cats->[$depth]{$category}[$k];
13811: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13812: my $trailstr = join(' -> ',(@{$parents},$category));
13813: if ($allitems->{$item} eq '') {
13814: push(@{$trails},$trailstr);
13815: $allitems->{$item} = scalar(@{$trails})-1;
13816: }
13817: my $deeper = $depth+1;
13818: push(@{$parents},$category);
1.665 raeburn 13819: if (ref($subcats) eq 'HASH') {
13820: my $subcat = &escape($name).':'.$category.':'.$depth;
13821: for (my $j=@{$parents}; $j>=0; $j--) {
13822: my $higher;
13823: if ($j > 0) {
13824: $higher = &escape($parents->[$j]).':'.
13825: &escape($parents->[$j-1]).':'.$j;
13826: } else {
13827: $higher = &escape($parents->[$j]).'::'.$j;
13828: }
13829: push(@{$subcats->{$higher}},$subcat);
13830: }
13831: }
13832: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13833: $subcats);
1.655 raeburn 13834: pop(@{$parents});
13835: }
13836: } else {
13837: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13838: my $trailstr = join(' -> ',(@{$parents},$category));
13839: if ($allitems->{$item} eq '') {
13840: push(@{$trails},$trailstr);
13841: $allitems->{$item} = scalar(@{$trails})-1;
13842: }
13843: }
13844: return;
13845: }
13846:
1.663 raeburn 13847: =pod
13848:
1.1075.2.56 raeburn 13849: =item * &assign_categories_table()
1.663 raeburn 13850:
13851: Create a datatable for display of hierarchical categories in a domain,
13852: with checkboxes to allow a course to be categorized.
13853:
13854: Inputs:
13855:
13856: cathash - reference to hash of categories defined for the domain (from
13857: configuration.db)
13858:
13859: currcat - scalar with an & separated list of categories assigned to a course.
13860:
1.919 raeburn 13861: type - scalar contains course type (Course or Community).
13862:
1.663 raeburn 13863: Returns: $output (markup to be displayed)
13864:
13865: =cut
13866:
13867: sub assign_categories_table {
1.919 raeburn 13868: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13869: my $output;
13870: if (ref($cathash) eq 'HASH') {
13871: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13872: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13873: $maxdepth = scalar(@cats);
13874: if (@cats > 0) {
13875: my $itemcount = 0;
13876: if (ref($cats[0]) eq 'ARRAY') {
13877: my @currcategories;
13878: if ($currcat ne '') {
13879: @currcategories = split('&',$currcat);
13880: }
1.919 raeburn 13881: my $table;
1.663 raeburn 13882: for (my $i=0; $i<@{$cats[0]}; $i++) {
13883: my $parent = $cats[0][$i];
1.919 raeburn 13884: next if ($parent eq 'instcode');
13885: if ($type eq 'Community') {
13886: next unless ($parent eq 'communities');
13887: } else {
13888: next if ($parent eq 'communities');
13889: }
1.663 raeburn 13890: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13891: my $item = &escape($parent).'::0';
13892: my $checked = '';
13893: if (@currcategories > 0) {
13894: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13895: $checked = ' checked="checked"';
1.663 raeburn 13896: }
13897: }
1.919 raeburn 13898: my $parent_title = $parent;
13899: if ($parent eq 'communities') {
13900: $parent_title = &mt('Communities');
13901: }
13902: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13903: '<input type="checkbox" name="usecategory" value="'.
13904: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13905: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13906: my $depth = 1;
13907: push(@path,$parent);
1.919 raeburn 13908: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13909: pop(@path);
1.919 raeburn 13910: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13911: $itemcount ++;
13912: }
1.919 raeburn 13913: if ($itemcount) {
13914: $output = &Apache::loncommon::start_data_table().
13915: $table.
13916: &Apache::loncommon::end_data_table();
13917: }
1.663 raeburn 13918: }
13919: }
13920: }
13921: return $output;
13922: }
13923:
13924: =pod
13925:
1.1075.2.56 raeburn 13926: =item * &assign_category_rows()
1.663 raeburn 13927:
13928: Create a datatable row for display of nested categories in a domain,
13929: with checkboxes to allow a course to be categorized,called recursively.
13930:
13931: Inputs:
13932:
13933: itemcount - track row number for alternating colors
13934:
13935: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13936: categories and subcategories.
13937:
13938: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13939:
13940: parent - parent of current category item
13941:
13942: path - Array containing all categories back up through the hierarchy from the
13943: current category to the top level.
13944:
13945: currcategories - reference to array of current categories assigned to the course
13946:
13947: Returns: $output (markup to be displayed).
13948:
13949: =cut
13950:
13951: sub assign_category_rows {
13952: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13953: my ($text,$name,$item,$chgstr);
13954: if (ref($cats) eq 'ARRAY') {
13955: my $maxdepth = scalar(@{$cats});
13956: if (ref($cats->[$depth]) eq 'HASH') {
13957: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13958: my $numchildren = @{$cats->[$depth]{$parent}};
13959: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1075.2.45 raeburn 13960: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13961: for (my $j=0; $j<$numchildren; $j++) {
13962: $name = $cats->[$depth]{$parent}[$j];
13963: $item = &escape($name).':'.&escape($parent).':'.$depth;
13964: my $deeper = $depth+1;
13965: my $checked = '';
13966: if (ref($currcategories) eq 'ARRAY') {
13967: if (@{$currcategories} > 0) {
13968: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13969: $checked = ' checked="checked"';
1.663 raeburn 13970: }
13971: }
13972: }
1.664 raeburn 13973: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13974: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13975: $item.'"'.$checked.' />'.$name.'</label></span>'.
13976: '<input type="hidden" name="catname" value="'.$name.'" />'.
13977: '</td><td>';
1.663 raeburn 13978: if (ref($path) eq 'ARRAY') {
13979: push(@{$path},$name);
13980: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13981: pop(@{$path});
13982: }
13983: $text .= '</td></tr>';
13984: }
13985: $text .= '</table></td>';
13986: }
13987: }
13988: }
13989: return $text;
13990: }
13991:
1.1075.2.69 raeburn 13992: =pod
13993:
13994: =back
13995:
13996: =cut
13997:
1.655 raeburn 13998: ############################################################
13999: ############################################################
14000:
14001:
1.443 albertel 14002: sub commit_customrole {
1.664 raeburn 14003: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 14004: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 14005: ($start?', '.&mt('starting').' '.localtime($start):'').
14006: ($end?', ending '.localtime($end):'').': <b>'.
14007: &Apache::lonnet::assigncustomrole(
1.664 raeburn 14008: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 14009: '</b><br />';
14010: return $output;
14011: }
14012:
14013: sub commit_standardrole {
1.1075.2.31 raeburn 14014: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 14015: my ($output,$logmsg,$linefeed);
14016: if ($context eq 'auto') {
14017: $linefeed = "\n";
14018: } else {
14019: $linefeed = "<br />\n";
14020: }
1.443 albertel 14021: if ($three eq 'st') {
1.541 raeburn 14022: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1075.2.31 raeburn 14023: $one,$two,$sec,$context,$credits);
1.541 raeburn 14024: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 14025: ($result eq 'unknown_course') || ($result eq 'refused')) {
14026: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 14027: } else {
1.541 raeburn 14028: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 14029: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14030: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
14031: if ($context eq 'auto') {
14032: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
14033: } else {
14034: $output .= '<b>'.$result.'</b>'.$linefeed.
14035: &mt('Add to classlist').': <b>ok</b>';
14036: }
14037: $output .= $linefeed;
1.443 albertel 14038: }
14039: } else {
14040: $output = &mt('Assigning').' '.$three.' in '.$url.
14041: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 14042: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 14043: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 14044: if ($context eq 'auto') {
14045: $output .= $result.$linefeed;
14046: } else {
14047: $output .= '<b>'.$result.'</b>'.$linefeed;
14048: }
1.443 albertel 14049: }
14050: return $output;
14051: }
14052:
14053: sub commit_studentrole {
1.1075.2.31 raeburn 14054: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
14055: $credits) = @_;
1.626 raeburn 14056: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 14057: if ($context eq 'auto') {
14058: $linefeed = "\n";
14059: } else {
14060: $linefeed = '<br />'."\n";
14061: }
1.443 albertel 14062: if (defined($one) && defined($two)) {
14063: my $cid=$one.'_'.$two;
14064: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
14065: my $secchange = 0;
14066: my $expire_role_result;
14067: my $modify_section_result;
1.628 raeburn 14068: if ($oldsec ne '-1') {
14069: if ($oldsec ne $sec) {
1.443 albertel 14070: $secchange = 1;
1.628 raeburn 14071: my $now = time;
1.443 albertel 14072: my $uurl='/'.$cid;
14073: $uurl=~s/\_/\//g;
14074: if ($oldsec) {
14075: $uurl.='/'.$oldsec;
14076: }
1.626 raeburn 14077: $oldsecurl = $uurl;
1.628 raeburn 14078: $expire_role_result =
1.652 raeburn 14079: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 14080: if ($env{'request.course.sec'} ne '') {
14081: if ($expire_role_result eq 'refused') {
14082: my @roles = ('st');
14083: my @statuses = ('previous');
14084: my @roledoms = ($one);
14085: my $withsec = 1;
14086: my %roleshash =
14087: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
14088: \@statuses,\@roles,\@roledoms,$withsec);
14089: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
14090: my ($oldstart,$oldend) =
14091: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
14092: if ($oldend > 0 && $oldend <= $now) {
14093: $expire_role_result = 'ok';
14094: }
14095: }
14096: }
14097: }
1.443 albertel 14098: $result = $expire_role_result;
14099: }
14100: }
14101: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1075.2.31 raeburn 14102: $modify_section_result =
14103: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
14104: undef,undef,undef,$sec,
14105: $end,$start,'','',$cid,
14106: '',$context,$credits);
1.443 albertel 14107: if ($modify_section_result =~ /^ok/) {
14108: if ($secchange == 1) {
1.628 raeburn 14109: if ($sec eq '') {
14110: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
14111: } else {
14112: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
14113: }
1.443 albertel 14114: } elsif ($oldsec eq '-1') {
1.628 raeburn 14115: if ($sec eq '') {
14116: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
14117: } else {
14118: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14119: }
1.443 albertel 14120: } else {
1.628 raeburn 14121: if ($sec eq '') {
14122: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
14123: } else {
14124: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
14125: }
1.443 albertel 14126: }
14127: } else {
1.628 raeburn 14128: if ($secchange) {
14129: $$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;
14130: } else {
14131: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
14132: }
1.443 albertel 14133: }
14134: $result = $modify_section_result;
14135: } elsif ($secchange == 1) {
1.628 raeburn 14136: if ($oldsec eq '') {
1.1075.2.20 raeburn 14137: $$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 14138: } else {
14139: $$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;
14140: }
1.626 raeburn 14141: if ($expire_role_result eq 'refused') {
14142: my $newsecurl = '/'.$cid;
14143: $newsecurl =~ s/\_/\//g;
14144: if ($sec ne '') {
14145: $newsecurl.='/'.$sec;
14146: }
14147: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
14148: if ($sec eq '') {
14149: $$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;
14150: } else {
14151: $$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;
14152: }
14153: }
14154: }
1.443 albertel 14155: }
14156: } else {
1.626 raeburn 14157: $$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 14158: $result = "error: incomplete course id\n";
14159: }
14160: return $result;
14161: }
14162:
1.1075.2.25 raeburn 14163: sub show_role_extent {
14164: my ($scope,$context,$role) = @_;
14165: $scope =~ s{^/}{};
14166: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
14167: push(@courseroles,'co');
14168: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
14169: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
14170: $scope =~ s{/}{_};
14171: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
14172: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
14173: my ($audom,$auname) = split(/\//,$scope);
14174: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
14175: &Apache::loncommon::plainname($auname,$audom).'</span>');
14176: } else {
14177: $scope =~ s{/$}{};
14178: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
14179: &Apache::lonnet::domain($scope,'description').'</span>');
14180: }
14181: }
14182:
1.443 albertel 14183: ############################################################
14184: ############################################################
14185:
1.566 albertel 14186: sub check_clone {
1.578 raeburn 14187: my ($args,$linefeed) = @_;
1.566 albertel 14188: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
14189: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
14190: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
14191: my $clonemsg;
14192: my $can_clone = 0;
1.944 raeburn 14193: my $lctype = lc($args->{'crstype'});
1.908 raeburn 14194: if ($lctype ne 'community') {
14195: $lctype = 'course';
14196: }
1.566 albertel 14197: if ($clonehome eq 'no_host') {
1.944 raeburn 14198: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14199: $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'});
14200: } else {
14201: $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'});
14202: }
1.566 albertel 14203: } else {
14204: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 14205: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14206: if ($clonedesc{'type'} ne 'Community') {
14207: $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'});
14208: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14209: }
14210: }
1.882 raeburn 14211: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
14212: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 14213: $can_clone = 1;
14214: } else {
1.1075.2.95 raeburn 14215: my %clonehash = &Apache::lonnet::get('environment',['cloners','internal.coursecode'],
1.566 albertel 14216: $args->{'clonedomain'},$args->{'clonecourse'});
1.1075.2.95 raeburn 14217: if ($clonehash{'cloners'} eq '') {
14218: my %domdefs = &Apache::lonnet::get_domain_defaults($args->{'course_domain'});
14219: if ($domdefs{'canclone'}) {
14220: unless ($domdefs{'canclone'} eq 'none') {
14221: if ($domdefs{'canclone'} eq 'domain') {
14222: if ($args->{'ccdomain'} eq $args->{'clonedomain'}) {
14223: $can_clone = 1;
14224: }
14225: } elsif (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14226: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
14227: if (&Apache::lonnet::default_instcode_cloning($args->{'clonedomain'},$domdefs{'canclone'},
14228: $clonehash{'internal.coursecode'},$args->{'crscode'})) {
14229: $can_clone = 1;
14230: }
14231: }
14232: }
1.908 raeburn 14233: }
1.1075.2.95 raeburn 14234: } else {
14235: my @cloners = split(/,/,$clonehash{'cloners'});
14236: if (grep(/^\*$/,@cloners)) {
1.942 raeburn 14237: $can_clone = 1;
1.1075.2.95 raeburn 14238: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
1.942 raeburn 14239: $can_clone = 1;
1.1075.2.96 raeburn 14240: } elsif (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14241: $can_clone = 1;
1.1075.2.95 raeburn 14242: }
14243: unless ($can_clone) {
1.1075.2.96 raeburn 14244: if (($clonehash{'internal.coursecode'}) && ($args->{'crscode'}) &&
14245: ($args->{'clonedomain'} eq $args->{'course_domain'})) {
1.1075.2.95 raeburn 14246: my (%gotdomdefaults,%gotcodedefaults);
14247: foreach my $cloner (@cloners) {
14248: if (($cloner ne '*') && ($cloner !~ /^\*\:$match_domain$/) &&
14249: ($cloner !~ /^$match_username\:$match_domain$/) && ($cloner ne '')) {
14250: my (%codedefaults,@code_order);
14251: if (ref($gotcodedefaults{$args->{'clonedomain'}}) eq 'HASH') {
14252: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'defaults'}) eq 'HASH') {
14253: %codedefaults = %{$gotcodedefaults{$args->{'clonedomain'}}{'defaults'}};
14254: }
14255: if (ref($gotcodedefaults{$args->{'clonedomain'}}{'order'}) eq 'ARRAY') {
14256: @code_order = @{$gotcodedefaults{$args->{'clonedomain'}}{'order'}};
14257: }
14258: } else {
14259: &Apache::lonnet::auto_instcode_defaults($args->{'clonedomain'},
14260: \%codedefaults,
14261: \@code_order);
14262: $gotcodedefaults{$args->{'clonedomain'}}{'defaults'} = \%codedefaults;
14263: $gotcodedefaults{$args->{'clonedomain'}}{'order'} = \@code_order;
14264: }
14265: if (@code_order > 0) {
14266: if (&Apache::lonnet::check_instcode_cloning(\%codedefaults,\@code_order,
14267: $cloner,$clonehash{'internal.coursecode'},
14268: $args->{'crscode'})) {
14269: $can_clone = 1;
14270: last;
14271: }
14272: }
14273: }
14274: }
14275: }
1.1075.2.96 raeburn 14276: }
14277: }
14278: unless ($can_clone) {
14279: my $ccrole = 'cc';
14280: if ($args->{'crstype'} eq 'Community') {
14281: $ccrole = 'co';
14282: }
14283: my %roleshash =
14284: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14285: $args->{'ccdomain'},
14286: 'userroles',['active'],[$ccrole],
14287: [$args->{'clonedomain'}]);
14288: if ($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) {
14289: $can_clone = 1;
14290: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},
14291: $args->{'ccuname'},$args->{'ccdomain'})) {
14292: $can_clone = 1;
1.1075.2.95 raeburn 14293: }
14294: }
14295: unless ($can_clone) {
14296: if ($args->{'crstype'} eq 'Community') {
14297: $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'});
14298: } else {
14299: $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 14300: }
1.566 albertel 14301: }
1.578 raeburn 14302: }
1.566 albertel 14303: }
14304: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14305: }
14306:
1.444 albertel 14307: sub construct_course {
1.1075.2.59 raeburn 14308: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14309: my $outcome;
1.541 raeburn 14310: my $linefeed = '<br />'."\n";
14311: if ($context eq 'auto') {
14312: $linefeed = "\n";
14313: }
1.566 albertel 14314:
14315: #
14316: # Are we cloning?
14317: #
14318: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14319: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14320: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14321: if ($context ne 'auto') {
1.578 raeburn 14322: if ($clonemsg ne '') {
14323: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14324: }
1.566 albertel 14325: }
14326: $outcome .= $clonemsg.$linefeed;
14327:
14328: if (!$can_clone) {
14329: return (0,$outcome);
14330: }
14331: }
14332:
1.444 albertel 14333: #
14334: # Open course
14335: #
14336: my $crstype = lc($args->{'crstype'});
14337: my %cenv=();
14338: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14339: $args->{'cdescr'},
14340: $args->{'curl'},
14341: $args->{'course_home'},
14342: $args->{'nonstandard'},
14343: $args->{'crscode'},
14344: $args->{'ccuname'}.':'.
14345: $args->{'ccdomain'},
1.882 raeburn 14346: $args->{'crstype'},
1.885 raeburn 14347: $cnum,$context,$category);
1.444 albertel 14348:
14349: # Note: The testing routines depend on this being output; see
14350: # Utils::Course. This needs to at least be output as a comment
14351: # if anyone ever decides to not show this, and Utils::Course::new
14352: # will need to be suitably modified.
1.541 raeburn 14353: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14354: if ($$courseid =~ /^error:/) {
14355: return (0,$outcome);
14356: }
14357:
1.444 albertel 14358: #
14359: # Check if created correctly
14360: #
1.479 albertel 14361: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14362: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14363: if ($crsuhome eq 'no_host') {
14364: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14365: return (0,$outcome);
14366: }
1.541 raeburn 14367: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14368:
1.444 albertel 14369: #
1.566 albertel 14370: # Do the cloning
14371: #
14372: if ($can_clone && $cloneid) {
14373: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14374: if ($context ne 'auto') {
14375: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14376: }
14377: $outcome .= $clonemsg.$linefeed;
14378: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14379: # Copy all files
1.637 www 14380: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14381: # Restore URL
1.566 albertel 14382: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14383: # Restore title
1.566 albertel 14384: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14385: # Restore creation date, creator and creation context.
14386: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14387: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14388: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14389: # Mark as cloned
1.566 albertel 14390: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14391: # Need to clone grading mode
14392: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14393: $cenv{'grading'}=$newenv{'grading'};
14394: # Do not clone these environment entries
14395: &Apache::lonnet::del('environment',
14396: ['default_enrollment_start_date',
14397: 'default_enrollment_end_date',
14398: 'question.email',
14399: 'policy.email',
14400: 'comment.email',
14401: 'pch.users.denied',
1.725 raeburn 14402: 'plc.users.denied',
14403: 'hidefromcat',
1.1075.2.36 raeburn 14404: 'checkforpriv',
1.1075.2.59 raeburn 14405: 'categories',
14406: 'internal.uniquecode'],
1.638 www 14407: $$crsudom,$$crsunum);
1.1075.2.63 raeburn 14408: if ($args->{'textbook'}) {
14409: $cenv{'internal.textbook'} = $args->{'textbook'};
14410: }
1.444 albertel 14411: }
1.566 albertel 14412:
1.444 albertel 14413: #
14414: # Set environment (will override cloned, if existing)
14415: #
14416: my @sections = ();
14417: my @xlists = ();
14418: if ($args->{'crstype'}) {
14419: $cenv{'type'}=$args->{'crstype'};
14420: }
14421: if ($args->{'crsid'}) {
14422: $cenv{'courseid'}=$args->{'crsid'};
14423: }
14424: if ($args->{'crscode'}) {
14425: $cenv{'internal.coursecode'}=$args->{'crscode'};
14426: }
14427: if ($args->{'crsquota'} ne '') {
14428: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14429: } else {
14430: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14431: }
14432: if ($args->{'ccuname'}) {
14433: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14434: ':'.$args->{'ccdomain'};
14435: } else {
14436: $cenv{'internal.courseowner'} = $args->{'curruser'};
14437: }
1.1075.2.31 raeburn 14438: if ($args->{'defaultcredits'}) {
14439: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14440: }
1.444 albertel 14441: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14442: if ($args->{'crssections'}) {
14443: $cenv{'internal.sectionnums'} = '';
14444: if ($args->{'crssections'} =~ m/,/) {
14445: @sections = split/,/,$args->{'crssections'};
14446: } else {
14447: $sections[0] = $args->{'crssections'};
14448: }
14449: if (@sections > 0) {
14450: foreach my $item (@sections) {
14451: my ($sec,$gp) = split/:/,$item;
14452: my $class = $args->{'crscode'}.$sec;
14453: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14454: $cenv{'internal.sectionnums'} .= $item.',';
14455: unless ($addcheck eq 'ok') {
14456: push @badclasses, $class;
14457: }
14458: }
14459: $cenv{'internal.sectionnums'} =~ s/,$//;
14460: }
14461: }
14462: # do not hide course coordinator from staff listing,
14463: # even if privileged
14464: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1075.2.36 raeburn 14465: # add course coordinator's domain to domains to check for privileged users
14466: # if different to course domain
14467: if ($$crsudom ne $args->{'ccdomain'}) {
14468: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14469: }
1.444 albertel 14470: # add crosslistings
14471: if ($args->{'crsxlist'}) {
14472: $cenv{'internal.crosslistings'}='';
14473: if ($args->{'crsxlist'} =~ m/,/) {
14474: @xlists = split/,/,$args->{'crsxlist'};
14475: } else {
14476: $xlists[0] = $args->{'crsxlist'};
14477: }
14478: if (@xlists > 0) {
14479: foreach my $item (@xlists) {
14480: my ($xl,$gp) = split/:/,$item;
14481: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14482: $cenv{'internal.crosslistings'} .= $item.',';
14483: unless ($addcheck eq 'ok') {
14484: push @badclasses, $xl;
14485: }
14486: }
14487: $cenv{'internal.crosslistings'} =~ s/,$//;
14488: }
14489: }
14490: if ($args->{'autoadds'}) {
14491: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14492: }
14493: if ($args->{'autodrops'}) {
14494: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14495: }
14496: # check for notification of enrollment changes
14497: my @notified = ();
14498: if ($args->{'notify_owner'}) {
14499: if ($args->{'ccuname'} ne '') {
14500: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14501: }
14502: }
14503: if ($args->{'notify_dc'}) {
14504: if ($uname ne '') {
1.630 raeburn 14505: push(@notified,$uname.':'.$udom);
1.444 albertel 14506: }
14507: }
14508: if (@notified > 0) {
14509: my $notifylist;
14510: if (@notified > 1) {
14511: $notifylist = join(',',@notified);
14512: } else {
14513: $notifylist = $notified[0];
14514: }
14515: $cenv{'internal.notifylist'} = $notifylist;
14516: }
14517: if (@badclasses > 0) {
14518: my %lt=&Apache::lonlocal::texthash(
14519: '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',
14520: 'dnhr' => 'does not have rights to access enrollment in these classes',
14521: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14522: );
1.541 raeburn 14523: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14524: ' ('.$lt{'adby'}.')';
14525: if ($context eq 'auto') {
14526: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14527: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14528: foreach my $item (@badclasses) {
14529: if ($context eq 'auto') {
14530: $outcome .= " - $item\n";
14531: } else {
14532: $outcome .= "<li>$item</li>\n";
14533: }
14534: }
14535: if ($context eq 'auto') {
14536: $outcome .= $linefeed;
14537: } else {
1.566 albertel 14538: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14539: }
14540: }
1.444 albertel 14541: }
14542: if ($args->{'no_end_date'}) {
14543: $args->{'endaccess'} = 0;
14544: }
14545: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14546: $cenv{'internal.autoend'}=$args->{'enrollend'};
14547: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14548: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14549: if ($args->{'showphotos'}) {
14550: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14551: }
14552: $cenv{'internal.authtype'} = $args->{'authtype'};
14553: $cenv{'internal.autharg'} = $args->{'autharg'};
14554: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14555: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14556: 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');
14557: if ($context eq 'auto') {
14558: $outcome .= $krb_msg;
14559: } else {
1.566 albertel 14560: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14561: }
14562: $outcome .= $linefeed;
1.444 albertel 14563: }
14564: }
14565: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14566: if ($args->{'setpolicy'}) {
14567: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14568: }
14569: if ($args->{'setcontent'}) {
14570: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14571: }
14572: }
14573: if ($args->{'reshome'}) {
14574: $cenv{'reshome'}=$args->{'reshome'}.'/';
14575: $cenv{'reshome'}=~s/\/+$/\//;
14576: }
14577: #
14578: # course has keyed access
14579: #
14580: if ($args->{'setkeys'}) {
14581: $cenv{'keyaccess'}='yes';
14582: }
14583: # if specified, key authority is not course, but user
14584: # only active if keyaccess is yes
14585: if ($args->{'keyauth'}) {
1.487 albertel 14586: my ($user,$domain) = split(':',$args->{'keyauth'});
14587: $user = &LONCAPA::clean_username($user);
14588: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14589: if ($user ne '' && $domain ne '') {
1.487 albertel 14590: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14591: }
14592: }
14593:
1.1075.2.59 raeburn 14594: #
14595: # generate and store uniquecode (available to course requester), if course should have one.
14596: #
14597: if ($args->{'uniquecode'}) {
14598: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14599: if ($code) {
14600: $cenv{'internal.uniquecode'} = $code;
14601: my %crsinfo =
14602: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14603: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14604: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14605: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14606: }
14607: if (ref($coderef)) {
14608: $$coderef = $code;
14609: }
14610: }
14611: }
14612:
1.444 albertel 14613: if ($args->{'disresdis'}) {
14614: $cenv{'pch.roles.denied'}='st';
14615: }
14616: if ($args->{'disablechat'}) {
14617: $cenv{'plc.roles.denied'}='st';
14618: }
14619:
14620: # Record we've not yet viewed the Course Initialization Helper for this
14621: # course
14622: $cenv{'course.helper.not.run'} = 1;
14623: #
14624: # Use new Randomseed
14625: #
14626: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14627: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14628: #
14629: # The encryption code and receipt prefix for this course
14630: #
14631: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14632: $cenv{'internal.encpref'}=100+int(9*rand(99));
14633: #
14634: # By default, use standard grading
14635: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14636:
1.541 raeburn 14637: $outcome .= $linefeed.&mt('Setting environment').': '.
14638: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14639: #
14640: # Open all assignments
14641: #
14642: if ($args->{'openall'}) {
14643: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14644: my %storecontent = ($storeunder => time,
14645: $storeunder.'.type' => 'date_start');
14646:
14647: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14648: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14649: }
14650: #
14651: # Set first page
14652: #
14653: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14654: || ($cloneid)) {
1.445 albertel 14655: use LONCAPA::map;
1.444 albertel 14656: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14657:
14658: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14659: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14660:
1.444 albertel 14661: $outcome .= ($fatal?$errtext:'read ok').' - ';
14662: my $title; my $url;
14663: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14664: $title=&mt('Syllabus');
1.444 albertel 14665: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14666: } else {
1.963 raeburn 14667: $title=&mt('Table of Contents');
1.444 albertel 14668: $url='/adm/navmaps';
14669: }
1.445 albertel 14670:
14671: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14672: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14673:
14674: if ($errtext) { $fatal=2; }
1.541 raeburn 14675: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14676: }
1.566 albertel 14677:
14678: return (1,$outcome);
1.444 albertel 14679: }
14680:
1.1075.2.59 raeburn 14681: sub make_unique_code {
14682: my ($cdom,$cnum) = @_;
14683: # get lock on uniquecodes db
14684: my $lockhash = {
14685: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14686: ':'.$env{'user.domain'},
14687: };
14688: my $tries = 0;
14689: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14690: my ($code,$error);
14691:
14692: while (($gotlock ne 'ok') && ($tries<3)) {
14693: $tries ++;
14694: sleep 1;
14695: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14696: }
14697: if ($gotlock eq 'ok') {
14698: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14699: my $gotcode;
14700: my $attempts = 0;
14701: while ((!$gotcode) && ($attempts < 100)) {
14702: $code = &generate_code();
14703: if (!exists($currcodes{$code})) {
14704: $gotcode = 1;
14705: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14706: $error = 'nostore';
14707: }
14708: }
14709: $attempts ++;
14710: }
14711: my @del_lock = ($cnum."\0".'uniquecodes');
14712: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14713: } else {
14714: $error = 'nolock';
14715: }
14716: return ($code,$error);
14717: }
14718:
14719: sub generate_code {
14720: my $code;
14721: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14722: for (my $i=0; $i<6; $i++) {
14723: my $lettnum = int (rand 2);
14724: my $item = '';
14725: if ($lettnum) {
14726: $item = $letts[int( rand(18) )];
14727: } else {
14728: $item = 1+int( rand(8) );
14729: }
14730: $code .= $item;
14731: }
14732: return $code;
14733: }
14734:
1.444 albertel 14735: ############################################################
14736: ############################################################
14737:
1.953 droeschl 14738: #SD
14739: # only Community and Course, or anything else?
1.378 raeburn 14740: sub course_type {
14741: my ($cid) = @_;
14742: if (!defined($cid)) {
14743: $cid = $env{'request.course.id'};
14744: }
1.404 albertel 14745: if (defined($env{'course.'.$cid.'.type'})) {
14746: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14747: } else {
14748: return 'Course';
1.377 raeburn 14749: }
14750: }
1.156 albertel 14751:
1.406 raeburn 14752: sub group_term {
14753: my $crstype = &course_type();
14754: my %names = (
14755: 'Course' => 'group',
1.865 raeburn 14756: 'Community' => 'group',
1.406 raeburn 14757: );
14758: return $names{$crstype};
14759: }
14760:
1.902 raeburn 14761: sub course_types {
1.1075.2.59 raeburn 14762: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14763: my %typename = (
14764: official => 'Official course',
14765: unofficial => 'Unofficial course',
14766: community => 'Community',
1.1075.2.59 raeburn 14767: textbook => 'Textbook course',
1.902 raeburn 14768: );
14769: return (\@types,\%typename);
14770: }
14771:
1.156 albertel 14772: sub icon {
14773: my ($file)=@_;
1.505 albertel 14774: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14775: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14776: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14777: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14778: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14779: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14780: $curfext.".gif") {
14781: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14782: $curfext.".gif";
14783: }
14784: }
1.249 albertel 14785: return &lonhttpdurl($iconname);
1.154 albertel 14786: }
1.84 albertel 14787:
1.575 albertel 14788: sub lonhttpdurl {
1.692 www 14789: #
14790: # Had been used for "small fry" static images on separate port 8080.
14791: # Modify here if lightweight http functionality desired again.
14792: # Currently eliminated due to increasing firewall issues.
14793: #
1.575 albertel 14794: my ($url)=@_;
1.692 www 14795: return $url;
1.215 albertel 14796: }
14797:
1.213 albertel 14798: sub connection_aborted {
14799: my ($r)=@_;
14800: $r->print(" ");$r->rflush();
14801: my $c = $r->connection;
14802: return $c->aborted();
14803: }
14804:
1.221 foxr 14805: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14806: # strings as 'strings'.
14807: sub escape_single {
1.221 foxr 14808: my ($input) = @_;
1.223 albertel 14809: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14810: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14811: return $input;
14812: }
1.223 albertel 14813:
1.222 foxr 14814: # Same as escape_single, but escape's "'s This
14815: # can be used for "strings"
14816: sub escape_double {
14817: my ($input) = @_;
14818: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14819: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14820: return $input;
14821: }
1.223 albertel 14822:
1.222 foxr 14823: # Escapes the last element of a full URL.
14824: sub escape_url {
14825: my ($url) = @_;
1.238 raeburn 14826: my @urlslices = split(/\//, $url,-1);
1.369 www 14827: my $lastitem = &escape(pop(@urlslices));
1.1075.2.83 raeburn 14828: return &HTML::Entities::encode(join('/',@urlslices),"'").'/'.$lastitem;
1.222 foxr 14829: }
1.462 albertel 14830:
1.820 raeburn 14831: sub compare_arrays {
14832: my ($arrayref1,$arrayref2) = @_;
14833: my (@difference,%count);
14834: @difference = ();
14835: %count = ();
14836: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14837: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14838: foreach my $element (keys(%count)) {
14839: if ($count{$element} == 1) {
14840: push(@difference,$element);
14841: }
14842: }
14843: }
14844: return @difference;
14845: }
14846:
1.817 bisitz 14847: # -------------------------------------------------------- Initialize user login
1.462 albertel 14848: sub init_user_environment {
1.463 albertel 14849: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14850: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14851:
14852: my $public=($username eq 'public' && $domain eq 'public');
14853:
14854: # See if old ID present, if so, remove
14855:
1.1062 raeburn 14856: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14857: my $now=time;
14858:
14859: if ($public) {
14860: my $max_public=100;
14861: my $oldest;
14862: my $oldest_time=0;
14863: for(my $next=1;$next<=$max_public;$next++) {
14864: if (-e $lonids."/publicuser_$next.id") {
14865: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14866: if ($mtime<$oldest_time || !$oldest_time) {
14867: $oldest_time=$mtime;
14868: $oldest=$next;
14869: }
14870: } else {
14871: $cookie="publicuser_$next";
14872: last;
14873: }
14874: }
14875: if (!$cookie) { $cookie="publicuser_$oldest"; }
14876: } else {
1.463 albertel 14877: # if this isn't a robot, kill any existing non-robot sessions
14878: if (!$args->{'robot'}) {
14879: opendir(DIR,$lonids);
14880: while ($filename=readdir(DIR)) {
14881: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14882: unlink($lonids.'/'.$filename);
14883: }
1.462 albertel 14884: }
1.463 albertel 14885: closedir(DIR);
1.1075.2.84 raeburn 14886: # If there is a undeleted lockfile for the user's paste buffer remove it.
14887: my $namespace = 'nohist_courseeditor';
14888: my $lockingkey = 'paste'."\0".'locked_num';
14889: my %lockhash = &Apache::lonnet::get($namespace,[$lockingkey],
14890: $domain,$username);
14891: if (exists($lockhash{$lockingkey})) {
14892: my $delresult = &Apache::lonnet::del($namespace,[$lockingkey],$domain,$username);
14893: unless ($delresult eq 'ok') {
14894: &Apache::lonnet::logthis("Failed to delete paste buffer locking key in $namespace for ".$username.":".$domain." Result was: $delresult");
14895: }
14896: }
1.462 albertel 14897: }
14898: # Give them a new cookie
1.463 albertel 14899: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14900: : $now.$$.int(rand(10000)));
1.463 albertel 14901: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14902:
14903: # Initialize roles
14904:
1.1062 raeburn 14905: ($userroles,$firstaccenv,$timerintenv) =
14906: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14907: }
14908: # ------------------------------------ Check browser type and MathML capability
14909:
1.1075.2.77 raeburn 14910: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14911: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14912:
14913: # ------------------------------------------------------------- Get environment
14914:
14915: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14916: my ($tmp) = keys(%userenv);
14917: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14918: } else {
14919: undef(%userenv);
14920: }
14921: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14922: $form->{'interface'}=$userenv{'interface'};
14923: }
14924: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14925:
14926: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14927: foreach my $option ('interface','localpath','localres') {
14928: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14929: }
14930: # --------------------------------------------------------- Write first profile
14931:
14932: {
14933: my %initial_env =
14934: ("user.name" => $username,
14935: "user.domain" => $domain,
14936: "user.home" => $authhost,
14937: "browser.type" => $clientbrowser,
14938: "browser.version" => $clientversion,
14939: "browser.mathml" => $clientmathml,
14940: "browser.unicode" => $clientunicode,
14941: "browser.os" => $clientos,
1.1075.2.42 raeburn 14942: "browser.mobile" => $clientmobile,
14943: "browser.info" => $clientinfo,
1.1075.2.77 raeburn 14944: "browser.osversion" => $clientosversion,
1.462 albertel 14945: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14946: "request.course.fn" => '',
14947: "request.course.uri" => '',
14948: "request.course.sec" => '',
14949: "request.role" => 'cm',
14950: "request.role.adv" => $env{'user.adv'},
14951: "request.host" => $ENV{'REMOTE_ADDR'},);
14952:
14953: if ($form->{'localpath'}) {
14954: $initial_env{"browser.localpath"} = $form->{'localpath'};
14955: $initial_env{"browser.localres"} = $form->{'localres'};
14956: }
14957:
14958: if ($form->{'interface'}) {
14959: $form->{'interface'}=~s/\W//gs;
14960: $initial_env{"browser.interface"} = $form->{'interface'};
14961: $env{'browser.interface'}=$form->{'interface'};
14962: }
14963:
1.1075.2.54 raeburn 14964: if ($form->{'iptoken'}) {
14965: my $lonhost = $r->dir_config('lonHostID');
14966: $initial_env{"user.noloadbalance"} = $lonhost;
14967: $env{'user.noloadbalance'} = $lonhost;
14968: }
14969:
1.981 raeburn 14970: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14971: my %domdef;
14972: unless ($domain eq 'public') {
14973: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14974: }
1.980 raeburn 14975:
1.1075.2.7 raeburn 14976: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14977: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14978: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14979: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14980: }
14981:
1.1075.2.59 raeburn 14982: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14983: $userenv{'canrequest.'.$crstype} =
14984: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14985: 'reload','requestcourses',
14986: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14987: }
14988:
1.1075.2.14 raeburn 14989: $userenv{'canrequest.author'} =
14990: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14991: 'reload','requestauthor',
14992: \%userenv,\%domdef,\%is_adv);
14993: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14994: $domain,$username);
14995: my $reqstatus = $reqauthor{'author_status'};
14996: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14997: if (ref($reqauthor{'author'}) eq 'HASH') {
14998: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14999: $reqauthor{'author'}{'timestamp'};
15000: }
15001: }
15002:
1.462 albertel 15003: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 15004:
1.462 albertel 15005: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
15006: &GDBM_WRCREAT(),0640)) {
15007: &_add_to_env(\%disk_env,\%initial_env);
15008: &_add_to_env(\%disk_env,\%userenv,'environment.');
15009: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 15010: if (ref($firstaccenv) eq 'HASH') {
15011: &_add_to_env(\%disk_env,$firstaccenv);
15012: }
15013: if (ref($timerintenv) eq 'HASH') {
15014: &_add_to_env(\%disk_env,$timerintenv);
15015: }
1.463 albertel 15016: if (ref($args->{'extra_env'})) {
15017: &_add_to_env(\%disk_env,$args->{'extra_env'});
15018: }
1.462 albertel 15019: untie(%disk_env);
15020: } else {
1.705 tempelho 15021: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
15022: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 15023: return 'error: '.$!;
15024: }
15025: }
15026: $env{'request.role'}='cm';
15027: $env{'request.role.adv'}=$env{'user.adv'};
15028: $env{'browser.type'}=$clientbrowser;
15029:
15030: return $cookie;
15031:
15032: }
15033:
15034: sub _add_to_env {
15035: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 15036: if (ref($env_data) eq 'HASH') {
15037: while (my ($key,$value) = each(%$env_data)) {
15038: $idf->{$prefix.$key} = $value;
15039: $env{$prefix.$key} = $value;
15040: }
1.462 albertel 15041: }
15042: }
15043:
1.685 tempelho 15044: # --- Get the symbolic name of a problem and the url
15045: sub get_symb {
15046: my ($request,$silent) = @_;
1.726 raeburn 15047: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 15048: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
15049: if ($symb eq '') {
15050: if (!$silent) {
1.1071 raeburn 15051: if (ref($request)) {
15052: $request->print("Unable to handle ambiguous references:$url:.");
15053: }
1.685 tempelho 15054: return ();
15055: }
15056: }
15057: &Apache::lonenc::check_decrypt(\$symb);
15058: return ($symb);
15059: }
15060:
15061: # --------------------------------------------------------------Get annotation
15062:
15063: sub get_annotation {
15064: my ($symb,$enc) = @_;
15065:
15066: my $key = $symb;
15067: if (!$enc) {
15068: $key =
15069: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
15070: }
15071: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
15072: return $annotation{$key};
15073: }
15074:
15075: sub clean_symb {
1.731 raeburn 15076: my ($symb,$delete_enc) = @_;
1.685 tempelho 15077:
15078: &Apache::lonenc::check_decrypt(\$symb);
15079: my $enc = $env{'request.enc'};
1.731 raeburn 15080: if ($delete_enc) {
1.730 raeburn 15081: delete($env{'request.enc'});
15082: }
1.685 tempelho 15083:
15084: return ($symb,$enc);
15085: }
1.462 albertel 15086:
1.1075.2.69 raeburn 15087: ############################################################
15088: ############################################################
15089:
15090: =pod
15091:
15092: =head1 Routines for building display used to search for courses
15093:
15094:
15095: =over 4
15096:
15097: =item * &build_filters()
15098:
15099: Create markup for a table used to set filters to use when selecting
15100: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
15101: and quotacheck.pl
15102:
15103:
15104: Inputs:
15105:
15106: filterlist - anonymous array of fields to include as potential filters
15107:
15108: crstype - course type
15109:
15110: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
15111: to pop-open a course selector (will contain "extra element").
15112:
15113: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
15114:
15115: filter - anonymous hash of criteria and their values
15116:
15117: action - form action
15118:
15119: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
15120:
15121: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
15122:
15123: cloneruname - username of owner of new course who wants to clone
15124:
15125: clonerudom - domain of owner of new course who wants to clone
15126:
15127: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
15128:
15129: codetitlesref - reference to array of titles of components in institutional codes (official courses)
15130:
15131: codedom - domain
15132:
15133: formname - value of form element named "form".
15134:
15135: fixeddom - domain, if fixed.
15136:
15137: prevphase - value to assign to form element named "phase" when going back to the previous screen
15138:
15139: cnameelement - name of form element in form on opener page which will receive title of selected course
15140:
15141: cnumelement - name of form element in form on opener page which will receive courseID of selected course
15142:
15143: cdomelement - name of form element in form on opener page which will receive domain of selected course
15144:
15145: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
15146:
15147: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
15148:
15149: clonewarning - warning message about missing information for intended course owner when DC creates a course
15150:
15151:
15152: Returns: $output - HTML for display of search criteria, and hidden form elements.
15153:
15154:
15155: Side Effects: None
15156:
15157: =cut
15158:
15159: # ---------------------------------------------- search for courses based on last activity etc.
15160:
15161: sub build_filters {
15162: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
15163: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
15164: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
15165: $cnameelement,$cnumelement,$cdomelement,$setroles,
15166: $clonetext,$clonewarning) = @_;
15167: my ($list,$jscript);
15168: my $onchange = 'javascript:updateFilters(this)';
15169: my ($domainselectform,$sincefilterform,$createdfilterform,
15170: $ownerdomselectform,$persondomselectform,$instcodeform,
15171: $typeselectform,$instcodetitle);
15172: if ($formname eq '') {
15173: $formname = $caller;
15174: }
15175: foreach my $item (@{$filterlist}) {
15176: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
15177: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
15178: if ($item eq 'domainfilter') {
15179: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
15180: } elsif ($item eq 'coursefilter') {
15181: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
15182: } elsif ($item eq 'ownerfilter') {
15183: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15184: } elsif ($item eq 'ownerdomfilter') {
15185: $filter->{'ownerdomfilter'} =
15186: &LONCAPA::clean_domain($filter->{$item});
15187: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
15188: 'ownerdomfilter',1);
15189: } elsif ($item eq 'personfilter') {
15190: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
15191: } elsif ($item eq 'persondomfilter') {
15192: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
15193: 'persondomfilter',1);
15194: } else {
15195: $filter->{$item} =~ s/\W//g;
15196: }
15197: if (!$filter->{$item}) {
15198: $filter->{$item} = '';
15199: }
15200: }
15201: if ($item eq 'domainfilter') {
15202: my $allow_blank = 1;
15203: if ($formname eq 'portform') {
15204: $allow_blank=0;
15205: } elsif ($formname eq 'studentform') {
15206: $allow_blank=0;
15207: }
15208: if ($fixeddom) {
15209: $domainselectform = '<input type="hidden" name="domainfilter"'.
15210: ' value="'.$codedom.'" />'.
15211: &Apache::lonnet::domain($codedom,'description');
15212: } else {
15213: $domainselectform = &select_dom_form($filter->{$item},
15214: 'domainfilter',
15215: $allow_blank,'',$onchange);
15216: }
15217: } else {
15218: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
15219: }
15220: }
15221:
15222: # last course activity filter and selection
15223: $sincefilterform = &timebased_select_form('sincefilter',$filter);
15224:
15225: # course created filter and selection
15226: if (exists($filter->{'createdfilter'})) {
15227: $createdfilterform = &timebased_select_form('createdfilter',$filter);
15228: }
15229:
15230: my %lt = &Apache::lonlocal::texthash(
15231: 'cac' => "$crstype Activity",
15232: 'ccr' => "$crstype Created",
15233: 'cde' => "$crstype Title",
15234: 'cdo' => "$crstype Domain",
15235: 'ins' => 'Institutional Code',
15236: 'inc' => 'Institutional Categorization',
15237: 'cow' => "$crstype Owner/Co-owner",
15238: 'cop' => "$crstype Personnel Includes",
15239: 'cog' => 'Type',
15240: );
15241:
15242: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15243: my $typeval = 'Course';
15244: if ($crstype eq 'Community') {
15245: $typeval = 'Community';
15246: }
15247: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
15248: } else {
15249: $typeselectform = '<select name="type" size="1"';
15250: if ($onchange) {
15251: $typeselectform .= ' onchange="'.$onchange.'"';
15252: }
15253: $typeselectform .= '>'."\n";
15254: foreach my $posstype ('Course','Community') {
15255: $typeselectform.='<option value="'.$posstype.'"'.
15256: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
15257: }
15258: $typeselectform.="</select>";
15259: }
15260:
15261: my ($cloneableonlyform,$cloneabletitle);
15262: if (exists($filter->{'cloneableonly'})) {
15263: my $cloneableon = '';
15264: my $cloneableoff = ' checked="checked"';
15265: if ($filter->{'cloneableonly'}) {
15266: $cloneableon = $cloneableoff;
15267: $cloneableoff = '';
15268: }
15269: $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>';
15270: if ($formname eq 'ccrs') {
1.1075.2.71 raeburn 15271: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1075.2.69 raeburn 15272: } else {
15273: $cloneabletitle = &mt('Cloneable by you');
15274: }
15275: }
15276: my $officialjs;
15277: if ($crstype eq 'Course') {
15278: if (exists($filter->{'instcodefilter'})) {
15279: # if (($fixeddom) || ($formname eq 'requestcrs') ||
15280: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
15281: if ($codedom) {
15282: $officialjs = 1;
15283: ($instcodeform,$jscript,$$numtitlesref) =
15284: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
15285: $officialjs,$codetitlesref);
15286: if ($jscript) {
15287: $jscript = '<script type="text/javascript">'."\n".
15288: '// <![CDATA['."\n".
15289: $jscript."\n".
15290: '// ]]>'."\n".
15291: '</script>'."\n";
15292: }
15293: }
15294: if ($instcodeform eq '') {
15295: $instcodeform =
15296: '<input type="text" name="instcodefilter" size="10" value="'.
15297: $list->{'instcodefilter'}.'" />';
15298: $instcodetitle = $lt{'ins'};
15299: } else {
15300: $instcodetitle = $lt{'inc'};
15301: }
15302: if ($fixeddom) {
15303: $instcodetitle .= '<br />('.$codedom.')';
15304: }
15305: }
15306: }
15307: my $output = qq|
15308: <form method="post" name="filterpicker" action="$action">
15309: <input type="hidden" name="form" value="$formname" />
15310: |;
15311: if ($formname eq 'modifycourse') {
15312: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15313: '<input type="hidden" name="prevphase" value="'.
15314: $prevphase.'" />'."\n";
1.1075.2.82 raeburn 15315: } elsif ($formname eq 'quotacheck') {
15316: $output .= qq|
15317: <input type="hidden" name="sortby" value="" />
15318: <input type="hidden" name="sortorder" value="" />
15319: |;
15320: } else {
1.1075.2.69 raeburn 15321: my $name_input;
15322: if ($cnameelement ne '') {
15323: $name_input = '<input type="hidden" name="cnameelement" value="'.
15324: $cnameelement.'" />';
15325: }
15326: $output .= qq|
15327: <input type="hidden" name="cnumelement" value="$cnumelement" />
15328: <input type="hidden" name="cdomelement" value="$cdomelement" />
15329: $name_input
15330: $roleelement
15331: $multelement
15332: $typeelement
15333: |;
15334: if ($formname eq 'portform') {
15335: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15336: }
15337: }
15338: if ($fixeddom) {
15339: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15340: }
15341: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15342: if ($sincefilterform) {
15343: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15344: .$sincefilterform
15345: .&Apache::lonhtmlcommon::row_closure();
15346: }
15347: if ($createdfilterform) {
15348: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15349: .$createdfilterform
15350: .&Apache::lonhtmlcommon::row_closure();
15351: }
15352: if ($domainselectform) {
15353: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15354: .$domainselectform
15355: .&Apache::lonhtmlcommon::row_closure();
15356: }
15357: if ($typeselectform) {
15358: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15359: $output .= $typeselectform;
15360: } else {
15361: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15362: .$typeselectform
15363: .&Apache::lonhtmlcommon::row_closure();
15364: }
15365: }
15366: if ($instcodeform) {
15367: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15368: .$instcodeform
15369: .&Apache::lonhtmlcommon::row_closure();
15370: }
15371: if (exists($filter->{'ownerfilter'})) {
15372: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15373: '<table><tr><td>'.&mt('Username').'<br />'.
15374: '<input type="text" name="ownerfilter" size="20" value="'.
15375: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15376: $ownerdomselectform.'</td></tr></table>'.
15377: &Apache::lonhtmlcommon::row_closure();
15378: }
15379: if (exists($filter->{'personfilter'})) {
15380: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15381: '<table><tr><td>'.&mt('Username').'<br />'.
15382: '<input type="text" name="personfilter" size="20" value="'.
15383: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15384: $persondomselectform.'</td></tr></table>'.
15385: &Apache::lonhtmlcommon::row_closure();
15386: }
15387: if (exists($filter->{'coursefilter'})) {
15388: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15389: .'<input type="text" name="coursefilter" size="25" value="'
15390: .$list->{'coursefilter'}.'" />'
15391: .&Apache::lonhtmlcommon::row_closure();
15392: }
15393: if ($cloneableonlyform) {
15394: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15395: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15396: }
15397: if (exists($filter->{'descriptfilter'})) {
15398: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15399: .'<input type="text" name="descriptfilter" size="40" value="'
15400: .$list->{'descriptfilter'}.'" />'
15401: .&Apache::lonhtmlcommon::row_closure(1);
15402: }
15403: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15404: '<input type="hidden" name="updater" value="" />'."\n".
15405: '<input type="submit" name="gosearch" value="'.
15406: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15407: return $jscript.$clonewarning.$output;
15408: }
15409:
15410: =pod
15411:
15412: =item * &timebased_select_form()
15413:
15414: Create markup for a dropdown list used to select a time-based
15415: filter e.g., Course Activity, Course Created, when searching for courses
15416: or communities
15417:
15418: Inputs:
15419:
15420: item - name of form element (sincefilter or createdfilter)
15421:
15422: filter - anonymous hash of criteria and their values
15423:
15424: Returns: HTML for a select box contained a blank, then six time selections,
15425: with value set in incoming form variables currently selected.
15426:
15427: Side Effects: None
15428:
15429: =cut
15430:
15431: sub timebased_select_form {
15432: my ($item,$filter) = @_;
15433: if (ref($filter) eq 'HASH') {
15434: $filter->{$item} =~ s/[^\d-]//g;
15435: if (!$filter->{$item}) { $filter->{$item}=-1; }
15436: return &select_form(
15437: $filter->{$item},
15438: $item,
15439: { '-1' => '',
15440: '86400' => &mt('today'),
15441: '604800' => &mt('last week'),
15442: '2592000' => &mt('last month'),
15443: '7776000' => &mt('last three months'),
15444: '15552000' => &mt('last six months'),
15445: '31104000' => &mt('last year'),
15446: 'select_form_order' =>
15447: ['-1','86400','604800','2592000','7776000',
15448: '15552000','31104000']});
15449: }
15450: }
15451:
15452: =pod
15453:
15454: =item * &js_changer()
15455:
15456: Create script tag containing Javascript used to submit course search form
15457: when course type or domain is changed, and also to hide 'Searching ...' on
15458: page load completion for page showing search result.
15459:
15460: Inputs: None
15461:
15462: Returns: markup containing updateFilters() and hideSearching() javascript functions.
15463:
15464: Side Effects: None
15465:
15466: =cut
15467:
15468: sub js_changer {
15469: return <<ENDJS;
15470: <script type="text/javascript">
15471: // <![CDATA[
15472: function updateFilters(caller) {
15473: if (typeof(caller) != "undefined") {
15474: document.filterpicker.updater.value = caller.name;
15475: }
15476: document.filterpicker.submit();
15477: }
15478:
15479: function hideSearching() {
15480: if (document.getElementById('searching')) {
15481: document.getElementById('searching').style.display = 'none';
15482: }
15483: return;
15484: }
15485:
15486: // ]]>
15487: </script>
15488:
15489: ENDJS
15490: }
15491:
15492: =pod
15493:
15494: =item * &search_courses()
15495:
15496: Process selected filters form course search form and pass to lonnet::courseiddump
15497: to retrieve a hash for which keys are courseIDs which match the selected filters.
15498:
15499: Inputs:
15500:
15501: dom - domain being searched
15502:
15503: type - course type ('Course' or 'Community' or '.' if any).
15504:
15505: filter - anonymous hash of criteria and their values
15506:
15507: numtitles - for institutional codes - number of categories
15508:
15509: cloneruname - optional username of new course owner
15510:
15511: clonerudom - optional domain of new course owner
15512:
1.1075.2.95 raeburn 15513: domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
1.1075.2.69 raeburn 15514: (used when DC is using course creation form)
15515:
15516: codetitles - reference to array of titles of components in institutional codes (official courses).
15517:
1.1075.2.95 raeburn 15518: cc_clone - escaped comma separated list of courses for which course cloner has active CC role
15519: (and so can clone automatically)
15520:
15521: reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone
15522:
15523: reqinstcode - institutional code of new course, where search_courses is used to identify potential
15524: courses to clone
1.1075.2.69 raeburn 15525:
15526: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15527:
15528:
15529: Side Effects: None
15530:
15531: =cut
15532:
15533:
15534: sub search_courses {
1.1075.2.95 raeburn 15535: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles,
15536: $cc_clone,$reqcrsdom,$reqinstcode) = @_;
1.1075.2.69 raeburn 15537: my (%courses,%showcourses,$cloner);
15538: if (($filter->{'ownerfilter'} ne '') ||
15539: ($filter->{'ownerdomfilter'} ne '')) {
15540: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15541: $filter->{'ownerdomfilter'};
15542: }
15543: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15544: if (!$filter->{$item}) {
15545: $filter->{$item}='.';
15546: }
15547: }
15548: my $now = time;
15549: my $timefilter =
15550: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15551: my ($createdbefore,$createdafter);
15552: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15553: $createdbefore = $now;
15554: $createdafter = $now-$filter->{'createdfilter'};
15555: }
15556: my ($instcodefilter,$regexpok);
15557: if ($numtitles) {
15558: if ($env{'form.official'} eq 'on') {
15559: $instcodefilter =
15560: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15561: $regexpok = 1;
15562: } elsif ($env{'form.official'} eq 'off') {
15563: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15564: unless ($instcodefilter eq '') {
15565: $regexpok = -1;
15566: }
15567: }
15568: } else {
15569: $instcodefilter = $filter->{'instcodefilter'};
15570: }
15571: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15572: if ($type eq '') { $type = '.'; }
15573:
15574: if (($clonerudom ne '') && ($cloneruname ne '')) {
15575: $cloner = $cloneruname.':'.$clonerudom;
15576: }
15577: %courses = &Apache::lonnet::courseiddump($dom,
15578: $filter->{'descriptfilter'},
15579: $timefilter,
15580: $instcodefilter,
15581: $filter->{'combownerfilter'},
15582: $filter->{'coursefilter'},
15583: undef,undef,$type,$regexpok,undef,undef,
1.1075.2.95 raeburn 15584: undef,undef,$cloner,$cc_clone,
1.1075.2.69 raeburn 15585: $filter->{'cloneableonly'},
15586: $createdbefore,$createdafter,undef,
1.1075.2.95 raeburn 15587: $domcloner,undef,$reqcrsdom,$reqinstcode);
1.1075.2.69 raeburn 15588: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15589: my $ccrole;
15590: if ($type eq 'Community') {
15591: $ccrole = 'co';
15592: } else {
15593: $ccrole = 'cc';
15594: }
15595: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15596: $filter->{'persondomfilter'},
15597: 'userroles',undef,
15598: [$ccrole,'in','ad','ep','ta','cr'],
15599: $dom);
15600: foreach my $role (keys(%rolehash)) {
15601: my ($cnum,$cdom,$courserole) = split(':',$role);
15602: my $cid = $cdom.'_'.$cnum;
15603: if (exists($courses{$cid})) {
15604: if (ref($courses{$cid}) eq 'HASH') {
15605: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15606: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15607: push (@{$courses{$cid}{roles}},$courserole);
15608: }
15609: } else {
15610: $courses{$cid}{roles} = [$courserole];
15611: }
15612: $showcourses{$cid} = $courses{$cid};
15613: }
15614: }
15615: }
15616: %courses = %showcourses;
15617: }
15618: return %courses;
15619: }
15620:
15621: =pod
15622:
15623: =back
15624:
1.1075.2.88 raeburn 15625: =head1 Routines for version requirements for current course.
15626:
15627: =over 4
15628:
15629: =item * &check_release_required()
15630:
15631: Compares required LON-CAPA version with version on server, and
15632: if required version is newer looks for a server with the required version.
15633:
15634: Looks first at servers in user's owen domain; if none suitable, looks at
15635: servers in course's domain are permitted to host sessions for user's domain.
15636:
15637: Inputs:
15638:
15639: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15640:
15641: $courseid - Course ID of current course
15642:
15643: $rolecode - User's current role in course (for switchserver query string).
15644:
15645: $required - LON-CAPA version needed by course (format: Major.Minor).
15646:
15647:
15648: Returns:
15649:
15650: $switchserver - query string tp append to /adm/switchserver call (if
15651: current server's LON-CAPA version is too old.
15652:
15653: $warning - Message is displayed if no suitable server could be found.
15654:
15655: =cut
15656:
15657: sub check_release_required {
15658: my ($loncaparev,$courseid,$rolecode,$required) = @_;
15659: my ($switchserver,$warning);
15660: if ($required ne '') {
15661: my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
15662: my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15663: if ($reqdmajor ne '' && $reqdminor ne '') {
15664: my $otherserver;
15665: if (($major eq '' && $minor eq '') ||
15666: (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
15667: my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required,1);
15668: my $switchlcrev =
15669: &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
15670: $userdomserver);
15671: my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
15672: if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
15673: (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
15674: my $cdom = $env{'course.'.$courseid.'.domain'};
15675: if ($cdom ne $env{'user.domain'}) {
15676: my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom,undef,$required,1);
15677: my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
15678: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
15679: my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
15680: my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
15681: my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
15682: my $canhost =
15683: &Apache::lonnet::can_host_session($env{'user.domain'},
15684: $coursedomserver,
15685: $remoterev,
15686: $udomdefaults{'remotesessions'},
15687: $defdomdefaults{'hostedsessions'});
15688:
15689: if ($canhost) {
15690: $otherserver = $coursedomserver;
15691: } else {
15692: $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.");
15693: }
15694: } else {
15695: $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).");
15696: }
15697: } else {
15698: $otherserver = $userdomserver;
15699: }
15700: }
15701: if ($otherserver ne '') {
15702: $switchserver = 'otherserver='.$otherserver.'&role='.$rolecode;
15703: }
15704: }
15705: }
15706: return ($switchserver,$warning);
15707: }
15708:
15709: =pod
15710:
15711: =item * &check_release_result()
15712:
15713: Inputs:
15714:
15715: $switchwarning - Warning message if no suitable server found to host session.
15716:
15717: $switchserver - query string to append to /adm/switchserver containing lonHostID
15718: and current role.
15719:
15720: Returns: HTML to display with information about requirement to switch server.
15721: Either displaying warning with link to Roles/Courses screen or
15722: display link to switchserver.
15723:
1.1075.2.69 raeburn 15724: =cut
15725:
1.1075.2.88 raeburn 15726: sub check_release_result {
15727: my ($switchwarning,$switchserver) = @_;
15728: my $output = &start_page('Selected course unavailable on this server').
15729: '<p class="LC_warning">';
15730: if ($switchwarning) {
15731: $output .= $switchwarning.'<br /><a href="/adm/roles">';
15732: if (&show_course()) {
15733: $output .= &mt('Display courses');
15734: } else {
15735: $output .= &mt('Display roles');
15736: }
15737: $output .= '</a>';
15738: } elsif ($switchserver) {
15739: $output .= &mt('This course requires a newer version of LON-CAPA than is installed on this server.').
15740: '<br />'.
15741: '<a href="/adm/switchserver?'.$switchserver.'">'.
15742: &mt('Switch Server').
15743: '</a>';
15744: }
15745: $output .= '</p>'.&end_page();
15746: return $output;
15747: }
15748:
15749: =pod
15750:
15751: =item * &needs_coursereinit()
15752:
15753: Determine if course contents stored for user's session needs to be
15754: refreshed, because content has changed since "Big Hash" last tied.
15755:
15756: Check for change is made if time last checked is more than 10 minutes ago
15757: (by default).
15758:
15759: Inputs:
15760:
15761: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp)
15762:
15763: $interval (optional) - Time which may elapse (in s) between last check for content
15764: change in current course. (default: 600 s).
15765:
15766: Returns: an array; first element is:
15767:
15768: =over 4
15769:
15770: 'switch' - if content updates mean user's session
15771: needs to be switched to a server running a newer LON-CAPA version
15772:
15773: 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded)
15774: on current server hosting user's session
15775:
15776: '' - if no action required.
15777:
15778: =back
15779:
15780: If first item element is 'switch':
15781:
15782: second item is $switchwarning - Warning message if no suitable server found to host session.
15783:
15784: third item is $switchserver - query string to append to /adm/switchserver containing lonHostID
15785: and current role.
15786:
15787: otherwise: no other elements returned.
15788:
15789: =back
15790:
15791: =cut
15792:
15793: sub needs_coursereinit {
15794: my ($loncaparev,$interval) = @_;
15795: return() unless ($env{'request.course.id'} && $env{'request.course.tied'});
15796: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
15797: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
15798: my $now = time;
15799: if ($interval eq '') {
15800: $interval = 600;
15801: }
15802: if (($now-$env{'request.course.timechecked'})>$interval) {
15803: my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
15804: &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
15805: if ($lastchange > $env{'request.course.tied'}) {
15806: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15807: if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
15808: my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
15809: if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
15810: &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
15811: $curr_reqd_hash{'internal.releaserequired'}});
15812: my ($switchserver,$switchwarning) =
15813: &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
15814: $curr_reqd_hash{'internal.releaserequired'});
15815: if ($switchwarning ne '' || $switchserver ne '') {
15816: return ('switch',$switchwarning,$switchserver);
15817: }
15818: }
15819: }
15820: return ('update');
15821: }
15822: }
15823: return ();
15824: }
1.1075.2.69 raeburn 15825:
1.1075.2.11 raeburn 15826: sub update_content_constraints {
15827: my ($cdom,$cnum,$chome,$cid) = @_;
15828: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15829: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15830: my %checkresponsetypes;
15831: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15832: my ($item,$name,$value) = split(/:/,$key);
15833: if ($item eq 'resourcetag') {
15834: if ($name eq 'responsetype') {
15835: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15836: }
15837: }
15838: }
15839: my $navmap = Apache::lonnavmaps::navmap->new();
15840: if (defined($navmap)) {
15841: my %allresponses;
15842: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15843: my %responses = $res->responseTypes();
15844: foreach my $key (keys(%responses)) {
15845: next unless(exists($checkresponsetypes{$key}));
15846: $allresponses{$key} += $responses{$key};
15847: }
15848: }
15849: foreach my $key (keys(%allresponses)) {
15850: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15851: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15852: ($reqdmajor,$reqdminor) = ($major,$minor);
15853: }
15854: }
15855: undef($navmap);
15856: }
15857: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15858: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15859: }
15860: return;
15861: }
15862:
1.1075.2.27 raeburn 15863: sub allmaps_incourse {
15864: my ($cdom,$cnum,$chome,$cid) = @_;
15865: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15866: $cid = $env{'request.course.id'};
15867: $cdom = $env{'course.'.$cid.'.domain'};
15868: $cnum = $env{'course.'.$cid.'.num'};
15869: $chome = $env{'course.'.$cid.'.home'};
15870: }
15871: my %allmaps = ();
15872: my $lastchange =
15873: &Apache::lonnet::get_coursechange($cdom,$cnum);
15874: if ($lastchange > $env{'request.course.tied'}) {
15875: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15876: unless ($ferr) {
15877: &update_content_constraints($cdom,$cnum,$chome,$cid);
15878: }
15879: }
15880: my $navmap = Apache::lonnavmaps::navmap->new();
15881: if (defined($navmap)) {
15882: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15883: $allmaps{$res->src()} = 1;
15884: }
15885: }
15886: return \%allmaps;
15887: }
15888:
1.1075.2.11 raeburn 15889: sub parse_supplemental_title {
15890: my ($title) = @_;
15891:
15892: my ($foldertitle,$renametitle);
15893: if ($title =~ /&&&/) {
15894: $title = &HTML::Entites::decode($title);
15895: }
15896: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15897: $renametitle=$4;
15898: my ($time,$uname,$udom) = ($1,$2,$3);
15899: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15900: my $name = &plainname($uname,$udom);
15901: $name = &HTML::Entities::encode($name,'"<>&\'');
15902: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15903: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15904: $name.': <br />'.$foldertitle;
15905: }
15906: if (wantarray) {
15907: return ($title,$foldertitle,$renametitle);
15908: }
15909: return $title;
15910: }
15911:
1.1075.2.43 raeburn 15912: sub recurse_supplemental {
15913: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15914: if ($suppmap) {
15915: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15916: if ($fatal) {
15917: $errors ++;
15918: } else {
15919: if ($#LONCAPA::map::resources > 0) {
15920: foreach my $res (@LONCAPA::map::resources) {
15921: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15922: if (($src ne '') && ($status eq 'res')) {
1.1075.2.46 raeburn 15923: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15924: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1075.2.43 raeburn 15925: } else {
15926: $numfiles ++;
15927: }
15928: }
15929: }
15930: }
15931: }
15932: }
15933: return ($numfiles,$errors);
15934: }
15935:
1.1075.2.18 raeburn 15936: sub symb_to_docspath {
15937: my ($symb) = @_;
15938: return unless ($symb);
15939: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15940: if ($resurl=~/\.(sequence|page)$/) {
15941: $mapurl=$resurl;
15942: } elsif ($resurl eq 'adm/navmaps') {
15943: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15944: }
15945: my $mapresobj;
15946: my $navmap = Apache::lonnavmaps::navmap->new();
15947: if (ref($navmap)) {
15948: $mapresobj = $navmap->getResourceByUrl($mapurl);
15949: }
15950: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15951: my $type=$2;
15952: my $path;
15953: if (ref($mapresobj)) {
15954: my $pcslist = $mapresobj->map_hierarchy();
15955: if ($pcslist ne '') {
15956: foreach my $pc (split(/,/,$pcslist)) {
15957: next if ($pc <= 1);
15958: my $res = $navmap->getByMapPc($pc);
15959: if (ref($res)) {
15960: my $thisurl = $res->src();
15961: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15962: my $thistitle = $res->title();
15963: $path .= '&'.
15964: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1075.2.46 raeburn 15965: &escape($thistitle).
1.1075.2.18 raeburn 15966: ':'.$res->randompick().
15967: ':'.$res->randomout().
15968: ':'.$res->encrypted().
15969: ':'.$res->randomorder().
15970: ':'.$res->is_page();
15971: }
15972: }
15973: }
15974: $path =~ s/^\&//;
15975: my $maptitle = $mapresobj->title();
15976: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15977: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15978: }
15979: $path .= (($path ne '')? '&' : '').
15980: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15981: &escape($maptitle).
1.1075.2.18 raeburn 15982: ':'.$mapresobj->randompick().
15983: ':'.$mapresobj->randomout().
15984: ':'.$mapresobj->encrypted().
15985: ':'.$mapresobj->randomorder().
15986: ':'.$mapresobj->is_page();
15987: } else {
15988: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15989: my $ispage = (($type eq 'page')? 1 : '');
15990: if ($mapurl eq 'default') {
1.1075.2.38 raeburn 15991: $maptitle = 'Main Content';
1.1075.2.18 raeburn 15992: }
15993: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1075.2.46 raeburn 15994: &escape($maptitle).':::::'.$ispage;
1.1075.2.18 raeburn 15995: }
15996: unless ($mapurl eq 'default') {
15997: $path = 'default&'.
1.1075.2.46 raeburn 15998: &escape('Main Content').
1.1075.2.18 raeburn 15999: ':::::&'.$path;
16000: }
16001: return $path;
16002: }
16003:
1.1075.2.14 raeburn 16004: sub captcha_display {
16005: my ($context,$lonhost) = @_;
16006: my ($output,$error);
16007: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
16008: if ($captcha eq 'original') {
16009: $output = &create_captcha();
16010: unless ($output) {
16011: $error = 'captcha';
16012: }
16013: } elsif ($captcha eq 'recaptcha') {
16014: $output = &create_recaptcha($pubkey);
16015: unless ($output) {
16016: $error = 'recaptcha';
16017: }
16018: }
1.1075.2.66 raeburn 16019: return ($output,$error,$captcha);
1.1075.2.14 raeburn 16020: }
16021:
16022: sub captcha_response {
16023: my ($context,$lonhost) = @_;
16024: my ($captcha_chk,$captcha_error);
16025: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
16026: if ($captcha eq 'original') {
16027: ($captcha_chk,$captcha_error) = &check_captcha();
16028: } elsif ($captcha eq 'recaptcha') {
16029: $captcha_chk = &check_recaptcha($privkey);
16030: } else {
16031: $captcha_chk = 1;
16032: }
16033: return ($captcha_chk,$captcha_error);
16034: }
16035:
16036: sub get_captcha_config {
16037: my ($context,$lonhost) = @_;
16038: my ($captcha,$pubkey,$privkey,$hashtocheck);
16039: my $hostname = &Apache::lonnet::hostname($lonhost);
16040: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
16041: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
16042: if ($context eq 'usercreation') {
16043: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
16044: if (ref($domconfig{$context}) eq 'HASH') {
16045: $hashtocheck = $domconfig{$context}{'cancreate'};
16046: if (ref($hashtocheck) eq 'HASH') {
16047: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
16048: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
16049: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
16050: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
16051: }
16052: if ($privkey && $pubkey) {
16053: $captcha = 'recaptcha';
16054: } else {
16055: $captcha = 'original';
16056: }
16057: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
16058: $captcha = 'original';
16059: }
16060: }
16061: } else {
16062: $captcha = 'captcha';
16063: }
16064: } elsif ($context eq 'login') {
16065: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
16066: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
16067: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
16068: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
16069: if ($privkey && $pubkey) {
16070: $captcha = 'recaptcha';
16071: } else {
16072: $captcha = 'original';
16073: }
16074: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
16075: $captcha = 'original';
16076: }
16077: }
16078: return ($captcha,$pubkey,$privkey);
16079: }
16080:
16081: sub create_captcha {
16082: my %captcha_params = &captcha_settings();
16083: my ($output,$maxtries,$tries) = ('',10,0);
16084: while ($tries < $maxtries) {
16085: $tries ++;
16086: my $captcha = Authen::Captcha->new (
16087: output_folder => $captcha_params{'output_dir'},
16088: data_folder => $captcha_params{'db_dir'},
16089: );
16090: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
16091:
16092: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
16093: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
16094: &mt('Type in the letters/numbers shown below').' '.
1.1075.2.66 raeburn 16095: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
16096: '<br />'.
16097: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1075.2.14 raeburn 16098: last;
16099: }
16100: }
16101: return $output;
16102: }
16103:
16104: sub captcha_settings {
16105: my %captcha_params = (
16106: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
16107: www_output_dir => "/captchaspool",
16108: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
16109: numchars => '5',
16110: );
16111: return %captcha_params;
16112: }
16113:
16114: sub check_captcha {
16115: my ($captcha_chk,$captcha_error);
16116: my $code = $env{'form.code'};
16117: my $md5sum = $env{'form.crypt'};
16118: my %captcha_params = &captcha_settings();
16119: my $captcha = Authen::Captcha->new(
16120: output_folder => $captcha_params{'output_dir'},
16121: data_folder => $captcha_params{'db_dir'},
16122: );
1.1075.2.26 raeburn 16123: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1075.2.14 raeburn 16124: my %captcha_hash = (
16125: 0 => 'Code not checked (file error)',
16126: -1 => 'Failed: code expired',
16127: -2 => 'Failed: invalid code (not in database)',
16128: -3 => 'Failed: invalid code (code does not match crypt)',
16129: );
16130: if ($captcha_chk != 1) {
16131: $captcha_error = $captcha_hash{$captcha_chk}
16132: }
16133: return ($captcha_chk,$captcha_error);
16134: }
16135:
16136: sub create_recaptcha {
16137: my ($pubkey) = @_;
1.1075.2.51 raeburn 16138: my $use_ssl;
16139: if ($ENV{'SERVER_PORT'} == 443) {
16140: $use_ssl = 1;
16141: }
1.1075.2.14 raeburn 16142: my $captcha = Captcha::reCAPTCHA->new;
16143: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1075.2.51 raeburn 16144: $captcha->get_html($pubkey,undef,$use_ssl).
1.1075.2.92 raeburn 16145: &mt('If the text is hard to read, [_1] will replace them.',
1.1075.2.39 raeburn 16146: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1075.2.14 raeburn 16147: '<br /><br />';
16148: }
16149:
16150: sub check_recaptcha {
16151: my ($privkey) = @_;
16152: my $captcha_chk;
16153: my $captcha = Captcha::reCAPTCHA->new;
16154: my $captcha_result =
16155: $captcha->check_answer(
16156: $privkey,
16157: $ENV{'REMOTE_ADDR'},
16158: $env{'form.recaptcha_challenge_field'},
16159: $env{'form.recaptcha_response_field'},
16160: );
16161: if ($captcha_result->{is_valid}) {
16162: $captcha_chk = 1;
16163: }
16164: return $captcha_chk;
16165: }
16166:
1.1075.2.64 raeburn 16167: sub emailusername_info {
1.1075.2.67 raeburn 16168: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1075.2.64 raeburn 16169: my %titles = &Apache::lonlocal::texthash (
16170: lastname => 'Last Name',
16171: firstname => 'First Name',
16172: institution => 'School/college/university',
16173: location => "School's city, state/province, country",
16174: web => "School's web address",
16175: officialemail => 'E-mail address at institution (if different)',
16176: );
16177: return (\@fields,\%titles);
16178: }
16179:
1.1075.2.56 raeburn 16180: sub cleanup_html {
16181: my ($incoming) = @_;
16182: my $outgoing;
16183: if ($incoming ne '') {
16184: $outgoing = $incoming;
16185: $outgoing =~ s/;/;/g;
16186: $outgoing =~ s/\#/#/g;
16187: $outgoing =~ s/\&/&/g;
16188: $outgoing =~ s/</</g;
16189: $outgoing =~ s/>/>/g;
16190: $outgoing =~ s/\(/(/g;
16191: $outgoing =~ s/\)/)/g;
16192: $outgoing =~ s/"/"/g;
16193: $outgoing =~ s/'/'/g;
16194: $outgoing =~ s/\$/$/g;
16195: $outgoing =~ s{/}{/}g;
16196: $outgoing =~ s/=/=/g;
16197: $outgoing =~ s/\\/\/g
16198: }
16199: return $outgoing;
16200: }
16201:
1.1075.2.74 raeburn 16202: # Checks for critical messages and returns a redirect url if one exists.
16203: # $interval indicates how often to check for messages.
16204: sub critical_redirect {
16205: my ($interval) = @_;
16206: if ((time-$env{'user.criticalcheck.time'})>$interval) {
16207: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
16208: $env{'user.name'});
16209: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
16210: my $redirecturl;
16211: if ($what[0]) {
16212: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
16213: $redirecturl='/adm/email?critical=display';
16214: my $url=&Apache::lonnet::absolute_url().$redirecturl;
16215: return (1, $url);
16216: }
16217: }
16218: }
16219: return ();
16220: }
16221:
1.1075.2.64 raeburn 16222: # Use:
16223: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
16224: #
16225: ##################################################
16226: # password associated functions #
16227: ##################################################
16228: sub des_keys {
16229: # Make a new key for DES encryption.
16230: # Each key has two parts which are returned separately.
16231: # Please note: Each key must be passed through the &hex function
16232: # before it is output to the web browser. The hex versions cannot
16233: # be used to decrypt.
16234: my @hexstr=('0','1','2','3','4','5','6','7',
16235: '8','9','a','b','c','d','e','f');
16236: my $lkey='';
16237: for (0..7) {
16238: $lkey.=$hexstr[rand(15)];
16239: }
16240: my $ukey='';
16241: for (0..7) {
16242: $ukey.=$hexstr[rand(15)];
16243: }
16244: return ($lkey,$ukey);
16245: }
16246:
16247: sub des_decrypt {
16248: my ($key,$cyphertext) = @_;
16249: my $keybin=pack("H16",$key);
16250: my $cypher;
16251: if ($Crypt::DES::VERSION>=2.03) {
16252: $cypher=new Crypt::DES $keybin;
16253: } else {
16254: $cypher=new DES $keybin;
16255: }
16256: my $plaintext=
16257: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
16258: $plaintext.=
16259: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
16260: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
16261: return $plaintext;
16262: }
16263:
1.112 bowersj2 16264: 1;
16265: __END__;
1.41 ng 16266:
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