Annotation of loncom/interface/loncommon.pm, revision 1.1199
1.10 albertel 1: # The LearningOnline Network with CAPA
1.1 albertel 2: # a pile of common routines
1.10 albertel 3: #
1.1199 ! raeburn 4: # $Id: loncommon.pm,v 1.1198 2014/07/31 15:57:28 musolffc 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.1108 raeburn 70: use Apache::lonuserutils();
1.1110 raeburn 71: use Apache::lonuserstate();
1.1182 raeburn 72: use Apache::courseclassifier();
1.479 albertel 73: use LONCAPA qw(:DEFAULT :match);
1.657 raeburn 74: use DateTime::TimeZone;
1.687 raeburn 75: use DateTime::Locale::Catalog;
1.1091 foxr 76: use Text::Aspell;
1.1094 raeburn 77: use Authen::Captcha;
78: use Captcha::reCAPTCHA;
1.1174 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.1088 foxr 165: my %supported_codes;
1.1048 foxr 166: my %latex_language; # For choosing hyphenation in <transl..>
167: my %latex_language_bykey; # for choosing hyphenation from metadata
1.12 harris41 168: my %cprtag;
1.192 taceyjo1 169: my %scprtag;
1.351 www 170: my %fe; my %fd; my %fm;
1.41 ng 171: my %category_extensions;
1.12 harris41 172:
1.46 matthew 173: # ---------------------------------------------- Thesaurus variables
1.144 matthew 174: #
175: # %Keywords:
176: # A hash used by &keyword to determine if a word is considered a keyword.
177: # $thesaurus_db_file
178: # Scalar containing the full path to the thesaurus database.
1.46 matthew 179:
180: my %Keywords;
181: my $thesaurus_db_file;
182:
1.144 matthew 183: #
184: # Initialize values from language.tab, copyright.tab, filetypes.tab,
185: # thesaurus.tab, and filecategories.tab.
186: #
1.18 www 187: BEGIN {
1.46 matthew 188: # Variable initialization
189: $thesaurus_db_file = $Apache::lonnet::perlvar{'lonTabDir'}."/thesaurus.db";
190: #
1.22 www 191: unless ($readit) {
1.12 harris41 192: # ------------------------------------------------------------------- languages
193: {
1.158 raeburn 194: my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
195: '/language.tab';
196: if ( open(my $fh,"<$langtabfile") ) {
1.356 albertel 197: while (my $line = <$fh>) {
198: next if ($line=~/^\#/);
199: chomp($line);
1.1088 foxr 200: my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line));
1.158 raeburn 201: $language{$key}=$val.' - '.$enc;
202: if ($sup) {
203: $supported_language{$key}=$sup;
1.1088 foxr 204: $supported_codes{$key} = $code;
1.158 raeburn 205: }
1.1048 foxr 206: if ($latex) {
207: $latex_language_bykey{$key} = $latex;
1.1088 foxr 208: $latex_language{$code} = $latex;
1.1048 foxr 209: }
1.158 raeburn 210: }
211: close($fh);
212: }
1.12 harris41 213: }
214: # ------------------------------------------------------------------ copyrights
215: {
1.158 raeburn 216: my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
217: '/copyright.tab';
218: if ( open (my $fh,"<$copyrightfile") ) {
1.356 albertel 219: while (my $line = <$fh>) {
220: next if ($line=~/^\#/);
221: chomp($line);
222: my ($key,$val)=(split(/\s+/,$line,2));
1.158 raeburn 223: $cprtag{$key}=$val;
224: }
225: close($fh);
226: }
1.12 harris41 227: }
1.351 www 228: # ----------------------------------------------------------- source copyrights
1.192 taceyjo1 229: {
230: my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
231: '/source_copyright.tab';
232: if ( open (my $fh,"<$sourcecopyrightfile") ) {
1.356 albertel 233: while (my $line = <$fh>) {
234: next if ($line =~ /^\#/);
235: chomp($line);
236: my ($key,$val)=(split(/\s+/,$line,2));
1.192 taceyjo1 237: $scprtag{$key}=$val;
238: }
239: close($fh);
240: }
241: }
1.63 www 242:
1.517 raeburn 243: # -------------------------------------------------------------- default domain designs
1.63 www 244: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
1.517 raeburn 245: my $designfile = $designdir.'/default.tab';
246: if ( open (my $fh,"<$designfile") ) {
247: while (my $line = <$fh>) {
248: next if ($line =~ /^\#/);
249: chomp($line);
250: my ($key,$val)=(split(/\=/,$line));
251: if ($val) { $defaultdesign{$key}=$val; }
252: }
253: close($fh);
1.63 www 254: }
255:
1.15 harris41 256: # ------------------------------------------------------------- file categories
257: {
1.158 raeburn 258: my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
259: '/filecategories.tab';
260: if ( open (my $fh,"<$categoryfile") ) {
1.356 albertel 261: while (my $line = <$fh>) {
262: next if ($line =~ /^\#/);
263: chomp($line);
264: my ($extension,$category)=(split(/\s+/,$line,2));
1.158 raeburn 265: push @{$category_extensions{lc($category)}},$extension;
266: }
267: close($fh);
268: }
269:
1.15 harris41 270: }
1.12 harris41 271: # ------------------------------------------------------------------ file types
272: {
1.158 raeburn 273: my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
274: '/filetypes.tab';
275: if ( open (my $fh,"<$typesfile") ) {
1.356 albertel 276: while (my $line = <$fh>) {
277: next if ($line =~ /^\#/);
278: chomp($line);
279: my ($ending,$emb,$mime,$descr)=split(/\s+/,$line,4);
1.158 raeburn 280: if ($descr ne '') {
281: $fe{$ending}=lc($emb);
282: $fd{$ending}=$descr;
1.351 www 283: if ($mime ne 'unk') { $fm{$ending}=$mime; }
1.158 raeburn 284: }
285: }
286: close($fh);
287: }
1.12 harris41 288: }
1.22 www 289: &Apache::lonnet::logthis(
1.705 tempelho 290: "<span style='color:yellow;'>INFO: Read file types</span>");
1.22 www 291: $readit=1;
1.46 matthew 292: } # end of unless($readit)
1.32 matthew 293:
294: }
1.112 bowersj2 295:
1.42 matthew 296: ###############################################################
297: ## HTML and Javascript Helper Functions ##
298: ###############################################################
299:
300: =pod
301:
1.112 bowersj2 302: =head1 HTML and Javascript Functions
1.42 matthew 303:
1.112 bowersj2 304: =over 4
305:
1.648 raeburn 306: =item * &browser_and_searcher_javascript()
1.112 bowersj2 307:
308: X<browsing, javascript>X<searching, javascript>Returns a string
309: containing javascript with two functions, C<openbrowser> and
310: C<opensearcher>. Returned string does not contain E<lt>scriptE<gt>
311: tags.
1.42 matthew 312:
1.648 raeburn 313: =item * &openbrowser(formname,elementname,only,omit) [javascript]
1.42 matthew 314:
315: inputs: formname, elementname, only, omit
316:
317: formname and elementname indicate the name of the html form and name of
318: the element that the results of the browsing selection are to be placed in.
319:
320: Specifying 'only' will restrict the browser to displaying only files
1.185 www 321: with the given extension. Can be a comma separated list.
1.42 matthew 322:
323: Specifying 'omit' will restrict the browser to NOT displaying files
1.185 www 324: with the given extension. Can be a comma separated list.
1.42 matthew 325:
1.648 raeburn 326: =item * &opensearcher(formname,elementname) [javascript]
1.42 matthew 327:
328: Inputs: formname, elementname
329:
330: formname and elementname specify the name of the html form and the name
331: of the element the selection from the search results will be placed in.
1.542 raeburn 332:
1.42 matthew 333: =cut
334:
335: sub browser_and_searcher_javascript {
1.199 albertel 336: my ($mode)=@_;
337: if (!defined($mode)) { $mode='edit'; }
1.453 albertel 338: my $resurl=&escape_single(&lastresurl());
1.42 matthew 339: return <<END;
1.219 albertel 340: // <!-- BEGIN LON-CAPA Internal
1.50 matthew 341: var editbrowser = null;
1.135 albertel 342: function openbrowser(formname,elementname,only,omit,titleelement) {
1.170 www 343: var url = '$resurl/?';
1.42 matthew 344: if (editbrowser == null) {
345: url += 'launch=1&';
346: }
347: url += 'catalogmode=interactive&';
1.199 albertel 348: url += 'mode=$mode&';
1.611 albertel 349: url += 'inhibitmenu=yes&';
1.42 matthew 350: url += 'form=' + formname + '&';
351: if (only != null) {
352: url += 'only=' + only + '&';
1.217 albertel 353: } else {
354: url += 'only=&';
355: }
1.42 matthew 356: if (omit != null) {
357: url += 'omit=' + omit + '&';
1.217 albertel 358: } else {
359: url += 'omit=&';
360: }
1.135 albertel 361: if (titleelement != null) {
362: url += 'titleelement=' + titleelement + '&';
1.217 albertel 363: } else {
364: url += 'titleelement=&';
365: }
1.42 matthew 366: url += 'element=' + elementname + '';
367: var title = 'Browser';
1.435 albertel 368: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 369: options += ',width=700,height=600';
370: editbrowser = open(url,title,options,'1');
371: editbrowser.focus();
372: }
373: var editsearcher;
1.135 albertel 374: function opensearcher(formname,elementname,titleelement) {
1.42 matthew 375: var url = '/adm/searchcat?';
376: if (editsearcher == null) {
377: url += 'launch=1&';
378: }
379: url += 'catalogmode=interactive&';
1.199 albertel 380: url += 'mode=$mode&';
1.42 matthew 381: url += 'form=' + formname + '&';
1.135 albertel 382: if (titleelement != null) {
383: url += 'titleelement=' + titleelement + '&';
1.217 albertel 384: } else {
385: url += 'titleelement=&';
386: }
1.42 matthew 387: url += 'element=' + elementname + '';
388: var title = 'Search';
1.435 albertel 389: var options = 'scrollbars=1,resizable=1,menubar=0,toolbar=1,location=1';
1.42 matthew 390: options += ',width=700,height=600';
391: editsearcher = open(url,title,options,'1');
392: editsearcher.focus();
393: }
1.219 albertel 394: // END LON-CAPA Internal -->
1.42 matthew 395: END
1.170 www 396: }
397:
398: sub lastresurl {
1.258 albertel 399: if ($env{'environment.lastresurl'}) {
400: return $env{'environment.lastresurl'}
1.170 www 401: } else {
402: return '/res';
403: }
404: }
405:
406: sub storeresurl {
407: my $resurl=&Apache::lonnet::clutter(shift);
408: unless ($resurl=~/^\/res/) { return 0; }
409: $resurl=~s/\/$//;
410: &Apache::lonnet::put('environment',{'lastresurl' => $resurl});
1.646 raeburn 411: &Apache::lonnet::appenv({'environment.lastresurl' => $resurl});
1.170 www 412: return 1;
1.42 matthew 413: }
414:
1.74 www 415: sub studentbrowser_javascript {
1.111 www 416: unless (
1.258 albertel 417: (($env{'request.course.id'}) &&
1.302 albertel 418: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
419: || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
420: '/'.$env{'request.course.sec'})
421: ))
1.258 albertel 422: || ($env{'request.role'}=~/^(au|dc|su)/)
1.111 www 423: ) { return ''; }
1.74 www 424: return (<<'ENDSTDBRW');
1.776 bisitz 425: <script type="text/javascript" language="Javascript">
1.824 bisitz 426: // <![CDATA[
1.74 www 427: var stdeditbrowser;
1.999 www 428: function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {
1.74 www 429: var url = '/adm/pickstudent?';
430: var filter;
1.558 albertel 431: if (!ignorefilter) {
432: eval('filter=document.'+formname+'.'+uname+'.value;');
433: }
1.74 www 434: if (filter != null) {
435: if (filter != '') {
436: url += 'filter='+filter+'&';
437: }
438: }
439: url += 'form=' + formname + '&unameelement='+uname+
1.999 www 440: '&udomelement='+udom+
441: '&clicker='+clicker;
1.111 www 442: if (roleflag) { url+="&roles=1"; }
1.793 raeburn 443: if (courseadvonly) { url+="&courseadvonly=1"; }
1.102 www 444: var title = 'Student_Browser';
1.74 www 445: var options = 'scrollbars=1,resizable=1,menubar=0';
446: options += ',width=700,height=600';
447: stdeditbrowser = open(url,title,options,'1');
448: stdeditbrowser.focus();
449: }
1.824 bisitz 450: // ]]>
1.74 www 451: </script>
452: ENDSTDBRW
453: }
1.42 matthew 454:
1.1003 www 455: sub resourcebrowser_javascript {
456: unless ($env{'request.course.id'}) { return ''; }
1.1004 www 457: return (<<'ENDRESBRW');
1.1003 www 458: <script type="text/javascript" language="Javascript">
459: // <![CDATA[
460: var reseditbrowser;
1.1004 www 461: function openresbrowser(formname,reslink) {
1.1005 www 462: var url = '/adm/pickresource?form='+formname+'&reslink='+reslink;
1.1003 www 463: var title = 'Resource_Browser';
464: var options = 'scrollbars=1,resizable=1,menubar=0';
1.1005 www 465: options += ',width=700,height=500';
1.1004 www 466: reseditbrowser = open(url,title,options,'1');
467: reseditbrowser.focus();
1.1003 www 468: }
469: // ]]>
470: </script>
1.1004 www 471: ENDRESBRW
1.1003 www 472: }
473:
1.74 www 474: sub selectstudent_link {
1.999 www 475: my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;
476: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
477: &Apache::lonhtmlcommon::entity_encode($unameele)."','".
478: &Apache::lonhtmlcommon::entity_encode($udomele)."'";
1.258 albertel 479: if ($env{'request.course.id'}) {
1.302 albertel 480: if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
481: && !&Apache::lonnet::allowed('srm',$env{'request.course.id'}.
482: '/'.$env{'request.course.sec'})) {
1.111 www 483: return '';
484: }
1.999 www 485: $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
1.793 raeburn 486: if ($courseadvonly) {
487: $callargs .= ",'',1,1";
488: }
489: return '<span class="LC_nobreak">'.
490: '<a href="javascript:openstdbrowser('.$callargs.');">'.
491: &mt('Select User').'</a></span>';
1.74 www 492: }
1.258 albertel 493: if ($env{'request.role'}=~/^(au|dc|su)/) {
1.1012 www 494: $callargs .= ",'',1";
1.793 raeburn 495: return '<span class="LC_nobreak">'.
496: '<a href="javascript:openstdbrowser('.$callargs.');">'.
497: &mt('Select User').'</a></span>';
1.111 www 498: }
499: return '';
1.91 www 500: }
501:
1.1004 www 502: sub selectresource_link {
503: my ($form,$reslink,$arg)=@_;
504:
505: my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
506: &Apache::lonhtmlcommon::entity_encode($reslink)."'";
507: unless ($env{'request.course.id'}) { return $arg; }
508: return '<span class="LC_nobreak">'.
509: '<a href="javascript:openresbrowser('.$callargs.');">'.
510: $arg.'</a></span>';
511: }
512:
513:
514:
1.653 raeburn 515: sub authorbrowser_javascript {
516: return <<"ENDAUTHORBRW";
1.776 bisitz 517: <script type="text/javascript" language="JavaScript">
1.824 bisitz 518: // <![CDATA[
1.653 raeburn 519: var stdeditbrowser;
520:
521: function openauthorbrowser(formname,udom) {
522: var url = '/adm/pickauthor?';
523: url += 'form='+formname+'&roledom='+udom;
524: var title = 'Author_Browser';
525: var options = 'scrollbars=1,resizable=1,menubar=0';
526: options += ',width=700,height=600';
527: stdeditbrowser = open(url,title,options,'1');
528: stdeditbrowser.focus();
529: }
530:
1.824 bisitz 531: // ]]>
1.653 raeburn 532: </script>
533: ENDAUTHORBRW
534: }
535:
1.91 www 536: sub coursebrowser_javascript {
1.1116 raeburn 537: my ($domainfilter,$sec_element,$formname,$role_element,$crstype,
538: $credits_element) = @_;
1.932 raeburn 539: my $wintitle = 'Course_Browser';
1.931 raeburn 540: if ($crstype eq 'Community') {
1.932 raeburn 541: $wintitle = 'Community_Browser';
1.909 raeburn 542: }
1.876 raeburn 543: my $id_functions = &javascript_index_functions();
544: my $output = '
1.776 bisitz 545: <script type="text/javascript" language="JavaScript">
1.824 bisitz 546: // <![CDATA[
1.468 raeburn 547: var stdeditbrowser;'."\n";
1.876 raeburn 548:
549: $output .= <<"ENDSTDBRW";
1.909 raeburn 550: function opencrsbrowser(formname,uname,udom,desc,extra_element,multflag,type,type_elem) {
1.91 www 551: var url = '/adm/pickcourse?';
1.895 raeburn 552: var formid = getFormIdByName(formname);
1.876 raeburn 553: var domainfilter = getDomainFromSelectbox(formname,udom);
1.128 albertel 554: if (domainfilter != null) {
555: if (domainfilter != '') {
556: url += 'domainfilter='+domainfilter+'&';
557: }
558: }
1.91 www 559: url += 'form=' + formname + '&cnumelement='+uname+
1.187 albertel 560: '&cdomelement='+udom+
561: '&cnameelement='+desc;
1.468 raeburn 562: if (extra_element !=null && extra_element != '') {
1.594 raeburn 563: if (formname == 'rolechoice' || formname == 'studentform') {
1.468 raeburn 564: url += '&roleelement='+extra_element;
565: if (domainfilter == null || domainfilter == '') {
566: url += '&domainfilter='+extra_element;
567: }
1.234 raeburn 568: }
1.468 raeburn 569: else {
570: if (formname == 'portform') {
571: url += '&setroles='+extra_element;
1.800 raeburn 572: } else {
573: if (formname == 'rules') {
574: url += '&fixeddom='+extra_element;
575: }
1.468 raeburn 576: }
577: }
1.230 raeburn 578: }
1.909 raeburn 579: if (type != null && type != '') {
580: url += '&type='+type;
581: }
582: if (type_elem != null && type_elem != '') {
583: url += '&typeelement='+type_elem;
584: }
1.872 raeburn 585: if (formname == 'ccrs') {
586: var ownername = document.forms[formid].ccuname.value;
587: var ownerdom = document.forms[formid].ccdomain.options[document.forms[formid].ccdomain.selectedIndex].value;
588: url += '&cloner='+ownername+':'+ownerdom;
589: }
1.293 raeburn 590: if (multflag !=null && multflag != '') {
591: url += '&multiple='+multflag;
592: }
1.909 raeburn 593: var title = '$wintitle';
1.91 www 594: var options = 'scrollbars=1,resizable=1,menubar=0';
595: options += ',width=700,height=600';
596: stdeditbrowser = open(url,title,options,'1');
597: stdeditbrowser.focus();
598: }
1.876 raeburn 599: $id_functions
600: ENDSTDBRW
1.1116 raeburn 601: if (($sec_element ne '') || ($role_element ne '') || ($credits_element ne '')) {
602: $output .= &setsec_javascript($sec_element,$formname,$role_element,
603: $credits_element);
1.876 raeburn 604: }
605: $output .= '
606: // ]]>
607: </script>';
608: return $output;
609: }
610:
611: sub javascript_index_functions {
612: return <<"ENDJS";
613:
614: function getFormIdByName(formname) {
615: for (var i=0;i<document.forms.length;i++) {
616: if (document.forms[i].name == formname) {
617: return i;
618: }
619: }
620: return -1;
621: }
622:
623: function getIndexByName(formid,item) {
624: for (var i=0;i<document.forms[formid].elements.length;i++) {
625: if (document.forms[formid].elements[i].name == item) {
626: return i;
627: }
628: }
629: return -1;
630: }
1.468 raeburn 631:
1.876 raeburn 632: function getDomainFromSelectbox(formname,udom) {
633: var userdom;
634: var formid = getFormIdByName(formname);
635: if (formid > -1) {
636: var domid = getIndexByName(formid,udom);
637: if (domid > -1) {
638: if (document.forms[formid].elements[domid].type == 'select-one') {
639: userdom=document.forms[formid].elements[domid].options[document.forms[formid].elements[domid].selectedIndex].value;
640: }
641: if (document.forms[formid].elements[domid].type == 'hidden') {
642: userdom=document.forms[formid].elements[domid].value;
1.468 raeburn 643: }
644: }
645: }
1.876 raeburn 646: return userdom;
647: }
648:
649: ENDJS
1.468 raeburn 650:
1.876 raeburn 651: }
652:
1.1017 raeburn 653: sub javascript_array_indexof {
1.1018 raeburn 654: return <<ENDJS;
1.1017 raeburn 655: <script type="text/javascript" language="JavaScript">
656: // <![CDATA[
657:
658: if (!Array.prototype.indexOf) {
659: Array.prototype.indexOf = function (searchElement /*, fromIndex */ ) {
660: "use strict";
661: if (this === void 0 || this === null) {
662: throw new TypeError();
663: }
664: var t = Object(this);
665: var len = t.length >>> 0;
666: if (len === 0) {
667: return -1;
668: }
669: var n = 0;
670: if (arguments.length > 0) {
671: n = Number(arguments[1]);
1.1088 foxr 672: if (n !== n) { // shortcut for verifying if it is NaN
1.1017 raeburn 673: n = 0;
674: } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) {
675: n = (n > 0 || -1) * Math.floor(Math.abs(n));
676: }
677: }
678: if (n >= len) {
679: return -1;
680: }
681: var k = n >= 0 ? n : Math.max(len - Math.abs(n), 0);
682: for (; k < len; k++) {
683: if (k in t && t[k] === searchElement) {
684: return k;
685: }
686: }
687: return -1;
688: }
689: }
690:
691: // ]]>
692: </script>
693:
694: ENDJS
695:
696: }
697:
1.876 raeburn 698: sub userbrowser_javascript {
699: my $id_functions = &javascript_index_functions();
700: return <<"ENDUSERBRW";
701:
1.888 raeburn 702: function openuserbrowser(formname,uname,udom,ulast,ufirst,uemail,hideudom,crsdom,caller) {
1.876 raeburn 703: var url = '/adm/pickuser?';
704: var userdom = getDomainFromSelectbox(formname,udom);
705: if (userdom != null) {
706: if (userdom != '') {
707: url += 'srchdom='+userdom+'&';
708: }
709: }
710: url += 'form=' + formname + '&unameelement='+uname+
711: '&udomelement='+udom+
712: '&ulastelement='+ulast+
713: '&ufirstelement='+ufirst+
714: '&uemailelement='+uemail+
1.881 raeburn 715: '&hideudomelement='+hideudom+
716: '&coursedom='+crsdom;
1.888 raeburn 717: if ((caller != null) && (caller != undefined)) {
718: url += '&caller='+caller;
719: }
1.876 raeburn 720: var title = 'User_Browser';
721: var options = 'scrollbars=1,resizable=1,menubar=0';
722: options += ',width=700,height=600';
723: var stdeditbrowser = open(url,title,options,'1');
724: stdeditbrowser.focus();
725: }
726:
1.888 raeburn 727: function fix_domain (formname,udom,origdom,uname) {
1.876 raeburn 728: var formid = getFormIdByName(formname);
729: if (formid > -1) {
1.888 raeburn 730: var unameid = getIndexByName(formid,uname);
1.876 raeburn 731: var domid = getIndexByName(formid,udom);
732: var hidedomid = getIndexByName(formid,origdom);
733: if (hidedomid > -1) {
734: var fixeddom = document.forms[formid].elements[hidedomid].value;
1.888 raeburn 735: var unameval = document.forms[formid].elements[unameid].value;
736: if ((fixeddom != '') && (fixeddom != undefined) && (fixeddom != null) && (unameval != '') && (unameval != undefined) && (unameval != null)) {
737: if (domid > -1) {
738: var slct = document.forms[formid].elements[domid];
739: if (slct.type == 'select-one') {
740: var i;
741: for (i=0;i<slct.length;i++) {
742: if (slct.options[i].value==fixeddom) { slct.selectedIndex=i; }
743: }
744: }
745: if (slct.type == 'hidden') {
746: slct.value = fixeddom;
1.876 raeburn 747: }
748: }
1.468 raeburn 749: }
750: }
751: }
1.876 raeburn 752: return;
753: }
754:
755: $id_functions
756: ENDUSERBRW
1.468 raeburn 757: }
758:
759: sub setsec_javascript {
1.1116 raeburn 760: my ($sec_element,$formname,$role_element,$credits_element) = @_;
1.905 raeburn 761: my (@courserolenames,@communityrolenames,$rolestr,$courserolestr,
762: $communityrolestr);
763: if ($role_element ne '') {
764: my @allroles = ('st','ta','ep','in','ad');
765: foreach my $crstype ('Course','Community') {
766: if ($crstype eq 'Community') {
767: foreach my $role (@allroles) {
768: push(@communityrolenames,&Apache::lonnet::plaintext($role,$crstype));
769: }
770: push(@communityrolenames,&Apache::lonnet::plaintext('co'));
771: } else {
772: foreach my $role (@allroles) {
773: push(@courserolenames,&Apache::lonnet::plaintext($role,$crstype));
774: }
775: push(@courserolenames,&Apache::lonnet::plaintext('cc'));
776: }
777: }
778: $rolestr = '"'.join('","',@allroles).'"';
779: $courserolestr = '"'.join('","',@courserolenames).'"';
780: $communityrolestr = '"'.join('","',@communityrolenames).'"';
781: }
1.468 raeburn 782: my $setsections = qq|
783: function setSect(sectionlist) {
1.629 raeburn 784: var sectionsArray = new Array();
785: if ((sectionlist != '') && (typeof sectionlist != "undefined")) {
786: sectionsArray = sectionlist.split(",");
787: }
1.468 raeburn 788: var numSections = sectionsArray.length;
789: document.$formname.$sec_element.length = 0;
790: if (numSections == 0) {
791: document.$formname.$sec_element.multiple=false;
792: document.$formname.$sec_element.size=1;
793: document.$formname.$sec_element.options[0] = new Option('No existing sections','',false,false)
794: } else {
795: if (numSections == 1) {
796: document.$formname.$sec_element.multiple=false;
797: document.$formname.$sec_element.size=1;
798: document.$formname.$sec_element.options[0] = new Option('Select','',true,true);
799: document.$formname.$sec_element.options[1] = new Option('No section','',false,false)
800: document.$formname.$sec_element.options[2] = new Option(sectionsArray[0],sectionsArray[0],false,false);
801: } else {
802: for (var i=0; i<numSections; i++) {
803: document.$formname.$sec_element.options[i] = new Option(sectionsArray[i],sectionsArray[i],false,false)
804: }
805: document.$formname.$sec_element.multiple=true
806: if (numSections < 3) {
807: document.$formname.$sec_element.size=numSections;
808: } else {
809: document.$formname.$sec_element.size=3;
810: }
811: document.$formname.$sec_element.options[0].selected = false
812: }
813: }
1.91 www 814: }
1.905 raeburn 815:
816: function setRole(crstype) {
1.468 raeburn 817: |;
1.905 raeburn 818: if ($role_element eq '') {
819: $setsections .= ' return;
820: }
821: ';
822: } else {
823: $setsections .= qq|
824: var elementLength = document.$formname.$role_element.length;
825: var allroles = Array($rolestr);
826: var courserolenames = Array($courserolestr);
827: var communityrolenames = Array($communityrolestr);
828: if (elementLength != undefined) {
829: if (document.$formname.$role_element.options[5].value == 'cc') {
830: if (crstype == 'Course') {
831: return;
832: } else {
833: allroles[5] = 'co';
834: for (var i=0; i<6; i++) {
835: document.$formname.$role_element.options[i].value = allroles[i];
836: document.$formname.$role_element.options[i].text = communityrolenames[i];
837: }
838: }
839: } else {
840: if (crstype == 'Community') {
841: return;
842: } else {
843: allroles[5] = 'cc';
844: for (var i=0; i<6; i++) {
845: document.$formname.$role_element.options[i].value = allroles[i];
846: document.$formname.$role_element.options[i].text = courserolenames[i];
847: }
848: }
849: }
850: }
851: return;
852: }
853: |;
854: }
1.1116 raeburn 855: if ($credits_element) {
856: $setsections .= qq|
857: function setCredits(defaultcredits) {
858: document.$formname.$credits_element.value = defaultcredits;
859: return;
860: }
861: |;
862: }
1.468 raeburn 863: return $setsections;
864: }
865:
1.91 www 866: sub selectcourse_link {
1.909 raeburn 867: my ($form,$unameele,$udomele,$desc,$extra_element,$multflag,$selecttype,
868: $typeelement) = @_;
869: my $type = $selecttype;
1.871 raeburn 870: my $linktext = &mt('Select Course');
871: if ($selecttype eq 'Community') {
1.909 raeburn 872: $linktext = &mt('Select Community');
1.906 raeburn 873: } elsif ($selecttype eq 'Course/Community') {
874: $linktext = &mt('Select Course/Community');
1.909 raeburn 875: $type = '';
1.1019 raeburn 876: } elsif ($selecttype eq 'Select') {
877: $linktext = &mt('Select');
878: $type = '';
1.871 raeburn 879: }
1.787 bisitz 880: return '<span class="LC_nobreak">'
881: ."<a href='"
882: .'javascript:opencrsbrowser("'.$form.'","'.$unameele
883: .'","'.$udomele.'","'.$desc.'","'.$extra_element
1.909 raeburn 884: .'","'.$multflag.'","'.$type.'","'.$typeelement.'");'
1.871 raeburn 885: ."'>".$linktext.'</a>'
1.787 bisitz 886: .'</span>';
1.74 www 887: }
1.42 matthew 888:
1.653 raeburn 889: sub selectauthor_link {
890: my ($form,$udom)=@_;
891: return '<a href="javascript:openauthorbrowser('."'$form','$udom'".');">'.
892: &mt('Select Author').'</a>';
893: }
894:
1.876 raeburn 895: sub selectuser_link {
1.881 raeburn 896: my ($form,$unameelem,$domelem,$lastelem,$firstelem,$emailelem,$hdomelem,
1.888 raeburn 897: $coursedom,$linktext,$caller) = @_;
1.876 raeburn 898: return '<a href="javascript:openuserbrowser('."'$form','$unameelem','$domelem',".
1.888 raeburn 899: "'$lastelem','$firstelem','$emailelem','$hdomelem','$coursedom','$caller'".
1.881 raeburn 900: ');">'.$linktext.'</a>';
1.876 raeburn 901: }
902:
1.273 raeburn 903: sub check_uncheck_jscript {
904: my $jscript = <<"ENDSCRT";
905: function checkAll(field) {
906: if (field.length > 0) {
907: for (i = 0; i < field.length; i++) {
1.1093 raeburn 908: if (!field[i].disabled) {
909: field[i].checked = true;
910: }
1.273 raeburn 911: }
912: } else {
1.1093 raeburn 913: if (!field.disabled) {
914: field.checked = true;
915: }
1.273 raeburn 916: }
917: }
918:
919: function uncheckAll(field) {
920: if (field.length > 0) {
921: for (i = 0; i < field.length; i++) {
922: field[i].checked = false ;
1.543 albertel 923: }
924: } else {
1.273 raeburn 925: field.checked = false ;
926: }
927: }
928: ENDSCRT
929: return $jscript;
930: }
931:
1.656 www 932: sub select_timezone {
1.659 raeburn 933: my ($name,$selected,$onchange,$includeempty)=@_;
934: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
935: if ($includeempty) {
936: $output .= '<option value=""';
937: if (($selected eq '') || ($selected eq 'local')) {
938: $output .= ' selected="selected" ';
939: }
940: $output .= '> </option>';
941: }
1.657 raeburn 942: my @timezones = DateTime::TimeZone->all_names;
943: foreach my $tzone (@timezones) {
944: $output.= '<option value="'.$tzone.'"';
945: if ($tzone eq $selected) {
946: $output.=' selected="selected"';
947: }
948: $output.=">$tzone</option>\n";
1.656 www 949: }
950: $output.="</select>";
951: return $output;
952: }
1.273 raeburn 953:
1.687 raeburn 954: sub select_datelocale {
955: my ($name,$selected,$onchange,$includeempty)=@_;
956: my $output='<select name="'.$name.'" '.$onchange.'>'."\n";
957: if ($includeempty) {
958: $output .= '<option value=""';
959: if ($selected eq '') {
960: $output .= ' selected="selected" ';
961: }
962: $output .= '> </option>';
963: }
964: my (@possibles,%locale_names);
965: my @locales = DateTime::Locale::Catalog::Locales;
966: foreach my $locale (@locales) {
967: if (ref($locale) eq 'HASH') {
968: my $id = $locale->{'id'};
969: if ($id ne '') {
970: my $en_terr = $locale->{'en_territory'};
971: my $native_terr = $locale->{'native_territory'};
1.695 raeburn 972: my @languages = &Apache::lonlocal::preferred_languages();
1.687 raeburn 973: if (grep(/^en$/,@languages) || !@languages) {
974: if ($en_terr ne '') {
975: $locale_names{$id} = '('.$en_terr.')';
976: } elsif ($native_terr ne '') {
977: $locale_names{$id} = $native_terr;
978: }
979: } else {
980: if ($native_terr ne '') {
981: $locale_names{$id} = $native_terr.' ';
982: } elsif ($en_terr ne '') {
983: $locale_names{$id} = '('.$en_terr.')';
984: }
985: }
986: push (@possibles,$id);
987: }
988: }
989: }
990: foreach my $item (sort(@possibles)) {
991: $output.= '<option value="'.$item.'"';
992: if ($item eq $selected) {
993: $output.=' selected="selected"';
994: }
995: $output.=">$item";
996: if ($locale_names{$item} ne '') {
997: $output.=" $locale_names{$item}</option>\n";
998: }
999: $output.="</option>\n";
1000: }
1001: $output.="</select>";
1002: return $output;
1003: }
1004:
1.792 raeburn 1005: sub select_language {
1006: my ($name,$selected,$includeempty) = @_;
1007: my %langchoices;
1008: if ($includeempty) {
1.1117 raeburn 1009: %langchoices = ('' => 'No language preference');
1.792 raeburn 1010: }
1011: foreach my $id (&languageids()) {
1012: my $code = &supportedlanguagecode($id);
1013: if ($code) {
1014: $langchoices{$code} = &plainlanguagedescription($id);
1015: }
1016: }
1.1117 raeburn 1017: %langchoices = &Apache::lonlocal::texthash(%langchoices);
1.970 raeburn 1018: return &select_form($selected,$name,\%langchoices);
1.792 raeburn 1019: }
1020:
1.42 matthew 1021: =pod
1.36 matthew 1022:
1.1088 foxr 1023:
1024: =item * &list_languages()
1025:
1026: Returns an array reference that is suitable for use in language prompters.
1027: Each array element is itself a two element array. The first element
1028: is the language code. The second element a descsriptiuon of the
1029: language itself. This is suitable for use in e.g.
1030: &Apache::edit::select_arg (once dereferenced that is).
1031:
1032: =cut
1033:
1034: sub list_languages {
1035: my @lang_choices;
1036:
1037: foreach my $id (&languageids()) {
1038: my $code = &supportedlanguagecode($id);
1039: if ($code) {
1040: my $selector = $supported_codes{$id};
1041: my $description = &plainlanguagedescription($id);
1042: push (@lang_choices, [$selector, $description]);
1043: }
1044: }
1045: return \@lang_choices;
1046: }
1047:
1048: =pod
1049:
1.648 raeburn 1050: =item * &linked_select_forms(...)
1.36 matthew 1051:
1052: linked_select_forms returns a string containing a <script></script> block
1053: and html for two <select> menus. The select menus will be linked in that
1054: changing the value of the first menu will result in new values being placed
1055: in the second menu. The values in the select menu will appear in alphabetical
1.609 raeburn 1056: order unless a defined order is provided.
1.36 matthew 1057:
1058: linked_select_forms takes the following ordered inputs:
1059:
1060: =over 4
1061:
1.112 bowersj2 1062: =item * $formname, the name of the <form> tag
1.36 matthew 1063:
1.112 bowersj2 1064: =item * $middletext, the text which appears between the <select> tags
1.36 matthew 1065:
1.112 bowersj2 1066: =item * $firstdefault, the default value for the first menu
1.36 matthew 1067:
1.112 bowersj2 1068: =item * $firstselectname, the name of the first <select> tag
1.36 matthew 1069:
1.112 bowersj2 1070: =item * $secondselectname, the name of the second <select> tag
1.36 matthew 1071:
1.112 bowersj2 1072: =item * $hashref, a reference to a hash containing the data for the menus.
1.36 matthew 1073:
1.609 raeburn 1074: =item * $menuorder, the order of values in the first menu
1075:
1.1115 raeburn 1076: =item * $onchangefirst, additional javascript call to execute for an onchange
1077: event for the first <select> tag
1078:
1079: =item * $onchangesecond, additional javascript call to execute for an onchange
1080: event for the second <select> tag
1081:
1.41 ng 1082: =back
1083:
1.36 matthew 1084: Below is an example of such a hash. Only the 'text', 'default', and
1085: 'select2' keys must appear as stated. keys(%menu) are the possible
1086: values for the first select menu. The text that coincides with the
1.41 ng 1087: first menu value is given in $menu{$choice1}->{'text'}. The values
1.36 matthew 1088: and text for the second menu are given in the hash pointed to by
1089: $menu{$choice1}->{'select2'}.
1090:
1.112 bowersj2 1091: my %menu = ( A1 => { text =>"Choice A1" ,
1092: default => "B3",
1093: select2 => {
1094: B1 => "Choice B1",
1095: B2 => "Choice B2",
1096: B3 => "Choice B3",
1097: B4 => "Choice B4"
1.609 raeburn 1098: },
1099: order => ['B4','B3','B1','B2'],
1.112 bowersj2 1100: },
1101: A2 => { text =>"Choice A2" ,
1102: default => "C2",
1103: select2 => {
1104: C1 => "Choice C1",
1105: C2 => "Choice C2",
1106: C3 => "Choice C3"
1.609 raeburn 1107: },
1108: order => ['C2','C1','C3'],
1.112 bowersj2 1109: },
1110: A3 => { text =>"Choice A3" ,
1111: default => "D6",
1112: select2 => {
1113: D1 => "Choice D1",
1114: D2 => "Choice D2",
1115: D3 => "Choice D3",
1116: D4 => "Choice D4",
1117: D5 => "Choice D5",
1118: D6 => "Choice D6",
1119: D7 => "Choice D7"
1.609 raeburn 1120: },
1121: order => ['D4','D3','D2','D1','D7','D6','D5'],
1.112 bowersj2 1122: }
1123: );
1.36 matthew 1124:
1125: =cut
1126:
1127: sub linked_select_forms {
1128: my ($formname,
1129: $middletext,
1130: $firstdefault,
1131: $firstselectname,
1132: $secondselectname,
1.609 raeburn 1133: $hashref,
1134: $menuorder,
1.1115 raeburn 1135: $onchangefirst,
1136: $onchangesecond
1.36 matthew 1137: ) = @_;
1138: my $second = "document.$formname.$secondselectname";
1139: my $first = "document.$formname.$firstselectname";
1140: # output the javascript to do the changing
1141: my $result = '';
1.776 bisitz 1142: $result.='<script type="text/javascript" language="JavaScript">'."\n";
1.824 bisitz 1143: $result.="// <![CDATA[\n";
1.36 matthew 1144: $result.="var select2data = new Object();\n";
1145: $" = '","';
1146: my $debug = '';
1147: foreach my $s1 (sort(keys(%$hashref))) {
1148: $result.="select2data.d_$s1 = new Object();\n";
1149: $result.="select2data.d_$s1.def = new String('".
1150: $hashref->{$s1}->{'default'}."');\n";
1.609 raeburn 1151: $result.="select2data.d_$s1.values = new Array(";
1.36 matthew 1152: my @s2values = sort(keys( %{ $hashref->{$s1}->{'select2'} } ));
1.609 raeburn 1153: if (ref($hashref->{$s1}->{'order'}) eq 'ARRAY') {
1154: @s2values = @{$hashref->{$s1}->{'order'}};
1155: }
1.36 matthew 1156: $result.="\"@s2values\");\n";
1157: $result.="select2data.d_$s1.texts = new Array(";
1158: my @s2texts;
1159: foreach my $value (@s2values) {
1160: push @s2texts, $hashref->{$s1}->{'select2'}->{$value};
1161: }
1162: $result.="\"@s2texts\");\n";
1163: }
1164: $"=' ';
1165: $result.= <<"END";
1166:
1167: function select1_changed() {
1168: // Determine new choice
1169: var newvalue = "d_" + $first.value;
1170: // update select2
1171: var values = select2data[newvalue].values;
1172: var texts = select2data[newvalue].texts;
1173: var select2def = select2data[newvalue].def;
1174: var i;
1175: // out with the old
1176: for (i = 0; i < $second.options.length; i++) {
1177: $second.options[i] = null;
1178: }
1179: // in with the nuclear
1180: for (i=0;i<values.length; i++) {
1181: $second.options[i] = new Option(values[i]);
1.143 matthew 1182: $second.options[i].value = values[i];
1.36 matthew 1183: $second.options[i].text = texts[i];
1184: if (values[i] == select2def) {
1185: $second.options[i].selected = true;
1186: }
1187: }
1188: }
1.824 bisitz 1189: // ]]>
1.36 matthew 1190: </script>
1191: END
1192: # output the initial values for the selection lists
1.1115 raeburn 1193: $result .= "<select size=\"1\" name=\"$firstselectname\" onchange=\"select1_changed();$onchangefirst\">\n";
1.609 raeburn 1194: my @order = sort(keys(%{$hashref}));
1195: if (ref($menuorder) eq 'ARRAY') {
1196: @order = @{$menuorder};
1197: }
1198: foreach my $value (@order) {
1.36 matthew 1199: $result.=" <option value=\"$value\" ";
1.253 albertel 1200: $result.=" selected=\"selected\" " if ($value eq $firstdefault);
1.119 www 1201: $result.=">".&mt($hashref->{$value}->{'text'})."</option>\n";
1.36 matthew 1202: }
1203: $result .= "</select>\n";
1204: my %select2 = %{$hashref->{$firstdefault}->{'select2'}};
1205: $result .= $middletext;
1.1115 raeburn 1206: $result .= "<select size=\"1\" name=\"$secondselectname\"";
1207: if ($onchangesecond) {
1208: $result .= ' onchange="'.$onchangesecond.'"';
1209: }
1210: $result .= ">\n";
1.36 matthew 1211: my $seconddefault = $hashref->{$firstdefault}->{'default'};
1.609 raeburn 1212:
1213: my @secondorder = sort(keys(%select2));
1214: if (ref($hashref->{$firstdefault}->{'order'}) eq 'ARRAY') {
1215: @secondorder = @{$hashref->{$firstdefault}->{'order'}};
1216: }
1217: foreach my $value (@secondorder) {
1.36 matthew 1218: $result.=" <option value=\"$value\" ";
1.253 albertel 1219: $result.=" selected=\"selected\" " if ($value eq $seconddefault);
1.119 www 1220: $result.=">".&mt($select2{$value})."</option>\n";
1.36 matthew 1221: }
1222: $result .= "</select>\n";
1223: # return $debug;
1224: return $result;
1225: } # end of sub linked_select_forms {
1226:
1.45 matthew 1227: =pod
1.44 bowersj2 1228:
1.973 raeburn 1229: =item * &help_open_topic($topic,$text,$stayOnPage,$width,$height,$imgid)
1.44 bowersj2 1230:
1.112 bowersj2 1231: Returns a string corresponding to an HTML link to the given help
1232: $topic, where $topic corresponds to the name of a .tex file in
1233: /home/httpd/html/adm/help/tex, with underscores replaced by
1234: spaces.
1235:
1236: $text will optionally be linked to the same topic, allowing you to
1237: link text in addition to the graphic. If you do not want to link
1238: text, but wish to specify one of the later parameters, pass an
1239: empty string.
1240:
1241: $stayOnPage is a value that will be interpreted as a boolean. If true,
1242: the link will not open a new window. If false, the link will open
1243: a new window using Javascript. (Default is false.)
1244:
1245: $width and $height are optional numerical parameters that will
1246: override the width and height of the popped up window, which may
1.973 raeburn 1247: be useful for certain help topics with big pictures included.
1248:
1249: $imgid is the id of the img tag used for the help icon. This may be
1250: used in a javascript call to switch the image src. See
1251: lonhtmlcommon::htmlareaselectactive() for an example.
1.44 bowersj2 1252:
1253: =cut
1254:
1255: sub help_open_topic {
1.973 raeburn 1256: my ($topic, $text, $stayOnPage, $width, $height, $imgid) = @_;
1.48 bowersj2 1257: $text = "" if (not defined $text);
1.44 bowersj2 1258: $stayOnPage = 0 if (not defined $stayOnPage);
1.1033 www 1259: $width = 500 if (not defined $width);
1.44 bowersj2 1260: $height = 400 if (not defined $height);
1261: my $filename = $topic;
1262: $filename =~ s/ /_/g;
1263:
1.48 bowersj2 1264: my $template = "";
1265: my $link;
1.572 banghart 1266:
1.159 www 1267: $topic=~s/\W/\_/g;
1.44 bowersj2 1268:
1.572 banghart 1269: if (!$stayOnPage) {
1.1033 www 1270: $link = "javascript:openMyModal('/adm/help/${filename}.hlp',$width,$height,'yes');";
1.1037 www 1271: } elsif ($stayOnPage eq 'popup') {
1272: $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 1273: } else {
1.48 bowersj2 1274: $link = "/adm/help/${filename}.hlp";
1275: }
1276:
1277: # Add the text
1.755 neumanie 1278: if ($text ne "") {
1.763 bisitz 1279: $template.='<span class="LC_help_open_topic">'
1280: .'<a target="_top" href="'.$link.'">'
1281: .$text.'</a>';
1.48 bowersj2 1282: }
1283:
1.763 bisitz 1284: # (Always) Add the graphic
1.179 matthew 1285: my $title = &mt('Online Help');
1.667 raeburn 1286: my $helpicon=&lonhttpdurl("/adm/help/help.png");
1.973 raeburn 1287: if ($imgid ne '') {
1288: $imgid = ' id="'.$imgid.'"';
1289: }
1.763 bisitz 1290: $template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'
1291: .'<img src="'.$helpicon.'" border="0"'
1292: .' alt="'.&mt('Help: [_1]',$topic).'"'
1.973 raeburn 1293: .' title="'.$title.'" style="vertical-align:middle;"'.$imgid
1.763 bisitz 1294: .' /></a>';
1295: if ($text ne "") {
1296: $template.='</span>';
1297: }
1.44 bowersj2 1298: return $template;
1299:
1.106 bowersj2 1300: }
1301:
1302: # This is a quicky function for Latex cheatsheet editing, since it
1303: # appears in at least four places
1304: sub helpLatexCheatsheet {
1.1037 www 1305: my ($topic,$text,$not_author,$stayOnPage) = @_;
1.732 raeburn 1306: my $out;
1.106 bowersj2 1307: my $addOther = '';
1.732 raeburn 1308: if ($topic) {
1.1037 www 1309: $addOther = '<span>'.&help_open_topic($topic,&mt($text),$stayOnPage, undef, 600).'</span> ';
1.763 bisitz 1310: }
1311: $out = '<span>' # Start cheatsheet
1312: .$addOther
1313: .'<span>'
1.1037 www 1314: .&help_open_topic('Greek_Symbols',&mt('Greek Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1315: .'</span> <span>'
1.1037 www 1316: .&help_open_topic('Other_Symbols',&mt('Other Symbols'),$stayOnPage,undef,600)
1.763 bisitz 1317: .'</span>';
1.732 raeburn 1318: unless ($not_author) {
1.1186 kruse 1319: $out .= '<span>'
1320: .&help_open_topic('Authoring_Output_Tags',&mt('Output Tags'),$stayOnPage,undef,600)
1321: .'</span> <span>'
1322: .&help_open_topic('Authoring_Multilingual_Problems',&mt('How to create problems in different languages'),$stayOnPage,undef,600)
1.763 bisitz 1323: .'</span>';
1.732 raeburn 1324: }
1.763 bisitz 1325: $out .= '</span>'; # End cheatsheet
1.732 raeburn 1326: return $out;
1.172 www 1327: }
1328:
1.430 albertel 1329: sub general_help {
1330: my $helptopic='Student_Intro';
1331: if ($env{'request.role'}=~/^(ca|au)/) {
1332: $helptopic='Authoring_Intro';
1.907 raeburn 1333: } elsif ($env{'request.role'}=~/^(cc|co)/) {
1.430 albertel 1334: $helptopic='Course_Coordination_Intro';
1.672 raeburn 1335: } elsif ($env{'request.role'}=~/^dc/) {
1336: $helptopic='Domain_Coordination_Intro';
1.430 albertel 1337: }
1338: return $helptopic;
1339: }
1340:
1341: sub update_help_link {
1342: my ($topic,$component_help,$faq,$bug,$stayOnPage) = @_;
1343: my $origurl = $ENV{'REQUEST_URI'};
1344: $origurl=~s|^/~|/priv/|;
1345: my $timestamp = time;
1346: foreach my $datum (\$topic,\$component_help,\$faq,\$bug,\$origurl) {
1347: $$datum = &escape($$datum);
1348: }
1349:
1350: my $banner_link = "/adm/helpmenu?page=banner&topic=$topic&component_help=$component_help&faq=$faq&bug=$bug&origurl=$origurl&stamp=$timestamp&stayonpage=$stayOnPage";
1351: my $output .= <<"ENDOUTPUT";
1352: <script type="text/javascript">
1.824 bisitz 1353: // <![CDATA[
1.430 albertel 1354: banner_link = '$banner_link';
1.824 bisitz 1355: // ]]>
1.430 albertel 1356: </script>
1357: ENDOUTPUT
1358: return $output;
1359: }
1360:
1361: # now just updates the help link and generates a blue icon
1.193 raeburn 1362: sub help_open_menu {
1.430 albertel 1363: my ($topic,$component_help,$faq,$bug,$stayOnPage,$width,$height,$text)
1.552 banghart 1364: = @_;
1.949 droeschl 1365: $stayOnPage = 1;
1.430 albertel 1366: my $output;
1367: if ($component_help) {
1368: if (!$text) {
1369: $output=&help_open_topic($component_help,undef,$stayOnPage,
1370: $width,$height);
1371: } else {
1372: my $help_text;
1373: $help_text=&unescape($topic);
1374: $output='<table><tr><td>'.
1375: &help_open_topic($component_help,$help_text,$stayOnPage,
1376: $width,$height).'</td></tr></table>';
1377: }
1378: }
1379: my $banner_link = &update_help_link($topic,$component_help,$faq,$bug,$stayOnPage);
1380: return $output.$banner_link;
1381: }
1382:
1383: sub top_nav_help {
1384: my ($text) = @_;
1.436 albertel 1385: $text = &mt($text);
1.949 droeschl 1386: my $stay_on_page = 1;
1387:
1.1168 raeburn 1388: my ($link,$banner_link);
1389: unless ($env{'request.noversionuri'} =~ m{^/adm/helpmenu}) {
1390: $link = ($stay_on_page) ? "javascript:helpMenu('display')"
1391: : "javascript:helpMenu('open')";
1392: $banner_link = &update_help_link(undef,undef,undef,undef,$stay_on_page);
1393: }
1.201 raeburn 1394: my $title = &mt('Get help');
1.1168 raeburn 1395: if ($link) {
1396: return <<"END";
1.436 albertel 1397: $banner_link
1.1159 raeburn 1398: <a href="$link" title="$title">$text</a>
1.436 albertel 1399: END
1.1168 raeburn 1400: } else {
1401: return ' '.$text.' ';
1402: }
1.436 albertel 1403: }
1404:
1405: sub help_menu_js {
1.1154 raeburn 1406: my ($httphost) = @_;
1.949 droeschl 1407: my $stayOnPage = 1;
1.436 albertel 1408: my $width = 620;
1409: my $height = 600;
1.430 albertel 1410: my $helptopic=&general_help();
1.1154 raeburn 1411: my $details_link = $httphost.'/adm/help/'.$helptopic.'.hlp';
1.261 albertel 1412: my $nothing=&Apache::lonhtmlcommon::javascript_nothing();
1.331 albertel 1413: my $start_page =
1414: &Apache::loncommon::start_page('Help Menu', undef,
1415: {'frameset' => 1,
1416: 'js_ready' => 1,
1.1154 raeburn 1417: 'use_absolute' => $httphost,
1.331 albertel 1418: 'add_entries' => {
1.1168 raeburn 1419: 'border' => '0',
1.579 raeburn 1420: 'rows' => "110,*",},});
1.331 albertel 1421: my $end_page =
1422: &Apache::loncommon::end_page({'frameset' => 1,
1423: 'js_ready' => 1,});
1424:
1.436 albertel 1425: my $template .= <<"ENDTEMPLATE";
1426: <script type="text/javascript">
1.877 bisitz 1427: // <![CDATA[
1.253 albertel 1428: // <!-- BEGIN LON-CAPA Internal
1.430 albertel 1429: var banner_link = '';
1.243 raeburn 1430: function helpMenu(target) {
1431: var caller = this;
1432: if (target == 'open') {
1433: var newWindow = null;
1434: try {
1.262 albertel 1435: newWindow = window.open($nothing,"helpmenu","HEIGHT=$height,WIDTH=$width,resizable=yes,scrollbars=yes" )
1.243 raeburn 1436: }
1437: catch(error) {
1438: writeHelp(caller);
1439: return;
1440: }
1441: if (newWindow) {
1442: caller = newWindow;
1443: }
1.193 raeburn 1444: }
1.243 raeburn 1445: writeHelp(caller);
1446: return;
1447: }
1448: function writeHelp(caller) {
1.1168 raeburn 1449: caller.document.writeln('$start_page\\n<frame name="bannerframe" src="'+banner_link+'" marginwidth="0" marginheight="0" frameborder="0">\\n');
1450: caller.document.writeln('<frame name="bodyframe" src="$details_link" marginwidth="0" marginheight="0" frameborder="0">\\n$end_page');
1451: caller.document.close();
1452: caller.focus();
1.193 raeburn 1453: }
1.877 bisitz 1454: // END LON-CAPA Internal -->
1.253 albertel 1455: // ]]>
1.436 albertel 1456: </script>
1.193 raeburn 1457: ENDTEMPLATE
1458: return $template;
1459: }
1460:
1.172 www 1461: sub help_open_bug {
1462: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1463: unless ($env{'user.adv'}) { return ''; }
1.172 www 1464: unless ($Apache::lonnet::perlvar{'BugzillaHost'}) { return ''; }
1465: $text = "" if (not defined $text);
1466: $stayOnPage=1;
1.184 albertel 1467: $width = 600 if (not defined $width);
1468: $height = 600 if (not defined $height);
1.172 www 1469:
1470: $topic=~s/\W+/\+/g;
1471: my $link='';
1472: my $template='';
1.379 albertel 1473: my $url=$Apache::lonnet::perlvar{'BugzillaHost'}.'enter_bug.cgi?product=LON-CAPA&bug_file_loc='.
1474: &escape($ENV{'REQUEST_URI'}).'&component='.$topic;
1.172 www 1475: if (!$stayOnPage)
1476: {
1477: $link = "javascript:void(open('$url', 'Bugzilla', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1478: }
1479: else
1480: {
1481: $link = $url;
1482: }
1483: # Add the text
1484: if ($text ne "")
1485: {
1486: $template .=
1487: "<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1488: "<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
1.172 www 1489: }
1490:
1491: # Add the graphic
1.179 matthew 1492: my $title = &mt('Report a Bug');
1.215 albertel 1493: my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
1.172 www 1494: $template .= <<"ENDTEMPLATE";
1.436 albertel 1495: <a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
1.172 www 1496: ENDTEMPLATE
1497: if ($text ne '') { $template.='</td></tr></table>' };
1498: return $template;
1499:
1500: }
1501:
1502: sub help_open_faq {
1503: my ($topic, $text, $stayOnPage, $width, $height) = @_;
1.258 albertel 1504: unless ($env{'user.adv'}) { return ''; }
1.172 www 1505: unless ($Apache::lonnet::perlvar{'FAQHost'}) { return ''; }
1506: $text = "" if (not defined $text);
1507: $stayOnPage=1;
1508: $width = 350 if (not defined $width);
1509: $height = 400 if (not defined $height);
1510:
1511: $topic=~s/\W+/\+/g;
1512: my $link='';
1513: my $template='';
1514: my $url=$Apache::lonnet::perlvar{'FAQHost'}.'/fom/cache/'.$topic.'.html';
1515: if (!$stayOnPage)
1516: {
1517: $link = "javascript:void(open('$url', 'FAQ-O-Matic', 'menubar=0,toolbar=1,scrollbars=1,width=$width,height=$height,resizable=yes'))";
1518: }
1519: else
1520: {
1521: $link = $url;
1522: }
1523:
1524: # Add the text
1525: if ($text ne "")
1526: {
1527: $template .=
1.173 www 1528: "<table bgcolor='#337733' cellspacing='1' cellpadding='1' border='0'><tr>".
1.705 tempelho 1529: "<td bgcolor='#448844'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF; font-size:10pt;\">$text</span></a>";
1.172 www 1530: }
1531:
1532: # Add the graphic
1.179 matthew 1533: my $title = &mt('View the FAQ');
1.215 albertel 1534: my $faqicon=&lonhttpdurl("/adm/lonMisc/smallFAQ.gif");
1.172 www 1535: $template .= <<"ENDTEMPLATE";
1.436 albertel 1536: <a target="_top" href="$link" title="$title"><img src="$faqicon" border="0" alt="(FAQ: $topic)" /></a>
1.172 www 1537: ENDTEMPLATE
1538: if ($text ne '') { $template.='</td></tr></table>' };
1539: return $template;
1540:
1.44 bowersj2 1541: }
1.37 matthew 1542:
1.180 matthew 1543: ###############################################################
1544: ###############################################################
1545:
1.45 matthew 1546: =pod
1547:
1.648 raeburn 1548: =item * &change_content_javascript():
1.256 matthew 1549:
1550: This and the next function allow you to create small sections of an
1551: otherwise static HTML page that you can update on the fly with
1552: Javascript, even in Netscape 4.
1553:
1554: The Javascript fragment returned by this function (no E<lt>scriptE<gt> tag)
1555: must be written to the HTML page once. It will prove the Javascript
1556: function "change(name, content)". Calling the change function with the
1557: name of the section
1558: you want to update, matching the name passed to C<changable_area>, and
1559: the new content you want to put in there, will put the content into
1560: that area.
1561:
1562: B<Note>: Netscape 4 only reserves enough space for the changable area
1563: to contain room for the original contents. You need to "make space"
1564: for whatever changes you wish to make, and be B<sure> to check your
1565: code in Netscape 4. This feature in Netscape 4 is B<not> powerful;
1566: it's adequate for updating a one-line status display, but little more.
1567: This script will set the space to 100% width, so you only need to
1568: worry about height in Netscape 4.
1569:
1570: Modern browsers are much less limiting, and if you can commit to the
1571: user not using Netscape 4, this feature may be used freely with
1572: pretty much any HTML.
1573:
1574: =cut
1575:
1576: sub change_content_javascript {
1577: # If we're on Netscape 4, we need to use Layer-based code
1.258 albertel 1578: if ($env{'browser.type'} eq 'netscape' &&
1579: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1580: return (<<NETSCAPE4);
1581: function change(name, content) {
1582: doc = document.layers[name+"___escape"].layers[0].document;
1583: doc.open();
1584: doc.write(content);
1585: doc.close();
1586: }
1587: NETSCAPE4
1588: } else {
1589: # Otherwise, we need to use semi-standards-compliant code
1590: # (technically, "innerHTML" isn't standard but the equivalent
1591: # is really scary, and every useful browser supports it
1592: return (<<DOMBASED);
1593: function change(name, content) {
1594: element = document.getElementById(name);
1595: element.innerHTML = content;
1596: }
1597: DOMBASED
1598: }
1599: }
1600:
1601: =pod
1602:
1.648 raeburn 1603: =item * &changable_area($name,$origContent):
1.256 matthew 1604:
1605: This provides a "changable area" that can be modified on the fly via
1606: the Javascript code provided in C<change_content_javascript>. $name is
1607: the name you will use to reference the area later; do not repeat the
1608: same name on a given HTML page more then once. $origContent is what
1609: the area will originally contain, which can be left blank.
1610:
1611: =cut
1612:
1613: sub changable_area {
1614: my ($name, $origContent) = @_;
1615:
1.258 albertel 1616: if ($env{'browser.type'} eq 'netscape' &&
1617: $env{'browser.version'} =~ /^4\./) {
1.256 matthew 1618: # If this is netscape 4, we need to use the Layer tag
1619: return "<ilayer width='100%' id='${name}___escape' overflow='none'><layer width='100%' id='$name' overflow='none'>$origContent</layer></ilayer>";
1620: } else {
1621: return "<span id='$name'>$origContent</span>";
1622: }
1623: }
1624:
1625: =pod
1626:
1.648 raeburn 1627: =item * &viewport_geometry_js
1.590 raeburn 1628:
1629: Provides javascript object (Geometry) which can provide information about the viewport geometry for the client browser.
1630:
1631: =cut
1632:
1633:
1634: sub viewport_geometry_js {
1635: return <<"GEOMETRY";
1636: var Geometry = {};
1637: function init_geometry() {
1638: if (Geometry.init) { return };
1639: Geometry.init=1;
1640: if (window.innerHeight) {
1641: Geometry.getViewportHeight = function() { return window.innerHeight; };
1642: Geometry.getViewportWidth = function() { return window.innerWidth; };
1643: Geometry.getHorizontalScroll = function() { return window.pageXOffset; };
1644: Geometry.getVerticalScroll = function() { return window.pageYOffset; };
1645: }
1646: else if (document.documentElement && document.documentElement.clientHeight) {
1647: Geometry.getViewportHeight =
1648: function() { return document.documentElement.clientHeight; };
1649: Geometry.getViewportWidth =
1650: function() { return document.documentElement.clientWidth; };
1651:
1652: Geometry.getHorizontalScroll =
1653: function() { return document.documentElement.scrollLeft; };
1654: Geometry.getVerticalScroll =
1655: function() { return document.documentElement.scrollTop; };
1656: }
1657: else if (document.body.clientHeight) {
1658: Geometry.getViewportHeight =
1659: function() { return document.body.clientHeight; };
1660: Geometry.getViewportWidth =
1661: function() { return document.body.clientWidth; };
1662: Geometry.getHorizontalScroll =
1663: function() { return document.body.scrollLeft; };
1664: Geometry.getVerticalScroll =
1665: function() { return document.body.scrollTop; };
1666: }
1667: }
1668:
1669: GEOMETRY
1670: }
1671:
1672: =pod
1673:
1.648 raeburn 1674: =item * &viewport_size_js()
1.590 raeburn 1675:
1676: 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.
1677:
1678: =cut
1679:
1680: sub viewport_size_js {
1681: my $geometry = &viewport_geometry_js();
1682: return <<"DIMS";
1683:
1684: $geometry
1685:
1686: function getViewportDims(width,height) {
1687: init_geometry();
1688: width.value = Geometry.getViewportWidth();
1689: height.value = Geometry.getViewportHeight();
1690: return;
1691: }
1692:
1693: DIMS
1694: }
1695:
1696: =pod
1697:
1.648 raeburn 1698: =item * &resize_textarea_js()
1.565 albertel 1699:
1700: emits the needed javascript to resize a textarea to be as big as possible
1701:
1702: creates a function resize_textrea that takes two IDs first should be
1703: the id of the element to resize, second should be the id of a div that
1704: surrounds everything that comes after the textarea, this routine needs
1705: to be attached to the <body> for the onload and onresize events.
1706:
1.648 raeburn 1707: =back
1.565 albertel 1708:
1709: =cut
1710:
1711: sub resize_textarea_js {
1.590 raeburn 1712: my $geometry = &viewport_geometry_js();
1.565 albertel 1713: return <<"RESIZE";
1714: <script type="text/javascript">
1.824 bisitz 1715: // <![CDATA[
1.590 raeburn 1716: $geometry
1.565 albertel 1717:
1.588 albertel 1718: function getX(element) {
1719: var x = 0;
1720: while (element) {
1721: x += element.offsetLeft;
1722: element = element.offsetParent;
1723: }
1724: return x;
1725: }
1726: function getY(element) {
1727: var y = 0;
1728: while (element) {
1729: y += element.offsetTop;
1730: element = element.offsetParent;
1731: }
1732: return y;
1733: }
1734:
1735:
1.565 albertel 1736: function resize_textarea(textarea_id,bottom_id) {
1737: init_geometry();
1738: var textarea = document.getElementById(textarea_id);
1739: //alert(textarea);
1740:
1.588 albertel 1741: var textarea_top = getY(textarea);
1.565 albertel 1742: var textarea_height = textarea.offsetHeight;
1743: var bottom = document.getElementById(bottom_id);
1.588 albertel 1744: var bottom_top = getY(bottom);
1.565 albertel 1745: var bottom_height = bottom.offsetHeight;
1746: var window_height = Geometry.getViewportHeight();
1.588 albertel 1747: var fudge = 23;
1.565 albertel 1748: var new_height = window_height-fudge-textarea_top-bottom_height;
1749: if (new_height < 300) {
1750: new_height = 300;
1751: }
1752: textarea.style.height=new_height+'px';
1753: }
1.824 bisitz 1754: // ]]>
1.565 albertel 1755: </script>
1756: RESIZE
1757:
1758: }
1759:
1760: =pod
1761:
1.256 matthew 1762: =head1 Excel and CSV file utility routines
1763:
1764: =cut
1765:
1766: ###############################################################
1767: ###############################################################
1768:
1769: =pod
1770:
1.1162 raeburn 1771: =over 4
1772:
1.648 raeburn 1773: =item * &csv_translate($text)
1.37 matthew 1774:
1.185 www 1775: Translate $text to allow it to be output as a 'comma separated values'
1.37 matthew 1776: format.
1777:
1778: =cut
1779:
1.180 matthew 1780: ###############################################################
1781: ###############################################################
1.37 matthew 1782: sub csv_translate {
1783: my $text = shift;
1784: $text =~ s/\"/\"\"/g;
1.209 albertel 1785: $text =~ s/\n/ /g;
1.37 matthew 1786: return $text;
1787: }
1.180 matthew 1788:
1789: ###############################################################
1790: ###############################################################
1791:
1792: =pod
1793:
1.648 raeburn 1794: =item * &define_excel_formats()
1.180 matthew 1795:
1796: Define some commonly used Excel cell formats.
1797:
1798: Currently supported formats:
1799:
1800: =over 4
1801:
1802: =item header
1803:
1804: =item bold
1805:
1806: =item h1
1807:
1808: =item h2
1809:
1810: =item h3
1811:
1.256 matthew 1812: =item h4
1813:
1814: =item i
1815:
1.180 matthew 1816: =item date
1817:
1818: =back
1819:
1820: Inputs: $workbook
1821:
1822: Returns: $format, a hash reference.
1823:
1.1057 foxr 1824:
1.180 matthew 1825: =cut
1826:
1827: ###############################################################
1828: ###############################################################
1829: sub define_excel_formats {
1830: my ($workbook) = @_;
1831: my $format;
1832: $format->{'header'} = $workbook->add_format(bold => 1,
1833: bottom => 1,
1834: align => 'center');
1835: $format->{'bold'} = $workbook->add_format(bold=>1);
1836: $format->{'h1'} = $workbook->add_format(bold=>1, size=>18);
1837: $format->{'h2'} = $workbook->add_format(bold=>1, size=>16);
1838: $format->{'h3'} = $workbook->add_format(bold=>1, size=>14);
1.255 matthew 1839: $format->{'h4'} = $workbook->add_format(bold=>1, size=>12);
1.246 matthew 1840: $format->{'i'} = $workbook->add_format(italic=>1);
1.180 matthew 1841: $format->{'date'} = $workbook->add_format(num_format=>
1.207 matthew 1842: 'mm/dd/yyyy hh:mm:ss');
1.180 matthew 1843: return $format;
1844: }
1845:
1846: ###############################################################
1847: ###############################################################
1.113 bowersj2 1848:
1849: =pod
1850:
1.648 raeburn 1851: =item * &create_workbook()
1.255 matthew 1852:
1853: Create an Excel worksheet. If it fails, output message on the
1854: request object and return undefs.
1855:
1856: Inputs: Apache request object
1857:
1858: Returns (undef) on failure,
1859: Excel worksheet object, scalar with filename, and formats
1860: from &Apache::loncommon::define_excel_formats on success
1861:
1862: =cut
1863:
1864: ###############################################################
1865: ###############################################################
1866: sub create_workbook {
1867: my ($r) = @_;
1868: #
1869: # Create the excel spreadsheet
1870: my $filename = '/prtspool/'.
1.258 albertel 1871: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.255 matthew 1872: time.'_'.rand(1000000000).'.xls';
1873: my $workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename);
1874: if (! defined($workbook)) {
1875: $r->log_error("Error creating excel spreadsheet $filename: $!");
1.928 bisitz 1876: $r->print(
1877: '<p class="LC_error">'
1878: .&mt('Problems occurred in creating the new Excel file.')
1879: .' '.&mt('This error has been logged.')
1880: .' '.&mt('Please alert your LON-CAPA administrator.')
1881: .'</p>'
1882: );
1.255 matthew 1883: return (undef);
1884: }
1885: #
1.1014 foxr 1886: $workbook->set_tempdir(LONCAPA::tempdir());
1.255 matthew 1887: #
1888: my $format = &Apache::loncommon::define_excel_formats($workbook);
1889: return ($workbook,$filename,$format);
1890: }
1891:
1892: ###############################################################
1893: ###############################################################
1894:
1895: =pod
1896:
1.648 raeburn 1897: =item * &create_text_file()
1.113 bowersj2 1898:
1.542 raeburn 1899: Create a file to write to and eventually make available to the user.
1.256 matthew 1900: If file creation fails, outputs an error message on the request object and
1901: return undefs.
1.113 bowersj2 1902:
1.256 matthew 1903: Inputs: Apache request object, and file suffix
1.113 bowersj2 1904:
1.256 matthew 1905: Returns (undef) on failure,
1906: Filehandle and filename on success.
1.113 bowersj2 1907:
1908: =cut
1909:
1.256 matthew 1910: ###############################################################
1911: ###############################################################
1912: sub create_text_file {
1913: my ($r,$suffix) = @_;
1914: if (! defined($suffix)) { $suffix = 'txt'; };
1915: my $fh;
1916: my $filename = '/prtspool/'.
1.258 albertel 1917: $env{'user.name'}.'_'.$env{'user.domain'}.'_'.
1.256 matthew 1918: time.'_'.rand(1000000000).'.'.$suffix;
1919: $fh = Apache::File->new('>/home/httpd'.$filename);
1920: if (! defined($fh)) {
1921: $r->log_error("Couldn't open $filename for output $!");
1.928 bisitz 1922: $r->print(
1923: '<p class="LC_error">'
1924: .&mt('Problems occurred in creating the output file.')
1925: .' '.&mt('This error has been logged.')
1926: .' '.&mt('Please alert your LON-CAPA administrator.')
1927: .'</p>'
1928: );
1.113 bowersj2 1929: }
1.256 matthew 1930: return ($fh,$filename)
1.113 bowersj2 1931: }
1932:
1933:
1.256 matthew 1934: =pod
1.113 bowersj2 1935:
1936: =back
1937:
1938: =cut
1.37 matthew 1939:
1940: ###############################################################
1.33 matthew 1941: ## Home server <option> list generating code ##
1942: ###############################################################
1.35 matthew 1943:
1.169 www 1944: # ------------------------------------------
1945:
1946: sub domain_select {
1947: my ($name,$value,$multiple)=@_;
1948: my %domains=map {
1.514 albertel 1949: $_ => $_.' '. &Apache::lonnet::domain($_,'description')
1.512 albertel 1950: } &Apache::lonnet::all_domains();
1.169 www 1951: if ($multiple) {
1952: $domains{''}=&mt('Any domain');
1.550 albertel 1953: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.287 albertel 1954: return &multiple_select_form($name,$value,4,\%domains);
1.169 www 1955: } else {
1.550 albertel 1956: $domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
1.970 raeburn 1957: return &select_form($name,$value,\%domains);
1.169 www 1958: }
1959: }
1960:
1.282 albertel 1961: #-------------------------------------------
1962:
1963: =pod
1964:
1.519 raeburn 1965: =head1 Routines for form select boxes
1966:
1967: =over 4
1968:
1.648 raeburn 1969: =item * &multiple_select_form($name,$value,$size,$hash,$order)
1.282 albertel 1970:
1971: Returns a string containing a <select> element int multiple mode
1972:
1973:
1974: Args:
1975: $name - name of the <select> element
1.506 raeburn 1976: $value - scalar or array ref of values that should already be selected
1.282 albertel 1977: $size - number of rows long the select element is
1.283 albertel 1978: $hash - the elements should be 'option' => 'shown text'
1.282 albertel 1979: (shown text should already have been &mt())
1.506 raeburn 1980: $order - (optional) array ref of the order to show the elements in
1.283 albertel 1981:
1.282 albertel 1982: =cut
1983:
1984: #-------------------------------------------
1.169 www 1985: sub multiple_select_form {
1.284 albertel 1986: my ($name,$value,$size,$hash,$order)=@_;
1.169 www 1987: my %selected = map { $_ => 1 } ref($value)?@{$value}:($value);
1988: my $output='';
1.191 matthew 1989: if (! defined($size)) {
1990: $size = 4;
1.283 albertel 1991: if (scalar(keys(%$hash))<4) {
1992: $size = scalar(keys(%$hash));
1.191 matthew 1993: }
1994: }
1.734 bisitz 1995: $output.="\n".'<select name="'.$name.'" size="'.$size.'" multiple="multiple">';
1.501 banghart 1996: my @order;
1.506 raeburn 1997: if (ref($order) eq 'ARRAY') {
1998: @order = @{$order};
1999: } else {
2000: @order = sort(keys(%$hash));
1.501 banghart 2001: }
2002: if (exists($$hash{'select_form_order'})) {
2003: @order = @{$$hash{'select_form_order'}};
2004: }
2005:
1.284 albertel 2006: foreach my $key (@order) {
1.356 albertel 2007: $output.='<option value="'.&HTML::Entities::encode($key,'"<>&').'" ';
1.284 albertel 2008: $output.='selected="selected" ' if ($selected{$key});
2009: $output.='>'.$hash->{$key}."</option>\n";
1.169 www 2010: }
2011: $output.="</select>\n";
2012: return $output;
2013: }
2014:
1.88 www 2015: #-------------------------------------------
2016:
2017: =pod
2018:
1.970 raeburn 2019: =item * &select_form($defdom,$name,$hashref,$onchange)
1.88 www 2020:
2021: Returns a string containing a <select name='$name' size='1'> form to
1.970 raeburn 2022: allow a user to select options from a ref to a hash containing:
2023: option_name => displayed text. An optional $onchange can include
2024: a javascript onchange item, e.g., onchange="this.form.submit();"
2025:
1.88 www 2026: See lonrights.pm for an example invocation and use.
2027:
2028: =cut
2029:
2030: #-------------------------------------------
2031: sub select_form {
1.970 raeburn 2032: my ($def,$name,$hashref,$onchange) = @_;
2033: return unless (ref($hashref) eq 'HASH');
2034: if ($onchange) {
2035: $onchange = ' onchange="'.$onchange.'"';
2036: }
2037: my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.128 albertel 2038: my @keys;
1.970 raeburn 2039: if (exists($hashref->{'select_form_order'})) {
2040: @keys=@{$hashref->{'select_form_order'}};
1.128 albertel 2041: } else {
1.970 raeburn 2042: @keys=sort(keys(%{$hashref}));
1.128 albertel 2043: }
1.356 albertel 2044: foreach my $key (@keys) {
2045: $selectform.=
2046: '<option value="'.&HTML::Entities::encode($key,'"<>&').'" '.
2047: ($key eq $def ? 'selected="selected" ' : '').
1.970 raeburn 2048: ">".$hashref->{$key}."</option>\n";
1.88 www 2049: }
2050: $selectform.="</select>";
2051: return $selectform;
2052: }
2053:
1.475 www 2054: # For display filters
2055:
2056: sub display_filter {
1.1074 raeburn 2057: my ($context) = @_;
1.475 www 2058: if (!$env{'form.show'}) { $env{'form.show'}=10; }
1.477 www 2059: if (!$env{'form.displayfilter'}) { $env{'form.displayfilter'}='currentfolder'; }
1.1074 raeburn 2060: my $phraseinput = 'hidden';
2061: my $includeinput = 'hidden';
2062: my ($checked,$includetypestext);
2063: if ($env{'form.displayfilter'} eq 'containing') {
2064: $phraseinput = 'text';
2065: if ($context eq 'parmslog') {
2066: $includeinput = 'checkbox';
2067: if ($env{'form.includetypes'}) {
2068: $checked = ' checked="checked"';
2069: }
2070: $includetypestext = &mt('Include parameter types');
2071: }
2072: } else {
2073: $includetypestext = ' ';
2074: }
2075: my ($additional,$secondid,$thirdid);
2076: if ($context eq 'parmslog') {
2077: $additional =
2078: '<label><input type="'.$includeinput.'" name="includetypes"'.
2079: $checked.' name="includetypes" value="1" id="includetypes" />'.
2080: ' <span id="includetypestext">'.$includetypestext.'</span>'.
2081: '</label>';
2082: $secondid = 'includetypes';
2083: $thirdid = 'includetypestext';
2084: }
2085: my $onchange = "javascript:toggleHistoryOptions(this,'containingphrase','$context',
2086: '$secondid','$thirdid')";
2087: return '<span class="LC_nobreak"><label>'.&mt('Records: [_1]',
1.475 www 2088: &Apache::lonmeta::selectbox('show',$env{'form.show'},undef,
2089: (&mt('all'),10,20,50,100,1000,10000))).
1.714 bisitz 2090: '</label></span> <span class="LC_nobreak">'.
1.1074 raeburn 2091: &mt('Filter: [_1]',
1.477 www 2092: &select_form($env{'form.displayfilter'},
2093: 'displayfilter',
1.970 raeburn 2094: {'currentfolder' => 'Current folder/page',
1.477 www 2095: 'containing' => 'Containing phrase',
1.1074 raeburn 2096: 'none' => 'None'},$onchange)).' '.
2097: '<input type="'.$phraseinput.'" name="containingphrase" id="containingphrase" size="30" value="'.
2098: &HTML::Entities::encode($env{'form.containingphrase'}).
2099: '" />'.$additional;
2100: }
2101:
2102: sub display_filter_js {
2103: my $includetext = &mt('Include parameter types');
2104: return <<"ENDJS";
2105:
2106: function toggleHistoryOptions(setter,firstid,context,secondid,thirdid) {
2107: var firstType = 'hidden';
2108: if (setter.options[setter.selectedIndex].value == 'containing') {
2109: firstType = 'text';
2110: }
2111: firstObject = document.getElementById(firstid);
2112: if (typeof(firstObject) == 'object') {
2113: if (firstObject.type != firstType) {
2114: changeInputType(firstObject,firstType);
2115: }
2116: }
2117: if (context == 'parmslog') {
2118: var secondType = 'hidden';
2119: if (firstType == 'text') {
2120: secondType = 'checkbox';
2121: }
2122: secondObject = document.getElementById(secondid);
2123: if (typeof(secondObject) == 'object') {
2124: if (secondObject.type != secondType) {
2125: changeInputType(secondObject,secondType);
2126: }
2127: }
2128: var textItem = document.getElementById(thirdid);
2129: var currtext = textItem.innerHTML;
2130: var newtext;
2131: if (firstType == 'text') {
2132: newtext = '$includetext';
2133: } else {
2134: newtext = ' ';
2135: }
2136: if (currtext != newtext) {
2137: textItem.innerHTML = newtext;
2138: }
2139: }
2140: return;
2141: }
2142:
2143: function changeInputType(oldObject,newType) {
2144: var newObject = document.createElement('input');
2145: newObject.type = newType;
2146: if (oldObject.size) {
2147: newObject.size = oldObject.size;
2148: }
2149: if (oldObject.value) {
2150: newObject.value = oldObject.value;
2151: }
2152: if (oldObject.name) {
2153: newObject.name = oldObject.name;
2154: }
2155: if (oldObject.id) {
2156: newObject.id = oldObject.id;
2157: }
2158: oldObject.parentNode.replaceChild(newObject,oldObject);
2159: return;
2160: }
2161:
2162: ENDJS
1.475 www 2163: }
2164:
1.167 www 2165: sub gradeleveldescription {
2166: my $gradelevel=shift;
2167: my %gradelevels=(0 => 'Not specified',
2168: 1 => 'Grade 1',
2169: 2 => 'Grade 2',
2170: 3 => 'Grade 3',
2171: 4 => 'Grade 4',
2172: 5 => 'Grade 5',
2173: 6 => 'Grade 6',
2174: 7 => 'Grade 7',
2175: 8 => 'Grade 8',
2176: 9 => 'Grade 9',
2177: 10 => 'Grade 10',
2178: 11 => 'Grade 11',
2179: 12 => 'Grade 12',
2180: 13 => 'Grade 13',
2181: 14 => '100 Level',
2182: 15 => '200 Level',
2183: 16 => '300 Level',
2184: 17 => '400 Level',
2185: 18 => 'Graduate Level');
2186: return &mt($gradelevels{$gradelevel});
2187: }
2188:
1.163 www 2189: sub select_level_form {
2190: my ($deflevel,$name)=@_;
2191: unless ($deflevel) { $deflevel=0; }
1.167 www 2192: my $selectform = "<select name=\"$name\" size=\"1\">\n";
2193: for (my $i=0; $i<=18; $i++) {
2194: $selectform.="<option value=\"$i\" ".
1.253 albertel 2195: ($i==$deflevel ? 'selected="selected" ' : '').
1.167 www 2196: ">".&gradeleveldescription($i)."</option>\n";
2197: }
2198: $selectform.="</select>";
2199: return $selectform;
1.163 www 2200: }
1.167 www 2201:
1.35 matthew 2202: #-------------------------------------------
2203:
1.45 matthew 2204: =pod
2205:
1.1121 raeburn 2206: =item * &select_dom_form($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms)
1.35 matthew 2207:
2208: Returns a string containing a <select name='$name' size='1'> form to
2209: allow a user to select the domain to preform an operation in.
2210: See loncreateuser.pm for an example invocation and use.
2211:
1.90 www 2212: If the $includeempty flag is set, it also includes an empty choice ("no domain
2213: selected");
2214:
1.743 raeburn 2215: If the $showdomdesc flag is set, the domain name is followed by the domain description.
2216:
1.910 raeburn 2217: 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.
2218:
1.1121 raeburn 2219: The optional $incdoms is a reference to an array of domains which will be the only available options.
2220:
2221: The optional $excdoms is a reference to an array of domains which will be excluded from the available options.
1.563 raeburn 2222:
1.35 matthew 2223: =cut
2224:
2225: #-------------------------------------------
1.34 matthew 2226: sub select_dom_form {
1.1121 raeburn 2227: my ($defdom,$name,$includeempty,$showdomdesc,$onchange,$incdoms,$excdoms) = @_;
1.872 raeburn 2228: if ($onchange) {
1.874 raeburn 2229: $onchange = ' onchange="'.$onchange.'"';
1.743 raeburn 2230: }
1.1121 raeburn 2231: my (@domains,%exclude);
1.910 raeburn 2232: if (ref($incdoms) eq 'ARRAY') {
2233: @domains = sort {lc($a) cmp lc($b)} (@{$incdoms});
2234: } else {
2235: @domains = sort {lc($a) cmp lc($b)} (&Apache::lonnet::all_domains());
2236: }
1.90 www 2237: if ($includeempty) { @domains=('',@domains); }
1.1121 raeburn 2238: if (ref($excdoms) eq 'ARRAY') {
2239: map { $exclude{$_} = 1; } @{$excdoms};
2240: }
1.743 raeburn 2241: my $selectdomain = "<select name=\"$name\" size=\"1\"$onchange>\n";
1.356 albertel 2242: foreach my $dom (@domains) {
1.1121 raeburn 2243: next if ($exclude{$dom});
1.356 albertel 2244: $selectdomain.="<option value=\"$dom\" ".
1.563 raeburn 2245: ($dom eq $defdom ? 'selected="selected" ' : '').'>'.$dom;
2246: if ($showdomdesc) {
2247: if ($dom ne '') {
2248: my $domdesc = &Apache::lonnet::domain($dom,'description');
2249: if ($domdesc ne '') {
2250: $selectdomain .= ' ('.$domdesc.')';
2251: }
2252: }
2253: }
2254: $selectdomain .= "</option>\n";
1.34 matthew 2255: }
2256: $selectdomain.="</select>";
2257: return $selectdomain;
2258: }
2259:
1.35 matthew 2260: #-------------------------------------------
2261:
1.45 matthew 2262: =pod
2263:
1.648 raeburn 2264: =item * &home_server_form_item($domain,$name,$defaultflag)
1.35 matthew 2265:
1.586 raeburn 2266: input: 4 arguments (two required, two optional) -
2267: $domain - domain of new user
2268: $name - name of form element
2269: $default - Value of 'default' causes a default item to be first
2270: option, and selected by default.
2271: $hide - Value of 'hide' causes hiding of the name of the server,
2272: if 1 server found, or default, if 0 found.
1.594 raeburn 2273: output: returns 2 items:
1.586 raeburn 2274: (a) form element which contains either:
2275: (i) <select name="$name">
2276: <option value="$hostid1">$hostid $servers{$hostid}</option>
2277: <option value="$hostid2">$hostid $servers{$hostid}</option>
2278: </select>
2279: form item if there are multiple library servers in $domain, or
2280: (ii) an <input type="hidden" name="$name" value="$hostid" /> form item
2281: if there is only one library server in $domain.
2282:
2283: (b) number of library servers found.
2284:
2285: See loncreateuser.pm for example of use.
1.35 matthew 2286:
2287: =cut
2288:
2289: #-------------------------------------------
1.586 raeburn 2290: sub home_server_form_item {
2291: my ($domain,$name,$default,$hide) = @_;
1.513 albertel 2292: my %servers = &Apache::lonnet::get_servers($domain,'library');
1.586 raeburn 2293: my $result;
2294: my $numlib = keys(%servers);
2295: if ($numlib > 1) {
2296: $result .= '<select name="'.$name.'" />'."\n";
2297: if ($default) {
1.804 bisitz 2298: $result .= '<option value="default" selected="selected">'.&mt('default').
1.586 raeburn 2299: '</option>'."\n";
2300: }
2301: foreach my $hostid (sort(keys(%servers))) {
2302: $result.= '<option value="'.$hostid.'">'.
2303: $hostid.' '.$servers{$hostid}."</option>\n";
2304: }
2305: $result .= '</select>'."\n";
2306: } elsif ($numlib == 1) {
2307: my $hostid;
2308: foreach my $item (keys(%servers)) {
2309: $hostid = $item;
2310: }
2311: $result .= '<input type="hidden" name="'.$name.'" value="'.
2312: $hostid.'" />';
2313: if (!$hide) {
2314: $result .= $hostid.' '.$servers{$hostid};
2315: }
2316: $result .= "\n";
2317: } elsif ($default) {
2318: $result .= '<input type="hidden" name="'.$name.
2319: '" value="default" />';
2320: if (!$hide) {
2321: $result .= &mt('default');
2322: }
2323: $result .= "\n";
1.33 matthew 2324: }
1.586 raeburn 2325: return ($result,$numlib);
1.33 matthew 2326: }
1.112 bowersj2 2327:
2328: =pod
2329:
1.534 albertel 2330: =back
2331:
1.112 bowersj2 2332: =cut
1.87 matthew 2333:
2334: ###############################################################
1.112 bowersj2 2335: ## Decoding User Agent ##
1.87 matthew 2336: ###############################################################
2337:
2338: =pod
2339:
1.112 bowersj2 2340: =head1 Decoding the User Agent
2341:
2342: =over 4
2343:
2344: =item * &decode_user_agent()
1.87 matthew 2345:
2346: Inputs: $r
2347:
2348: Outputs:
2349:
2350: =over 4
2351:
1.112 bowersj2 2352: =item * $httpbrowser
1.87 matthew 2353:
1.112 bowersj2 2354: =item * $clientbrowser
1.87 matthew 2355:
1.112 bowersj2 2356: =item * $clientversion
1.87 matthew 2357:
1.112 bowersj2 2358: =item * $clientmathml
1.87 matthew 2359:
1.112 bowersj2 2360: =item * $clientunicode
1.87 matthew 2361:
1.112 bowersj2 2362: =item * $clientos
1.87 matthew 2363:
1.1137 raeburn 2364: =item * $clientmobile
2365:
1.1141 raeburn 2366: =item * $clientinfo
2367:
1.1194 raeburn 2368: =item * $clientosversion
2369:
1.87 matthew 2370: =back
2371:
1.157 matthew 2372: =back
2373:
1.87 matthew 2374: =cut
2375:
2376: ###############################################################
2377: ###############################################################
2378: sub decode_user_agent {
1.247 albertel 2379: my ($r)=@_;
1.87 matthew 2380: my @browsertype=split(/\&/,$Apache::lonnet::perlvar{"lonBrowsDet"});
2381: my %mathcap=split(/\&/,$$Apache::lonnet::perlvar{"lonMathML"});
2382: my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
1.247 albertel 2383: if (!$httpbrowser && $r) { $httpbrowser=$r->header_in('User-Agent'); }
1.87 matthew 2384: my $clientbrowser='unknown';
2385: my $clientversion='0';
2386: my $clientmathml='';
2387: my $clientunicode='0';
1.1137 raeburn 2388: my $clientmobile=0;
1.1194 raeburn 2389: my $clientosversion='';
1.87 matthew 2390: for (my $i=0;$i<=$#browsertype;$i++) {
1.1193 raeburn 2391: my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\%/,$browsertype[$i]);
1.87 matthew 2392: if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) {
2393: $clientbrowser=$bname;
2394: $httpbrowser=~/$vreg/i;
2395: $clientversion=$1;
2396: $clientmathml=($clientversion>=$minv);
2397: $clientunicode=($clientversion>=$univ);
2398: }
2399: }
2400: my $clientos='unknown';
1.1141 raeburn 2401: my $clientinfo;
1.87 matthew 2402: if (($httpbrowser=~/linux/i) ||
2403: ($httpbrowser=~/unix/i) ||
2404: ($httpbrowser=~/ux/i) ||
2405: ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
2406: if (($httpbrowser=~/vax/i) ||
2407: ($httpbrowser=~/vms/i)) { $clientos='vms'; }
2408: if ($httpbrowser=~/next/i) { $clientos='next'; }
2409: if (($httpbrowser=~/mac/i) ||
2410: ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
1.1194 raeburn 2411: if ($httpbrowser=~/win/i) {
2412: $clientos='win';
2413: if ($httpbrowser =~/Windows\s+NT\s+(\d+\.\d+)/i) {
2414: $clientosversion = $1;
2415: }
2416: }
1.87 matthew 2417: if ($httpbrowser=~/embed/i) { $clientos='pda'; }
1.1137 raeburn 2418: if ($httpbrowser=~/(Android|iPod|iPad|iPhone|webOS|Blackberry|Windows Phone|Opera m(?:ob|in)|Fennec)/i) {
2419: $clientmobile=lc($1);
2420: }
1.1141 raeburn 2421: if ($httpbrowser=~ m{Firefox/(\d+\.\d+)}) {
2422: $clientinfo = 'firefox-'.$1;
2423: } elsif ($httpbrowser=~ m{chromeframe/(\d+\.\d+)\.}) {
2424: $clientinfo = 'chromeframe-'.$1;
2425: }
1.87 matthew 2426: return ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
1.1194 raeburn 2427: $clientunicode,$clientos,$clientmobile,$clientinfo,
2428: $clientosversion);
1.87 matthew 2429: }
2430:
1.32 matthew 2431: ###############################################################
2432: ## Authentication changing form generation subroutines ##
2433: ###############################################################
2434: ##
2435: ## All of the authform_xxxxxxx subroutines take their inputs in a
2436: ## hash, and have reasonable default values.
2437: ##
2438: ## formname = the name given in the <form> tag.
1.35 matthew 2439: #-------------------------------------------
2440:
1.45 matthew 2441: =pod
2442:
1.112 bowersj2 2443: =head1 Authentication Routines
2444:
2445: =over 4
2446:
1.648 raeburn 2447: =item * &authform_xxxxxx()
1.35 matthew 2448:
2449: The authform_xxxxxx subroutines provide javascript and html forms which
2450: handle some of the conveniences required for authentication forms.
2451: This is not an optimal method, but it works.
2452:
2453: =over 4
2454:
1.112 bowersj2 2455: =item * authform_header
1.35 matthew 2456:
1.112 bowersj2 2457: =item * authform_authorwarning
1.35 matthew 2458:
1.112 bowersj2 2459: =item * authform_nochange
1.35 matthew 2460:
1.112 bowersj2 2461: =item * authform_kerberos
1.35 matthew 2462:
1.112 bowersj2 2463: =item * authform_internal
1.35 matthew 2464:
1.112 bowersj2 2465: =item * authform_filesystem
1.35 matthew 2466:
2467: =back
2468:
1.648 raeburn 2469: See loncreateuser.pm for invocation and use examples.
1.157 matthew 2470:
1.35 matthew 2471: =cut
2472:
2473: #-------------------------------------------
1.32 matthew 2474: sub authform_header{
2475: my %in = (
2476: formname => 'cu',
1.80 albertel 2477: kerb_def_dom => '',
1.32 matthew 2478: @_,
2479: );
2480: $in{'formname'} = 'document.' . $in{'formname'};
2481: my $result='';
1.80 albertel 2482:
2483: #---------------------------------------------- Code for upper case translation
2484: my $Javascript_toUpperCase;
2485: unless ($in{kerb_def_dom}) {
2486: $Javascript_toUpperCase =<<"END";
2487: switch (choice) {
2488: case 'krb': currentform.elements[choicearg].value =
2489: currentform.elements[choicearg].value.toUpperCase();
2490: break;
2491: default:
2492: }
2493: END
2494: } else {
2495: $Javascript_toUpperCase = "";
2496: }
2497:
1.165 raeburn 2498: my $radioval = "'nochange'";
1.591 raeburn 2499: if (defined($in{'curr_authtype'})) {
2500: if ($in{'curr_authtype'} ne '') {
2501: $radioval = "'".$in{'curr_authtype'}."arg'";
2502: }
1.174 matthew 2503: }
1.165 raeburn 2504: my $argfield = 'null';
1.591 raeburn 2505: if (defined($in{'mode'})) {
1.165 raeburn 2506: if ($in{'mode'} eq 'modifycourse') {
1.591 raeburn 2507: if (defined($in{'curr_autharg'})) {
2508: if ($in{'curr_autharg'} ne '') {
1.165 raeburn 2509: $argfield = "'$in{'curr_autharg'}'";
2510: }
2511: }
2512: }
2513: }
2514:
1.32 matthew 2515: $result.=<<"END";
2516: var current = new Object();
1.165 raeburn 2517: current.radiovalue = $radioval;
2518: current.argfield = $argfield;
1.32 matthew 2519:
2520: function changed_radio(choice,currentform) {
2521: var choicearg = choice + 'arg';
2522: // If a radio button in changed, we need to change the argfield
2523: if (current.radiovalue != choice) {
2524: current.radiovalue = choice;
2525: if (current.argfield != null) {
2526: currentform.elements[current.argfield].value = '';
2527: }
2528: if (choice == 'nochange') {
2529: current.argfield = null;
2530: } else {
2531: current.argfield = choicearg;
2532: switch(choice) {
2533: case 'krb':
2534: currentform.elements[current.argfield].value =
2535: "$in{'kerb_def_dom'}";
2536: break;
2537: default:
2538: break;
2539: }
2540: }
2541: }
2542: return;
2543: }
1.22 www 2544:
1.32 matthew 2545: function changed_text(choice,currentform) {
2546: var choicearg = choice + 'arg';
2547: if (currentform.elements[choicearg].value !='') {
1.80 albertel 2548: $Javascript_toUpperCase
1.32 matthew 2549: // clear old field
2550: if ((current.argfield != choicearg) && (current.argfield != null)) {
2551: currentform.elements[current.argfield].value = '';
2552: }
2553: current.argfield = choicearg;
2554: }
2555: set_auth_radio_buttons(choice,currentform);
2556: return;
1.20 www 2557: }
1.32 matthew 2558:
2559: function set_auth_radio_buttons(newvalue,currentform) {
1.986 raeburn 2560: var numauthchoices = currentform.login.length;
2561: if (typeof numauthchoices == "undefined") {
2562: return;
2563: }
1.32 matthew 2564: var i=0;
1.986 raeburn 2565: while (i < numauthchoices) {
1.32 matthew 2566: if (currentform.login[i].value == newvalue) { break; }
2567: i++;
2568: }
1.986 raeburn 2569: if (i == numauthchoices) {
1.32 matthew 2570: return;
2571: }
2572: current.radiovalue = newvalue;
2573: currentform.login[i].checked = true;
2574: return;
2575: }
2576: END
2577: return $result;
2578: }
2579:
1.1106 raeburn 2580: sub authform_authorwarning {
1.32 matthew 2581: my $result='';
1.144 matthew 2582: $result='<i>'.
2583: &mt('As a general rule, only authors or co-authors should be '.
2584: 'filesystem authenticated '.
2585: '(which allows access to the server filesystem).')."</i>\n";
1.32 matthew 2586: return $result;
2587: }
2588:
1.1106 raeburn 2589: sub authform_nochange {
1.32 matthew 2590: my %in = (
2591: formname => 'document.cu',
2592: kerb_def_dom => 'MSU.EDU',
2593: @_,
2594: );
1.1106 raeburn 2595: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.586 raeburn 2596: my $result;
1.1104 raeburn 2597: if (!$authnum) {
1.1105 raeburn 2598: $result = &mt('Under your current role you are not permitted to change login settings for this user');
1.586 raeburn 2599: } else {
2600: $result = '<label>'.&mt('[_1] Do not change login data',
2601: '<input type="radio" name="login" value="nochange" '.
2602: 'checked="checked" onclick="'.
1.281 albertel 2603: "javascript:changed_radio('nochange',$in{'formname'});".'" />').
2604: '</label>';
1.586 raeburn 2605: }
1.32 matthew 2606: return $result;
2607: }
2608:
1.591 raeburn 2609: sub authform_kerberos {
1.32 matthew 2610: my %in = (
2611: formname => 'document.cu',
2612: kerb_def_dom => 'MSU.EDU',
1.80 albertel 2613: kerb_def_auth => 'krb4',
1.32 matthew 2614: @_,
2615: );
1.586 raeburn 2616: my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
2617: $autharg,$jscall);
1.1106 raeburn 2618: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.80 albertel 2619: if ($in{'kerb_def_auth'} eq 'krb5') {
1.772 bisitz 2620: $check5 = ' checked="checked"';
1.80 albertel 2621: } else {
1.772 bisitz 2622: $check4 = ' checked="checked"';
1.80 albertel 2623: }
1.165 raeburn 2624: $krbarg = $in{'kerb_def_dom'};
1.591 raeburn 2625: if (defined($in{'curr_authtype'})) {
2626: if ($in{'curr_authtype'} eq 'krb') {
1.772 bisitz 2627: $krbcheck = ' checked="checked"';
1.623 raeburn 2628: if (defined($in{'mode'})) {
2629: if ($in{'mode'} eq 'modifyuser') {
2630: $krbcheck = '';
2631: }
2632: }
1.591 raeburn 2633: if (defined($in{'curr_kerb_ver'})) {
2634: if ($in{'curr_krb_ver'} eq '5') {
1.772 bisitz 2635: $check5 = ' checked="checked"';
1.591 raeburn 2636: $check4 = '';
2637: } else {
1.772 bisitz 2638: $check4 = ' checked="checked"';
1.591 raeburn 2639: $check5 = '';
2640: }
1.586 raeburn 2641: }
1.591 raeburn 2642: if (defined($in{'curr_autharg'})) {
1.165 raeburn 2643: $krbarg = $in{'curr_autharg'};
2644: }
1.586 raeburn 2645: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
1.591 raeburn 2646: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2647: $result =
2648: &mt('Currently Kerberos authenticated with domain [_1] Version [_2].',
2649: $in{'curr_autharg'},$krbver);
2650: } else {
2651: $result =
2652: &mt('Currently Kerberos authenticated, Version [_1].',$krbver);
2653: }
2654: return $result;
2655: }
2656: }
2657: } else {
2658: if ($authnum == 1) {
1.784 bisitz 2659: $authtype = '<input type="hidden" name="login" value="krb" />';
1.165 raeburn 2660: }
2661: }
1.586 raeburn 2662: if (!$can_assign{'krb4'} && !$can_assign{'krb5'}) {
2663: return;
1.587 raeburn 2664: } elsif ($authtype eq '') {
1.591 raeburn 2665: if (defined($in{'mode'})) {
1.587 raeburn 2666: if ($in{'mode'} eq 'modifycourse') {
2667: if ($authnum == 1) {
1.1104 raeburn 2668: $authtype = '<input type="radio" name="login" value="krb" />';
1.587 raeburn 2669: }
2670: }
2671: }
1.586 raeburn 2672: }
2673: $jscall = "javascript:changed_radio('krb',$in{'formname'});";
2674: if ($authtype eq '') {
2675: $authtype = '<input type="radio" name="login" value="krb" '.
2676: 'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
2677: $krbcheck.' />';
2678: }
2679: if (($can_assign{'krb4'} && $can_assign{'krb5'}) ||
1.1106 raeburn 2680: ($can_assign{'krb4'} && !$can_assign{'krb5'} &&
1.586 raeburn 2681: $in{'curr_authtype'} eq 'krb5') ||
1.1106 raeburn 2682: (!$can_assign{'krb4'} && $can_assign{'krb5'} &&
1.586 raeburn 2683: $in{'curr_authtype'} eq 'krb4')) {
2684: $result .= &mt
1.144 matthew 2685: ('[_1] Kerberos authenticated with domain [_2] '.
1.281 albertel 2686: '[_3] Version 4 [_4] Version 5 [_5]',
1.586 raeburn 2687: '<label>'.$authtype,
1.281 albertel 2688: '</label><input type="text" size="10" name="krbarg" '.
1.165 raeburn 2689: 'value="'.$krbarg.'" '.
1.144 matthew 2690: 'onchange="'.$jscall.'" />',
1.281 albertel 2691: '<label><input type="radio" name="krbver" value="4" '.$check4.' />',
2692: '</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',
2693: '</label>');
1.586 raeburn 2694: } elsif ($can_assign{'krb4'}) {
2695: $result .= &mt
2696: ('[_1] Kerberos authenticated with domain [_2] '.
2697: '[_3] Version 4 [_4]',
2698: '<label>'.$authtype,
2699: '</label><input type="text" size="10" name="krbarg" '.
2700: 'value="'.$krbarg.'" '.
2701: 'onchange="'.$jscall.'" />',
2702: '<label><input type="hidden" name="krbver" value="4" />',
2703: '</label>');
2704: } elsif ($can_assign{'krb5'}) {
2705: $result .= &mt
2706: ('[_1] Kerberos authenticated with domain [_2] '.
2707: '[_3] Version 5 [_4]',
2708: '<label>'.$authtype,
2709: '</label><input type="text" size="10" name="krbarg" '.
2710: 'value="'.$krbarg.'" '.
2711: 'onchange="'.$jscall.'" />',
2712: '<label><input type="hidden" name="krbver" value="5" />',
2713: '</label>');
2714: }
1.32 matthew 2715: return $result;
2716: }
2717:
1.1106 raeburn 2718: sub authform_internal {
1.586 raeburn 2719: my %in = (
1.32 matthew 2720: formname => 'document.cu',
2721: kerb_def_dom => 'MSU.EDU',
2722: @_,
2723: );
1.586 raeburn 2724: my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2725: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2726: if (defined($in{'curr_authtype'})) {
2727: if ($in{'curr_authtype'} eq 'int') {
1.586 raeburn 2728: if ($can_assign{'int'}) {
1.772 bisitz 2729: $intcheck = 'checked="checked" ';
1.623 raeburn 2730: if (defined($in{'mode'})) {
2731: if ($in{'mode'} eq 'modifyuser') {
2732: $intcheck = '';
2733: }
2734: }
1.591 raeburn 2735: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2736: $intarg = $in{'curr_autharg'};
2737: }
2738: } else {
2739: $result = &mt('Currently internally authenticated.');
2740: return $result;
1.165 raeburn 2741: }
2742: }
1.586 raeburn 2743: } else {
2744: if ($authnum == 1) {
1.784 bisitz 2745: $authtype = '<input type="hidden" name="login" value="int" />';
1.586 raeburn 2746: }
2747: }
2748: if (!$can_assign{'int'}) {
2749: return;
1.587 raeburn 2750: } elsif ($authtype eq '') {
1.591 raeburn 2751: if (defined($in{'mode'})) {
1.587 raeburn 2752: if ($in{'mode'} eq 'modifycourse') {
2753: if ($authnum == 1) {
1.1104 raeburn 2754: $authtype = '<input type="radio" name="login" value="int" />';
1.587 raeburn 2755: }
2756: }
2757: }
1.165 raeburn 2758: }
1.586 raeburn 2759: $jscall = "javascript:changed_radio('int',$in{'formname'});";
2760: if ($authtype eq '') {
2761: $authtype = '<input type="radio" name="login" value="int" '.$intcheck.
2762: ' onchange="'.$jscall.'" onclick="'.$jscall.'" />';
2763: }
1.605 bisitz 2764: $autharg = '<input type="password" size="10" name="intarg" value="'.
1.586 raeburn 2765: $intarg.'" onchange="'.$jscall.'" />';
2766: $result = &mt
1.144 matthew 2767: ('[_1] Internally authenticated (with initial password [_2])',
1.586 raeburn 2768: '<label>'.$authtype,'</label>'.$autharg);
1.824 bisitz 2769: $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 2770: return $result;
2771: }
2772:
1.1104 raeburn 2773: sub authform_local {
1.32 matthew 2774: my %in = (
2775: formname => 'document.cu',
2776: kerb_def_dom => 'MSU.EDU',
2777: @_,
2778: );
1.586 raeburn 2779: my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2780: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2781: if (defined($in{'curr_authtype'})) {
2782: if ($in{'curr_authtype'} eq 'loc') {
1.586 raeburn 2783: if ($can_assign{'loc'}) {
1.772 bisitz 2784: $loccheck = 'checked="checked" ';
1.623 raeburn 2785: if (defined($in{'mode'})) {
2786: if ($in{'mode'} eq 'modifyuser') {
2787: $loccheck = '';
2788: }
2789: }
1.591 raeburn 2790: if (defined($in{'curr_autharg'})) {
1.586 raeburn 2791: $locarg = $in{'curr_autharg'};
2792: }
2793: } else {
2794: $result = &mt('Currently using local (institutional) authentication.');
2795: return $result;
1.165 raeburn 2796: }
2797: }
1.586 raeburn 2798: } else {
2799: if ($authnum == 1) {
1.784 bisitz 2800: $authtype = '<input type="hidden" name="login" value="loc" />';
1.586 raeburn 2801: }
2802: }
2803: if (!$can_assign{'loc'}) {
2804: return;
1.587 raeburn 2805: } elsif ($authtype eq '') {
1.591 raeburn 2806: if (defined($in{'mode'})) {
1.587 raeburn 2807: if ($in{'mode'} eq 'modifycourse') {
2808: if ($authnum == 1) {
1.1104 raeburn 2809: $authtype = '<input type="radio" name="login" value="loc" />';
1.587 raeburn 2810: }
2811: }
2812: }
1.165 raeburn 2813: }
1.586 raeburn 2814: $jscall = "javascript:changed_radio('loc',$in{'formname'});";
2815: if ($authtype eq '') {
2816: $authtype = '<input type="radio" name="login" value="loc" '.
2817: $loccheck.' onchange="'.$jscall.'" onclick="'.
2818: $jscall.'" />';
2819: }
2820: $autharg = '<input type="text" size="10" name="locarg" value="'.
2821: $locarg.'" onchange="'.$jscall.'" />';
2822: $result = &mt('[_1] Local Authentication with argument [_2]',
2823: '<label>'.$authtype,'</label>'.$autharg);
1.32 matthew 2824: return $result;
2825: }
2826:
1.1106 raeburn 2827: sub authform_filesystem {
1.32 matthew 2828: my %in = (
2829: formname => 'document.cu',
2830: kerb_def_dom => 'MSU.EDU',
2831: @_,
2832: );
1.586 raeburn 2833: my ($fsyscheck,$result,$authtype,$autharg,$jscall);
1.1106 raeburn 2834: my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
1.591 raeburn 2835: if (defined($in{'curr_authtype'})) {
2836: if ($in{'curr_authtype'} eq 'fsys') {
1.586 raeburn 2837: if ($can_assign{'fsys'}) {
1.772 bisitz 2838: $fsyscheck = 'checked="checked" ';
1.623 raeburn 2839: if (defined($in{'mode'})) {
2840: if ($in{'mode'} eq 'modifyuser') {
2841: $fsyscheck = '';
2842: }
2843: }
1.586 raeburn 2844: } else {
2845: $result = &mt('Currently Filesystem Authenticated.');
2846: return $result;
2847: }
2848: }
2849: } else {
2850: if ($authnum == 1) {
1.784 bisitz 2851: $authtype = '<input type="hidden" name="login" value="fsys" />';
1.586 raeburn 2852: }
2853: }
2854: if (!$can_assign{'fsys'}) {
2855: return;
1.587 raeburn 2856: } elsif ($authtype eq '') {
1.591 raeburn 2857: if (defined($in{'mode'})) {
1.587 raeburn 2858: if ($in{'mode'} eq 'modifycourse') {
2859: if ($authnum == 1) {
1.1104 raeburn 2860: $authtype = '<input type="radio" name="login" value="fsys" />';
1.587 raeburn 2861: }
2862: }
2863: }
1.586 raeburn 2864: }
2865: $jscall = "javascript:changed_radio('fsys',$in{'formname'});";
2866: if ($authtype eq '') {
2867: $authtype = '<input type="radio" name="login" value="fsys" '.
2868: $fsyscheck.' onchange="'.$jscall.'" onclick="'.
2869: $jscall.'" />';
2870: }
2871: $autharg = '<input type="text" size="10" name="fsysarg" value=""'.
2872: ' onchange="'.$jscall.'" />';
2873: $result = &mt
1.144 matthew 2874: ('[_1] Filesystem Authenticated (with initial password [_2])',
1.281 albertel 2875: '<label><input type="radio" name="login" value="fsys" '.
1.586 raeburn 2876: $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',
1.605 bisitz 2877: '</label><input type="password" size="10" name="fsysarg" value="" '.
1.144 matthew 2878: 'onchange="'.$jscall.'" />');
1.32 matthew 2879: return $result;
2880: }
2881:
1.586 raeburn 2882: sub get_assignable_auth {
2883: my ($dom) = @_;
2884: if ($dom eq '') {
2885: $dom = $env{'request.role.domain'};
2886: }
2887: my %can_assign = (
2888: krb4 => 1,
2889: krb5 => 1,
2890: int => 1,
2891: loc => 1,
2892: );
2893: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
2894: if (ref($domconfig{'usercreation'}) eq 'HASH') {
2895: if (ref($domconfig{'usercreation'}{'authtypes'}) eq 'HASH') {
2896: my $authhash = $domconfig{'usercreation'}{'authtypes'};
2897: my $context;
2898: if ($env{'request.role'} =~ /^au/) {
2899: $context = 'author';
2900: } elsif ($env{'request.role'} =~ /^dc/) {
2901: $context = 'domain';
2902: } elsif ($env{'request.course.id'}) {
2903: $context = 'course';
2904: }
2905: if ($context) {
2906: if (ref($authhash->{$context}) eq 'HASH') {
2907: %can_assign = %{$authhash->{$context}};
2908: }
2909: }
2910: }
2911: }
2912: my $authnum = 0;
2913: foreach my $key (keys(%can_assign)) {
2914: if ($can_assign{$key}) {
2915: $authnum ++;
2916: }
2917: }
2918: if ($can_assign{'krb4'} && $can_assign{'krb5'}) {
2919: $authnum --;
2920: }
2921: return ($authnum,%can_assign);
2922: }
2923:
1.80 albertel 2924: ###############################################################
2925: ## Get Kerberos Defaults for Domain ##
2926: ###############################################################
2927: ##
2928: ## Returns default kerberos version and an associated argument
2929: ## as listed in file domain.tab. If not listed, provides
2930: ## appropriate default domain and kerberos version.
2931: ##
2932: #-------------------------------------------
2933:
2934: =pod
2935:
1.648 raeburn 2936: =item * &get_kerberos_defaults()
1.80 albertel 2937:
2938: get_kerberos_defaults($target_domain) returns the default kerberos
1.641 raeburn 2939: version and domain. If not found, it defaults to version 4 and the
2940: domain of the server.
1.80 albertel 2941:
1.648 raeburn 2942: =over 4
2943:
1.80 albertel 2944: ($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain);
2945:
1.648 raeburn 2946: =back
2947:
2948: =back
2949:
1.80 albertel 2950: =cut
2951:
2952: #-------------------------------------------
2953: sub get_kerberos_defaults {
2954: my $domain=shift;
1.641 raeburn 2955: my ($krbdef,$krbdefdom);
2956: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
2957: if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) {
2958: $krbdef = $domdefaults{'auth_def'};
2959: $krbdefdom = $domdefaults{'auth_arg_def'};
2960: } else {
1.80 albertel 2961: $ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/;
2962: my $krbdefdom=$1;
2963: $krbdefdom=~tr/a-z/A-Z/;
2964: $krbdef = "krb4";
2965: }
2966: return ($krbdef,$krbdefdom);
2967: }
1.112 bowersj2 2968:
1.32 matthew 2969:
1.46 matthew 2970: ###############################################################
2971: ## Thesaurus Functions ##
2972: ###############################################################
1.20 www 2973:
1.46 matthew 2974: =pod
1.20 www 2975:
1.112 bowersj2 2976: =head1 Thesaurus Functions
2977:
2978: =over 4
2979:
1.648 raeburn 2980: =item * &initialize_keywords()
1.46 matthew 2981:
2982: Initializes the package variable %Keywords if it is empty. Uses the
2983: package variable $thesaurus_db_file.
2984:
2985: =cut
2986:
2987: ###################################################
2988:
2989: sub initialize_keywords {
2990: return 1 if (scalar keys(%Keywords));
2991: # If we are here, %Keywords is empty, so fill it up
2992: # Make sure the file we need exists...
2993: if (! -e $thesaurus_db_file) {
2994: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file".
2995: " failed because it does not exist");
2996: return 0;
2997: }
2998: # Set up the hash as a database
2999: my %thesaurus_db;
3000: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3001: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3002: &Apache::lonnet::logthis("Could not tie \%thesaurus_db to ".
3003: $thesaurus_db_file);
3004: return 0;
3005: }
3006: # Get the average number of appearances of a word.
3007: my $avecount = $thesaurus_db{'average.count'};
3008: # Put keywords (those that appear > average) into %Keywords
3009: while (my ($word,$data)=each (%thesaurus_db)) {
3010: my ($count,undef) = split /:/,$data;
3011: $Keywords{$word}++ if ($count > $avecount);
3012: }
3013: untie %thesaurus_db;
3014: # Remove special values from %Keywords.
1.356 albertel 3015: foreach my $value ('total.count','average.count') {
3016: delete($Keywords{$value}) if (exists($Keywords{$value}));
1.586 raeburn 3017: }
1.46 matthew 3018: return 1;
3019: }
3020:
3021: ###################################################
3022:
3023: =pod
3024:
1.648 raeburn 3025: =item * &keyword($word)
1.46 matthew 3026:
3027: Returns true if $word is a keyword. A keyword is a word that appears more
3028: than the average number of times in the thesaurus database. Calls
3029: &initialize_keywords
3030:
3031: =cut
3032:
3033: ###################################################
1.20 www 3034:
3035: sub keyword {
1.46 matthew 3036: return if (!&initialize_keywords());
3037: my $word=lc(shift());
3038: $word=~s/\W//g;
3039: return exists($Keywords{$word});
1.20 www 3040: }
1.46 matthew 3041:
3042: ###############################################################
3043:
3044: =pod
1.20 www 3045:
1.648 raeburn 3046: =item * &get_related_words()
1.46 matthew 3047:
1.160 matthew 3048: Look up a word in the thesaurus. Takes a scalar argument and returns
1.46 matthew 3049: an array of words. If the keyword is not in the thesaurus, an empty array
3050: will be returned. The order of the words returned is determined by the
3051: database which holds them.
3052:
3053: Uses global $thesaurus_db_file.
3054:
1.1057 foxr 3055:
1.46 matthew 3056: =cut
3057:
3058: ###############################################################
3059: sub get_related_words {
3060: my $keyword = shift;
3061: my %thesaurus_db;
3062: if (! -e $thesaurus_db_file) {
3063: &Apache::lonnet::logthis("Attempt to access $thesaurus_db_file ".
3064: "failed because the file does not exist");
3065: return ();
3066: }
3067: if (! tie(%thesaurus_db,'GDBM_File',
1.53 albertel 3068: $thesaurus_db_file,&GDBM_READER(),0640)){
1.46 matthew 3069: return ();
3070: }
3071: my @Words=();
1.429 www 3072: my $count=0;
1.46 matthew 3073: if (exists($thesaurus_db{$keyword})) {
1.356 albertel 3074: # The first element is the number of times
3075: # the word appears. We do not need it now.
1.429 www 3076: my (undef,@RelatedWords) = (split(/:/,$thesaurus_db{$keyword}));
3077: my (undef,$mostfrequentcount)=split(/\,/,$RelatedWords[0]);
3078: my $threshold=$mostfrequentcount/10;
3079: foreach my $possibleword (@RelatedWords) {
3080: my ($word,$wordcount)=split(/\,/,$possibleword);
3081: if ($wordcount>$threshold) {
3082: push(@Words,$word);
3083: $count++;
3084: if ($count>10) { last; }
3085: }
1.20 www 3086: }
3087: }
1.46 matthew 3088: untie %thesaurus_db;
3089: return @Words;
1.14 harris41 3090: }
1.1090 foxr 3091: ###############################################################
3092: #
3093: # Spell checking
3094: #
3095:
3096: =pod
3097:
1.1142 raeburn 3098: =back
3099:
1.1090 foxr 3100: =head1 Spell checking
3101:
3102: =over 4
3103:
3104: =item * &check_spelling($wordlist $language)
3105:
3106: Takes a string containing words and feeds it to an external
3107: spellcheck program via a pipeline. Returns a string containing
3108: them mis-spelled words.
3109:
3110: Parameters:
3111:
3112: =over 4
3113:
3114: =item - $wordlist
3115:
3116: String that will be fed into the spellcheck program.
3117:
3118: =item - $language
3119:
3120: Language string that specifies the language for which the spell
3121: check will be performed.
3122:
3123: =back
3124:
3125: =back
3126:
3127: Note: This sub assumes that aspell is installed.
3128:
3129:
3130: =cut
3131:
1.46 matthew 3132:
1.1090 foxr 3133: sub check_spelling {
3134: my ($wordlist, $language) = @_;
1.1091 foxr 3135: my @misspellings;
3136:
3137: # Generate the speller and set the langauge.
3138: # if explicitly selected:
1.1090 foxr 3139:
1.1091 foxr 3140: my $speller = Text::Aspell->new;
1.1090 foxr 3141: if ($language) {
1.1091 foxr 3142: $speller->set_option('lang', $language);
1.1090 foxr 3143: }
3144:
1.1091 foxr 3145: # Turn the word list into an array of words by splittingon whitespace
1.1090 foxr 3146:
1.1091 foxr 3147: my @words = split(/\s+/, $wordlist);
1.1090 foxr 3148:
1.1091 foxr 3149: foreach my $word (@words) {
3150: if(! $speller->check($word)) {
3151: push(@misspellings, $word);
1.1090 foxr 3152: }
3153: }
1.1091 foxr 3154: return join(' ', @misspellings);
3155:
1.1090 foxr 3156: }
3157:
1.61 www 3158: # -------------------------------------------------------------- Plaintext name
1.81 albertel 3159: =pod
3160:
1.112 bowersj2 3161: =head1 User Name Functions
3162:
3163: =over 4
3164:
1.648 raeburn 3165: =item * &plainname($uname,$udom,$first)
1.81 albertel 3166:
1.112 bowersj2 3167: Takes a users logon name and returns it as a string in
1.226 albertel 3168: "first middle last generation" form
3169: if $first is set to 'lastname' then it returns it as
3170: 'lastname generation, firstname middlename' if their is a lastname
1.81 albertel 3171:
3172: =cut
1.61 www 3173:
1.295 www 3174:
1.81 albertel 3175: ###############################################################
1.61 www 3176: sub plainname {
1.226 albertel 3177: my ($uname,$udom,$first)=@_;
1.537 albertel 3178: return if (!defined($uname) || !defined($udom));
1.295 www 3179: my %names=&getnames($uname,$udom);
1.226 albertel 3180: my $name=&Apache::lonnet::format_name($names{'firstname'},
3181: $names{'middlename'},
3182: $names{'lastname'},
3183: $names{'generation'},$first);
3184: $name=~s/^\s+//;
1.62 www 3185: $name=~s/\s+$//;
3186: $name=~s/\s+/ /g;
1.353 albertel 3187: if ($name !~ /\S/) { $name=$uname.':'.$udom; }
1.62 www 3188: return $name;
1.61 www 3189: }
1.66 www 3190:
3191: # -------------------------------------------------------------------- Nickname
1.81 albertel 3192: =pod
3193:
1.648 raeburn 3194: =item * &nickname($uname,$udom)
1.81 albertel 3195:
3196: Gets a users name and returns it as a string as
3197:
3198: ""nickname""
1.66 www 3199:
1.81 albertel 3200: if the user has a nickname or
3201:
3202: "first middle last generation"
3203:
3204: if the user does not
3205:
3206: =cut
1.66 www 3207:
3208: sub nickname {
3209: my ($uname,$udom)=@_;
1.537 albertel 3210: return if (!defined($uname) || !defined($udom));
1.295 www 3211: my %names=&getnames($uname,$udom);
1.68 albertel 3212: my $name=$names{'nickname'};
1.66 www 3213: if ($name) {
3214: $name='"'.$name.'"';
3215: } else {
3216: $name=$names{'firstname'}.' '.$names{'middlename'}.' '.
3217: $names{'lastname'}.' '.$names{'generation'};
3218: $name=~s/\s+$//;
3219: $name=~s/\s+/ /g;
3220: }
3221: return $name;
3222: }
3223:
1.295 www 3224: sub getnames {
3225: my ($uname,$udom)=@_;
1.537 albertel 3226: return if (!defined($uname) || !defined($udom));
1.433 albertel 3227: if ($udom eq 'public' && $uname eq 'public') {
3228: return ('lastname' => &mt('Public'));
3229: }
1.295 www 3230: my $id=$uname.':'.$udom;
3231: my ($names,$cached)=&Apache::lonnet::is_cached_new('namescache',$id);
3232: if ($cached) {
3233: return %{$names};
3234: } else {
3235: my %loadnames=&Apache::lonnet::get('environment',
3236: ['firstname','middlename','lastname','generation','nickname'],
3237: $udom,$uname);
3238: &Apache::lonnet::do_cache_new('namescache',$id,\%loadnames);
3239: return %loadnames;
3240: }
3241: }
1.61 www 3242:
1.542 raeburn 3243: # -------------------------------------------------------------------- getemails
1.648 raeburn 3244:
1.542 raeburn 3245: =pod
3246:
1.648 raeburn 3247: =item * &getemails($uname,$udom)
1.542 raeburn 3248:
3249: Gets a user's email information and returns it as a hash with keys:
3250: notification, critnotification, permanentemail
3251:
3252: For notification and critnotification, values are comma-separated lists
1.648 raeburn 3253: of e-mail addresses; for permanentemail, value is a single e-mail address.
1.542 raeburn 3254:
1.648 raeburn 3255:
1.542 raeburn 3256: =cut
3257:
1.648 raeburn 3258:
1.466 albertel 3259: sub getemails {
3260: my ($uname,$udom)=@_;
3261: if ($udom eq 'public' && $uname eq 'public') {
3262: return;
3263: }
1.467 www 3264: if (!$udom) { $udom=$env{'user.domain'}; }
3265: if (!$uname) { $uname=$env{'user.name'}; }
1.466 albertel 3266: my $id=$uname.':'.$udom;
3267: my ($names,$cached)=&Apache::lonnet::is_cached_new('emailscache',$id);
3268: if ($cached) {
3269: return %{$names};
3270: } else {
3271: my %loadnames=&Apache::lonnet::get('environment',
3272: ['notification','critnotification',
3273: 'permanentemail'],
3274: $udom,$uname);
3275: &Apache::lonnet::do_cache_new('emailscache',$id,\%loadnames);
3276: return %loadnames;
3277: }
3278: }
3279:
1.551 albertel 3280: sub flush_email_cache {
3281: my ($uname,$udom)=@_;
3282: if (!$udom) { $udom =$env{'user.domain'}; }
3283: if (!$uname) { $uname=$env{'user.name'}; }
3284: return if ($udom eq 'public' && $uname eq 'public');
3285: my $id=$uname.':'.$udom;
3286: &Apache::lonnet::devalidate_cache_new('emailscache',$id);
3287: }
3288:
1.728 raeburn 3289: # -------------------------------------------------------------------- getlangs
3290:
3291: =pod
3292:
3293: =item * &getlangs($uname,$udom)
3294:
3295: Gets a user's language preference and returns it as a hash with key:
3296: language.
3297:
3298: =cut
3299:
3300:
3301: sub getlangs {
3302: my ($uname,$udom) = @_;
3303: if (!$udom) { $udom =$env{'user.domain'}; }
3304: if (!$uname) { $uname=$env{'user.name'}; }
3305: my $id=$uname.':'.$udom;
3306: my ($langs,$cached)=&Apache::lonnet::is_cached_new('userlangs',$id);
3307: if ($cached) {
3308: return %{$langs};
3309: } else {
3310: my %loadlangs=&Apache::lonnet::get('environment',['languages'],
3311: $udom,$uname);
3312: &Apache::lonnet::do_cache_new('userlangs',$id,\%loadlangs);
3313: return %loadlangs;
3314: }
3315: }
3316:
3317: sub flush_langs_cache {
3318: my ($uname,$udom)=@_;
3319: if (!$udom) { $udom =$env{'user.domain'}; }
3320: if (!$uname) { $uname=$env{'user.name'}; }
3321: return if ($udom eq 'public' && $uname eq 'public');
3322: my $id=$uname.':'.$udom;
3323: &Apache::lonnet::devalidate_cache_new('userlangs',$id);
3324: }
3325:
1.61 www 3326: # ------------------------------------------------------------------ Screenname
1.81 albertel 3327:
3328: =pod
3329:
1.648 raeburn 3330: =item * &screenname($uname,$udom)
1.81 albertel 3331:
3332: Gets a users screenname and returns it as a string
3333:
3334: =cut
1.61 www 3335:
3336: sub screenname {
3337: my ($uname,$udom)=@_;
1.258 albertel 3338: if ($uname eq $env{'user.name'} &&
3339: $udom eq $env{'user.domain'}) {return $env{'environment.screenname'};}
1.212 albertel 3340: my %names=&Apache::lonnet::get('environment',['screenname'],$udom,$uname);
1.68 albertel 3341: return $names{'screenname'};
1.62 www 3342: }
3343:
1.212 albertel 3344:
1.802 bisitz 3345: # ------------------------------------------------------------- Confirm Wrapper
3346: =pod
3347:
1.1142 raeburn 3348: =item * &confirmwrapper($message)
1.802 bisitz 3349:
3350: Wrap messages about completion of operation in box
3351:
3352: =cut
3353:
3354: sub confirmwrapper {
3355: my ($message)=@_;
3356: if ($message) {
3357: return "\n".'<div class="LC_confirm_box">'."\n"
3358: .$message."\n"
3359: .'</div>'."\n";
3360: } else {
3361: return $message;
3362: }
3363: }
3364:
1.62 www 3365: # ------------------------------------------------------------- Message Wrapper
3366:
3367: sub messagewrapper {
1.369 www 3368: my ($link,$username,$domain,$subject,$text)=@_;
1.62 www 3369: return
1.441 albertel 3370: '<a href="/adm/email?compose=individual&'.
3371: 'recname='.$username.'&recdom='.$domain.
3372: '&subject='.&escape($subject).'&text='.&escape($text).'" '.
1.200 matthew 3373: 'title="'.&mt('Send message').'">'.$link.'</a>';
1.74 www 3374: }
1.802 bisitz 3375:
1.74 www 3376: # --------------------------------------------------------------- Notes Wrapper
3377:
3378: sub noteswrapper {
3379: my ($link,$un,$do)=@_;
3380: return
1.896 amueller 3381: "<a href='/adm/email?recordftf=retrieve&recname=$un&recdom=$do'>$link</a>";
1.62 www 3382: }
1.802 bisitz 3383:
1.62 www 3384: # ------------------------------------------------------------- Aboutme Wrapper
3385:
3386: sub aboutmewrapper {
1.1070 raeburn 3387: my ($link,$username,$domain,$target,$class)=@_;
1.447 raeburn 3388: if (!defined($username) && !defined($domain)) {
3389: return;
3390: }
1.1096 raeburn 3391: return '<a href="/adm/'.$domain.'/'.$username.'/aboutme"'.
1.1070 raeburn 3392: ($target?' target="'.$target.'"':'').($class?' class="'.$class.'"':'').' title="'.&mt("View this user's personal information page").'">'.$link.'</a>';
1.62 www 3393: }
3394:
3395: # ------------------------------------------------------------ Syllabus Wrapper
3396:
3397: sub syllabuswrapper {
1.707 bisitz 3398: my ($linktext,$coursedir,$domain)=@_;
1.208 matthew 3399: return qq{<a href="/public/$domain/$coursedir/syllabus">$linktext</a>};
1.61 www 3400: }
1.14 harris41 3401:
1.802 bisitz 3402: # -----------------------------------------------------------------------------
3403:
1.208 matthew 3404: sub track_student_link {
1.887 raeburn 3405: my ($linktext,$sname,$sdom,$target,$start,$only_body) = @_;
1.268 albertel 3406: my $link ="/adm/trackstudent?";
1.208 matthew 3407: my $title = 'View recent activity';
3408: if (defined($sname) && $sname !~ /^\s*$/ &&
3409: defined($sdom) && $sdom !~ /^\s*$/) {
1.268 albertel 3410: $link .= "selected_student=$sname:$sdom";
1.208 matthew 3411: $title .= ' of this student';
1.268 albertel 3412: }
1.208 matthew 3413: if (defined($target) && $target !~ /^\s*$/) {
3414: $target = qq{target="$target"};
3415: } else {
3416: $target = '';
3417: }
1.268 albertel 3418: if ($start) { $link.='&start='.$start; }
1.887 raeburn 3419: if ($only_body) { $link .= '&only_body=1'; }
1.554 albertel 3420: $title = &mt($title);
3421: $linktext = &mt($linktext);
1.448 albertel 3422: return qq{<a href="$link" title="$title" $target>$linktext</a>}.
3423: &help_open_topic('View_recent_activity');
1.208 matthew 3424: }
3425:
1.781 raeburn 3426: sub slot_reservations_link {
3427: my ($linktext,$sname,$sdom,$target) = @_;
3428: my $link ="/adm/slotrequest?command=showresv&origin=aboutme";
3429: my $title = 'View slot reservation history';
3430: if (defined($sname) && $sname !~ /^\s*$/ &&
3431: defined($sdom) && $sdom !~ /^\s*$/) {
3432: $link .= "&uname=$sname&udom=$sdom";
3433: $title .= ' of this student';
3434: }
3435: if (defined($target) && $target !~ /^\s*$/) {
3436: $target = qq{target="$target"};
3437: } else {
3438: $target = '';
3439: }
3440: $title = &mt($title);
3441: $linktext = &mt($linktext);
3442: return qq{<a href="$link" title="$title" $target>$linktext</a>};
3443: # FIXME uncomment when help item created: &help_open_topic('Slot_Reservation_History');
3444:
3445: }
3446:
1.508 www 3447: # ===================================================== Display a student photo
3448:
3449:
1.509 albertel 3450: sub student_image_tag {
1.508 www 3451: my ($domain,$user)=@_;
3452: my $imgsrc=&Apache::lonnet::studentphoto($domain,$user,'jpg');
3453: if (($imgsrc) && ($imgsrc ne '/adm/lonKaputt/lonlogo_broken.gif')) {
3454: return '<img src="'.$imgsrc.'" align="right" />';
3455: } else {
3456: return '';
3457: }
3458: }
3459:
1.112 bowersj2 3460: =pod
3461:
3462: =back
3463:
3464: =head1 Access .tab File Data
3465:
3466: =over 4
3467:
1.648 raeburn 3468: =item * &languageids()
1.112 bowersj2 3469:
3470: returns list of all language ids
3471:
3472: =cut
3473:
1.14 harris41 3474: sub languageids {
1.16 harris41 3475: return sort(keys(%language));
1.14 harris41 3476: }
3477:
1.112 bowersj2 3478: =pod
3479:
1.648 raeburn 3480: =item * &languagedescription()
1.112 bowersj2 3481:
3482: returns description of a specified language id
3483:
3484: =cut
3485:
1.14 harris41 3486: sub languagedescription {
1.125 www 3487: my $code=shift;
3488: return ($supported_language{$code}?'* ':'').
3489: $language{$code}.
1.126 www 3490: ($supported_language{$code}?' ('.&mt('interface available').')':'');
1.145 www 3491: }
3492:
1.1048 foxr 3493: =pod
3494:
3495: =item * &plainlanguagedescription
3496:
3497: Returns both the plain language description (e.g. 'Creoles and Pidgins, English-based (Other)')
3498: and the language character encoding (e.g. ISO) separated by a ' - ' string.
3499:
3500: =cut
3501:
1.145 www 3502: sub plainlanguagedescription {
3503: my $code=shift;
3504: return $language{$code};
3505: }
3506:
1.1048 foxr 3507: =pod
3508:
3509: =item * &supportedlanguagecode
3510:
3511: Returns the supported language code (e.g. sptutf maps to pt) given a language
3512: code.
3513:
3514: =cut
3515:
1.145 www 3516: sub supportedlanguagecode {
3517: my $code=shift;
3518: return $supported_language{$code};
1.97 www 3519: }
3520:
1.112 bowersj2 3521: =pod
3522:
1.1048 foxr 3523: =item * &latexlanguage()
3524:
3525: Given a language key code returns the correspondnig language to use
3526: to select the correct hyphenation on LaTeX printouts. This is undef if there
3527: is no supported hyphenation for the language code.
3528:
3529: =cut
3530:
3531: sub latexlanguage {
3532: my $code = shift;
3533: return $latex_language{$code};
3534: }
3535:
3536: =pod
3537:
3538: =item * &latexhyphenation()
3539:
3540: Same as above but what's supplied is the language as it might be stored
3541: in the metadata.
3542:
3543: =cut
3544:
3545: sub latexhyphenation {
3546: my $key = shift;
3547: return $latex_language_bykey{$key};
3548: }
3549:
3550: =pod
3551:
1.648 raeburn 3552: =item * ©rightids()
1.112 bowersj2 3553:
3554: returns list of all copyrights
3555:
3556: =cut
3557:
3558: sub copyrightids {
3559: return sort(keys(%cprtag));
3560: }
3561:
3562: =pod
3563:
1.648 raeburn 3564: =item * ©rightdescription()
1.112 bowersj2 3565:
3566: returns description of a specified copyright id
3567:
3568: =cut
3569:
3570: sub copyrightdescription {
1.166 www 3571: return &mt($cprtag{shift(@_)});
1.112 bowersj2 3572: }
1.197 matthew 3573:
3574: =pod
3575:
1.648 raeburn 3576: =item * &source_copyrightids()
1.192 taceyjo1 3577:
3578: returns list of all source copyrights
3579:
3580: =cut
3581:
3582: sub source_copyrightids {
3583: return sort(keys(%scprtag));
3584: }
3585:
3586: =pod
3587:
1.648 raeburn 3588: =item * &source_copyrightdescription()
1.192 taceyjo1 3589:
3590: returns description of a specified source copyright id
3591:
3592: =cut
3593:
3594: sub source_copyrightdescription {
3595: return &mt($scprtag{shift(@_)});
3596: }
1.112 bowersj2 3597:
3598: =pod
3599:
1.648 raeburn 3600: =item * &filecategories()
1.112 bowersj2 3601:
3602: returns list of all file categories
3603:
3604: =cut
3605:
3606: sub filecategories {
3607: return sort(keys(%category_extensions));
3608: }
3609:
3610: =pod
3611:
1.648 raeburn 3612: =item * &filecategorytypes()
1.112 bowersj2 3613:
3614: returns list of file types belonging to a given file
3615: category
3616:
3617: =cut
3618:
3619: sub filecategorytypes {
1.356 albertel 3620: my ($cat) = @_;
3621: return @{$category_extensions{lc($cat)}};
1.112 bowersj2 3622: }
3623:
3624: =pod
3625:
1.648 raeburn 3626: =item * &fileembstyle()
1.112 bowersj2 3627:
3628: returns embedding style for a specified file type
3629:
3630: =cut
3631:
3632: sub fileembstyle {
3633: return $fe{lc(shift(@_))};
1.169 www 3634: }
3635:
1.351 www 3636: sub filemimetype {
3637: return $fm{lc(shift(@_))};
3638: }
3639:
1.169 www 3640:
3641: sub filecategoryselect {
3642: my ($name,$value)=@_;
1.189 matthew 3643: return &select_form($value,$name,
1.970 raeburn 3644: {'' => &mt('Any category'), map { $_,$_ } sort(keys(%category_extensions))});
1.112 bowersj2 3645: }
3646:
3647: =pod
3648:
1.648 raeburn 3649: =item * &filedescription()
1.112 bowersj2 3650:
3651: returns description for a specified file type
3652:
3653: =cut
3654:
3655: sub filedescription {
1.188 matthew 3656: my $file_description = $fd{lc(shift())};
3657: $file_description =~ s:([\[\]]):~$1:g;
3658: return &mt($file_description);
1.112 bowersj2 3659: }
3660:
3661: =pod
3662:
1.648 raeburn 3663: =item * &filedescriptionex()
1.112 bowersj2 3664:
3665: returns description for a specified file type with
3666: extra formatting
3667:
3668: =cut
3669:
3670: sub filedescriptionex {
3671: my $ex=shift;
1.188 matthew 3672: my $file_description = $fd{lc($ex)};
3673: $file_description =~ s:([\[\]]):~$1:g;
3674: return '.'.$ex.' '.&mt($file_description);
1.112 bowersj2 3675: }
3676:
3677: # End of .tab access
3678: =pod
3679:
3680: =back
3681:
3682: =cut
3683:
3684: # ------------------------------------------------------------------ File Types
3685: sub fileextensions {
3686: return sort(keys(%fe));
3687: }
3688:
1.97 www 3689: # ----------------------------------------------------------- Display Languages
3690: # returns a hash with all desired display languages
3691: #
3692:
3693: sub display_languages {
3694: my %languages=();
1.695 raeburn 3695: foreach my $lang (&Apache::lonlocal::preferred_languages()) {
1.356 albertel 3696: $languages{$lang}=1;
1.97 www 3697: }
3698: &get_unprocessed_cgi($ENV{'QUERY_STRING'},['displaylanguage']);
1.258 albertel 3699: if ($env{'form.displaylanguage'}) {
1.356 albertel 3700: foreach my $lang (split(/\s*(\,|\;|\:)\s*/,$env{'form.displaylanguage'})) {
3701: $languages{$lang}=1;
1.97 www 3702: }
3703: }
3704: return %languages;
1.14 harris41 3705: }
3706:
1.582 albertel 3707: sub languages {
3708: my ($possible_langs) = @_;
1.695 raeburn 3709: my @preferred_langs = &Apache::lonlocal::preferred_languages();
1.582 albertel 3710: if (!ref($possible_langs)) {
3711: if( wantarray ) {
3712: return @preferred_langs;
3713: } else {
3714: return $preferred_langs[0];
3715: }
3716: }
3717: my %possibilities = map { $_ => 1 } (@$possible_langs);
3718: my @preferred_possibilities;
3719: foreach my $preferred_lang (@preferred_langs) {
3720: if (exists($possibilities{$preferred_lang})) {
3721: push(@preferred_possibilities, $preferred_lang);
3722: }
3723: }
3724: if( wantarray ) {
3725: return @preferred_possibilities;
3726: }
3727: return $preferred_possibilities[0];
3728: }
3729:
1.742 raeburn 3730: sub user_lang {
3731: my ($touname,$toudom,$fromcid) = @_;
3732: my @userlangs;
3733: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) {
3734: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
3735: $env{'course.'.$fromcid.'.languages'}));
3736: } else {
3737: my %langhash = &getlangs($touname,$toudom);
3738: if ($langhash{'languages'} ne '') {
3739: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
3740: } else {
3741: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom);
3742: if ($domdefs{'lang_def'} ne '') {
3743: @userlangs = ($domdefs{'lang_def'});
3744: }
3745: }
3746: }
3747: my @languages=&Apache::lonlocal::get_genlanguages(@userlangs);
3748: my $user_lh = Apache::localize->get_handle(@languages);
3749: return $user_lh;
3750: }
3751:
3752:
1.112 bowersj2 3753: ###############################################################
3754: ## Student Answer Attempts ##
3755: ###############################################################
3756:
3757: =pod
3758:
3759: =head1 Alternate Problem Views
3760:
3761: =over 4
3762:
1.648 raeburn 3763: =item * &get_previous_attempt($symb, $username, $domain, $course,
1.1199 ! raeburn 3764: $getattempt, $regexp, $gradesub, $usec, $identifier)
1.112 bowersj2 3765:
3766: Return string with previous attempt on problem. Arguments:
3767:
3768: =over 4
3769:
3770: =item * $symb: Problem, including path
3771:
3772: =item * $username: username of the desired student
3773:
3774: =item * $domain: domain of the desired student
1.14 harris41 3775:
1.112 bowersj2 3776: =item * $course: Course ID
1.14 harris41 3777:
1.112 bowersj2 3778: =item * $getattempt: Leave blank for all attempts, otherwise put
3779: something
1.14 harris41 3780:
1.112 bowersj2 3781: =item * $regexp: if string matches this regexp, the string will be
3782: sent to $gradesub
1.14 harris41 3783:
1.112 bowersj2 3784: =item * $gradesub: routine that processes the string if it matches $regexp
1.14 harris41 3785:
1.1199 ! raeburn 3786: =item * $usec: section of the desired student
! 3787:
! 3788: =item * $identifier: counter for student (multiple students one problem) or
! 3789: problem (one student; whole sequence).
! 3790:
1.112 bowersj2 3791: =back
1.14 harris41 3792:
1.112 bowersj2 3793: The output string is a table containing all desired attempts, if any.
1.16 harris41 3794:
1.112 bowersj2 3795: =cut
1.1 albertel 3796:
3797: sub get_previous_attempt {
1.1199 ! raeburn 3798: my ($symb,$username,$domain,$course,$getattempt,$regexp,$gradesub,$usec,$identifier)=@_;
1.1 albertel 3799: my $prevattempts='';
1.43 ng 3800: no strict 'refs';
1.1 albertel 3801: if ($symb) {
1.3 albertel 3802: my (%returnhash)=
3803: &Apache::lonnet::restore($symb,$course,$domain,$username);
1.1 albertel 3804: if ($returnhash{'version'}) {
3805: my %lasthash=();
3806: my $version;
3807: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.356 albertel 3808: foreach my $key (sort(split(/\:/,$returnhash{$version.':keys'}))) {
3809: $lasthash{$key}=$returnhash{$version.':'.$key};
1.19 harris41 3810: }
1.1 albertel 3811: }
1.596 albertel 3812: $prevattempts=&start_data_table().&start_data_table_header_row();
3813: $prevattempts.='<th>'.&mt('History').'</th>';
1.1199 ! raeburn 3814: my (%typeparts,%lasthidden,%regraded,%hidestatus);
1.945 raeburn 3815: my $showsurv=&Apache::lonnet::allowed('vas',$env{'request.course.id'});
1.356 albertel 3816: foreach my $key (sort(keys(%lasthash))) {
3817: my ($ign,@parts) = split(/\./,$key);
1.41 ng 3818: if ($#parts > 0) {
1.31 albertel 3819: my $data=$parts[-1];
1.989 raeburn 3820: next if ($data eq 'foilorder');
1.31 albertel 3821: pop(@parts);
1.1010 www 3822: $prevattempts.='<th>'.&mt('Part ').join('.',@parts).'<br />'.$data.' </th>';
1.945 raeburn 3823: if ($data eq 'type') {
3824: unless ($showsurv) {
3825: my $id = join(',',@parts);
3826: $typeparts{$ign.'.'.$id} = $lasthash{$key};
1.978 raeburn 3827: if (($lasthash{$key} eq 'anonsurvey') || ($lasthash{$key} eq 'anonsurveycred')) {
3828: $lasthidden{$ign.'.'.$id} = 1;
3829: }
1.945 raeburn 3830: }
1.1199 ! raeburn 3831: if ($identifier ne '') {
! 3832: my $id = join(',',@parts);
! 3833: if (&Apache::lonnet::EXT("resource.$id.problemstatus",$symb,
! 3834: $domain,$username,$usec,undef,$course) =~ /^no/) {
! 3835: $hidestatus{$ign.'.'.$id} = 1;
! 3836: }
! 3837: }
! 3838: } elsif ($data eq 'regrader') {
! 3839: if (($identifier ne '') && (@parts)) {
! 3840: $regraded{$parts[-1]} = 1;
! 3841: }
1.1010 www 3842: }
1.31 albertel 3843: } else {
1.41 ng 3844: if ($#parts == 0) {
3845: $prevattempts.='<th>'.$parts[0].'</th>';
3846: } else {
3847: $prevattempts.='<th>'.$ign.'</th>';
3848: }
1.31 albertel 3849: }
1.16 harris41 3850: }
1.596 albertel 3851: $prevattempts.=&end_data_table_header_row();
1.40 ng 3852: if ($getattempt eq '') {
1.1199 ! raeburn 3853: my (%solved,%resets,%probstatus);
1.40 ng 3854: for ($version=1;$version<=$returnhash{'version'};$version++) {
1.1199 ! raeburn 3855: if ($identifier ne '') {
! 3856: foreach my $part (keys(%regraded)) {
! 3857: if (($returnhash{$version.':resource.'.$part.'.regrader'}) &&
! 3858: ($returnhash{$version.':resource.'.$part.'.tries'} eq '') &&
! 3859: ($returnhash{$version.':resource.'.$part.'.award'} eq '')) {
! 3860: push(@{$resets{$part}},$version);
! 3861: }
! 3862: }
! 3863: }
! 3864: my (@hidden,@unsolved);
1.945 raeburn 3865: if (%typeparts) {
3866: foreach my $id (keys(%typeparts)) {
1.1199 ! raeburn 3867: if (($returnhash{$version.':'.$id.'.type'} eq 'anonsurvey') ||
! 3868: ($returnhash{$version.':'.$id.'.type'} eq 'anonsurveycred')) {
1.945 raeburn 3869: push(@hidden,$id);
1.1199 ! raeburn 3870: } elsif ($identifier ne '') {
! 3871: unless (($returnhash{$version.':'.$id.'.type'} eq 'survey') ||
! 3872: ($returnhash{$version.':'.$id.'.type'} eq 'surveycred') ||
! 3873: ($hidestatus{$id})) {
! 3874: next if ((ref($resets{$id}) eq 'ARRAY') && grep(/^\Q$id\E$/,@{$resets{$id}}));
! 3875: if ($returnhash{$version.':'.$id.'.solved'} eq 'correct_by_student') {
! 3876: push(@{$solved{$id}},$version);
! 3877: } elsif (($returnhash{$version.':'.$id.'.solved'} ne '') &&
! 3878: (ref($solved{$id}) eq 'ARRAY')) {
! 3879: my $skip;
! 3880: if (ref($resets{$id}) eq 'ARRAY') {
! 3881: foreach my $reset (@{$resets{$id}}) {
! 3882: if ($reset > $solved{$id}[-1]) {
! 3883: $skip=1;
! 3884: last;
! 3885: }
! 3886: }
! 3887: }
! 3888: unless ($skip) {
! 3889: my ($ign,$partslist) = split(/\./,$id,2);
! 3890: push(@unsolved,$partslist);
! 3891: }
! 3892: }
! 3893: }
1.945 raeburn 3894: }
3895: }
3896: }
3897: $prevattempts.=&start_data_table_row().
1.1199 ! raeburn 3898: '<td>'.&mt('Transaction [_1]',$version);
! 3899: if (@unsolved) {
! 3900: $prevattempts .= '<span class="LC_nobreak"><label>'.
! 3901: '<input type="checkbox" name="HIDE'.$identifier.'" value="'.$version.':'.join('_',@unsolved).'" />'.
! 3902: &mt('Hide').'</label></span>';
! 3903: }
! 3904: $prevattempts .= '</td>';
1.945 raeburn 3905: if (@hidden) {
3906: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3907: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3908: my $hide;
3909: foreach my $id (@hidden) {
3910: if ($key =~ /^\Q$id\E/) {
3911: $hide = 1;
3912: last;
3913: }
3914: }
3915: if ($hide) {
3916: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3917: if (($data eq 'award') || ($data eq 'awarddetail')) {
3918: my $value = &format_previous_attempt_value($key,
3919: $returnhash{$version.':'.$key});
1.1173 kruse 3920: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3921: } else {
3922: $prevattempts.='<td> </td>';
3923: }
3924: } else {
3925: if ($key =~ /\./) {
3926: my $value = &format_previous_attempt_value($key,
3927: $returnhash{$version.':'.$key});
1.1173 kruse 3928: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3929: } else {
3930: $prevattempts.='<td> </td>';
3931: }
3932: }
3933: }
3934: } else {
3935: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3936: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3937: my $value = &format_previous_attempt_value($key,
3938: $returnhash{$version.':'.$key});
1.1173 kruse 3939: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3940: }
3941: }
3942: $prevattempts.=&end_data_table_row();
1.40 ng 3943: }
1.1 albertel 3944: }
1.945 raeburn 3945: my @currhidden = keys(%lasthidden);
1.596 albertel 3946: $prevattempts.=&start_data_table_row().'<td>'.&mt('Current').'</td>';
1.356 albertel 3947: foreach my $key (sort(keys(%lasthash))) {
1.989 raeburn 3948: next if ($key =~ /\.foilorder$/);
1.945 raeburn 3949: if (%typeparts) {
3950: my $hidden;
3951: foreach my $id (@currhidden) {
3952: if ($key =~ /^\Q$id\E/) {
3953: $hidden = 1;
3954: last;
3955: }
3956: }
3957: if ($hidden) {
3958: my ($id,$data) = ($key =~ /^(.+)\.([^.]+)$/);
3959: if (($data eq 'award') || ($data eq 'awarddetail')) {
3960: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3961: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3962: $value = &$gradesub($value);
3963: }
1.1173 kruse 3964: $prevattempts.='<td>'. $value.' </td>';
1.945 raeburn 3965: } else {
3966: $prevattempts.='<td> </td>';
3967: }
3968: } else {
3969: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3970: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3971: $value = &$gradesub($value);
3972: }
1.1173 kruse 3973: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3974: }
3975: } else {
3976: my $value = &format_previous_attempt_value($key,$lasthash{$key});
3977: if ($key =~/$regexp$/ && (defined &$gradesub)) {
3978: $value = &$gradesub($value);
3979: }
1.1173 kruse 3980: $prevattempts.='<td>'.$value.' </td>';
1.945 raeburn 3981: }
1.16 harris41 3982: }
1.596 albertel 3983: $prevattempts.= &end_data_table_row().&end_data_table();
1.1 albertel 3984: } else {
1.596 albertel 3985: $prevattempts=
3986: &start_data_table().&start_data_table_row().
3987: '<td>'.&mt('Nothing submitted - no attempts.').'</td>'.
3988: &end_data_table_row().&end_data_table();
1.1 albertel 3989: }
3990: } else {
1.596 albertel 3991: $prevattempts=
3992: &start_data_table().&start_data_table_row().
3993: '<td>'.&mt('No data.').'</td>'.
3994: &end_data_table_row().&end_data_table();
1.1 albertel 3995: }
1.10 albertel 3996: }
3997:
1.581 albertel 3998: sub format_previous_attempt_value {
3999: my ($key,$value) = @_;
1.1011 www 4000: if (($key =~ /timestamp/) || ($key=~/duedate/)) {
1.1173 kruse 4001: $value = &Apache::lonlocal::locallocaltime($value);
1.581 albertel 4002: } elsif (ref($value) eq 'ARRAY') {
1.1173 kruse 4003: $value = &HTML::Entities::encode('('.join(', ', @{ $value }).')','"<>&');
1.988 raeburn 4004: } elsif ($key =~ /answerstring$/) {
4005: my %answers = &Apache::lonnet::str2hash($value);
1.1173 kruse 4006: my @answer = %answers;
4007: %answers = map {&HTML::Entities::encode($_, '"<>&')} @answer;
1.988 raeburn 4008: my @anskeys = sort(keys(%answers));
4009: if (@anskeys == 1) {
4010: my $answer = $answers{$anskeys[0]};
1.1001 raeburn 4011: if ($answer =~ m{\0}) {
4012: $answer =~ s{\0}{,}g;
1.988 raeburn 4013: }
4014: my $tag_internal_answer_name = 'INTERNAL';
4015: if ($anskeys[0] eq $tag_internal_answer_name) {
4016: $value = $answer;
4017: } else {
4018: $value = $anskeys[0].'='.$answer;
4019: }
4020: } else {
4021: foreach my $ans (@anskeys) {
4022: my $answer = $answers{$ans};
1.1001 raeburn 4023: if ($answer =~ m{\0}) {
4024: $answer =~ s{\0}{,}g;
1.988 raeburn 4025: }
4026: $value .= $ans.'='.$answer.'<br />';;
4027: }
4028: }
1.581 albertel 4029: } else {
1.1173 kruse 4030: $value = &HTML::Entities::encode(&unescape($value), '"<>&');
1.581 albertel 4031: }
4032: return $value;
4033: }
4034:
4035:
1.107 albertel 4036: sub relative_to_absolute {
4037: my ($url,$output)=@_;
4038: my $parser=HTML::TokeParser->new(\$output);
4039: my $token;
4040: my $thisdir=$url;
4041: my @rlinks=();
4042: while ($token=$parser->get_token) {
4043: if ($token->[0] eq 'S') {
4044: if ($token->[1] eq 'a') {
4045: if ($token->[2]->{'href'}) {
4046: $rlinks[$#rlinks+1]=$token->[2]->{'href'};
4047: }
4048: } elsif ($token->[1] eq 'img' || $token->[1] eq 'embed' ) {
4049: $rlinks[$#rlinks+1]=$token->[2]->{'src'};
4050: } elsif ($token->[1] eq 'base') {
4051: $thisdir=$token->[2]->{'href'};
4052: }
4053: }
4054: }
4055: $thisdir=~s-/[^/]*$--;
1.356 albertel 4056: foreach my $link (@rlinks) {
1.726 raeburn 4057: unless (($link=~/^https?\:\/\//i) ||
1.356 albertel 4058: ($link=~/^\//) ||
4059: ($link=~/^javascript:/i) ||
4060: ($link=~/^mailto:/i) ||
4061: ($link=~/^\#/)) {
4062: my $newlocation=&Apache::lonnet::hreflocation($thisdir,$link);
4063: $output=~s/(\"|\'|\=\s*)\Q$link\E(\"|\'|\s|\>)/$1$newlocation$2/;
1.107 albertel 4064: }
4065: }
4066: # -------------------------------------------------- Deal with Applet codebases
4067: $output=~s/(\<applet[^\>]+)(codebase\=[^\S\>]+)*([^\>]*)\>/$1.($2?$2:' codebase="'.$thisdir.'"').$3.'>'/gei;
4068: return $output;
4069: }
4070:
1.112 bowersj2 4071: =pod
4072:
1.648 raeburn 4073: =item * &get_student_view()
1.112 bowersj2 4074:
4075: show a snapshot of what student was looking at
4076:
4077: =cut
4078:
1.10 albertel 4079: sub get_student_view {
1.186 albertel 4080: my ($symb,$username,$domain,$courseid,$target,$moreenv) = @_;
1.114 www 4081: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4082: my (%form);
1.10 albertel 4083: my @elements=('symb','courseid','domain','username');
4084: foreach my $element (@elements) {
1.186 albertel 4085: $form{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4086: }
1.186 albertel 4087: if (defined($moreenv)) {
4088: %form=(%form,%{$moreenv});
4089: }
1.236 albertel 4090: if (defined($target)) { $form{'grade_target'} = $target; }
1.107 albertel 4091: $feedurl=&Apache::lonnet::clutter($feedurl);
1.650 www 4092: my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
1.11 albertel 4093: $userview=~s/\<body[^\>]*\>//gi;
4094: $userview=~s/\<\/body\>//gi;
4095: $userview=~s/\<html\>//gi;
4096: $userview=~s/\<\/html\>//gi;
4097: $userview=~s/\<head\>//gi;
4098: $userview=~s/\<\/head\>//gi;
4099: $userview=~s/action\s*\=/would_be_action\=/gi;
1.107 albertel 4100: $userview=&relative_to_absolute($feedurl,$userview);
1.650 www 4101: if (wantarray) {
4102: return ($userview,$response);
4103: } else {
4104: return $userview;
4105: }
4106: }
4107:
4108: sub get_student_view_with_retries {
4109: my ($symb,$retries,$username,$domain,$courseid,$target,$moreenv) = @_;
4110:
4111: my $ok = 0; # True if we got a good response.
4112: my $content;
4113: my $response;
4114:
4115: # Try to get the student_view done. within the retries count:
4116:
4117: do {
4118: ($content, $response) = &get_student_view($symb,$username,$domain,$courseid,$target,$moreenv);
4119: $ok = $response->is_success;
4120: if (!$ok) {
4121: &Apache::lonnet::logthis("Failed get_student_view_with_retries on $symb: ".$response->is_success.', '.$response->code.', '.$response->message);
4122: }
4123: $retries--;
4124: } while (!$ok && ($retries > 0));
4125:
4126: if (!$ok) {
4127: $content = ''; # On error return an empty content.
4128: }
1.651 www 4129: if (wantarray) {
4130: return ($content, $response);
4131: } else {
4132: return $content;
4133: }
1.11 albertel 4134: }
4135:
1.112 bowersj2 4136: =pod
4137:
1.648 raeburn 4138: =item * &get_student_answers()
1.112 bowersj2 4139:
4140: show a snapshot of how student was answering problem
4141:
4142: =cut
4143:
1.11 albertel 4144: sub get_student_answers {
1.100 sakharuk 4145: my ($symb,$username,$domain,$courseid,%form) = @_;
1.114 www 4146: my ($map,$id,$feedurl) = &Apache::lonnet::decode_symb($symb);
1.186 albertel 4147: my (%moreenv);
1.11 albertel 4148: my @elements=('symb','courseid','domain','username');
4149: foreach my $element (@elements) {
1.186 albertel 4150: $moreenv{'grade_'.$element}=eval '$'.$element #'
1.10 albertel 4151: }
1.186 albertel 4152: $moreenv{'grade_target'}='answer';
4153: %moreenv=(%form,%moreenv);
1.497 raeburn 4154: $feedurl = &Apache::lonnet::clutter($feedurl);
4155: my $userview=&Apache::lonnet::ssi($feedurl,%moreenv);
1.10 albertel 4156: return $userview;
1.1 albertel 4157: }
1.116 albertel 4158:
4159: =pod
4160:
4161: =item * &submlink()
4162:
1.242 albertel 4163: Inputs: $text $uname $udom $symb $target
1.116 albertel 4164:
4165: Returns: A link to grades.pm such as to see the SUBM view of a student
4166:
4167: =cut
4168:
4169: ###############################################
4170: sub submlink {
1.242 albertel 4171: my ($text,$uname,$udom,$symb,$target)=@_;
1.116 albertel 4172: if (!($uname && $udom)) {
4173: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4174: &Apache::lonnet::whichuser($symb);
1.116 albertel 4175: if (!$symb) { $symb=$cursymb; }
4176: }
1.254 matthew 4177: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4178: $symb=&escape($symb);
1.960 bisitz 4179: if ($target) { $target=" target=\"$target\""; }
4180: return
4181: '<a href="/adm/grades?command=submission'.
4182: '&symb='.$symb.
4183: '&student='.$uname.
4184: '&userdom='.$udom.'"'.
4185: $target.'>'.$text.'</a>';
1.242 albertel 4186: }
4187: ##############################################
4188:
4189: =pod
4190:
4191: =item * &pgrdlink()
4192:
4193: Inputs: $text $uname $udom $symb $target
4194:
4195: Returns: A link to grades.pm such as to see the PGRD view of a student
4196:
4197: =cut
4198:
4199: ###############################################
4200: sub pgrdlink {
4201: my $link=&submlink(@_);
4202: $link=~s/(&command=submission)/$1&showgrading=yes/;
4203: return $link;
4204: }
4205: ##############################################
4206:
4207: =pod
4208:
4209: =item * &pprmlink()
4210:
4211: Inputs: $text $uname $udom $symb $target
4212:
4213: Returns: A link to parmset.pm such as to see the PPRM view of a
1.283 albertel 4214: student and a specific resource
1.242 albertel 4215:
4216: =cut
4217:
4218: ###############################################
4219: sub pprmlink {
4220: my ($text,$uname,$udom,$symb,$target)=@_;
4221: if (!($uname && $udom)) {
4222: (my $cursymb, my $courseid,$udom,$uname)=
1.463 albertel 4223: &Apache::lonnet::whichuser($symb);
1.242 albertel 4224: if (!$symb) { $symb=$cursymb; }
4225: }
1.254 matthew 4226: if (!$symb) { $symb=&Apache::lonnet::symbread(); }
1.369 www 4227: $symb=&escape($symb);
1.242 albertel 4228: if ($target) { $target="target=\"$target\""; }
1.595 albertel 4229: return '<a href="/adm/parmset?command=set&'.
4230: 'symb='.$symb.'&uname='.$uname.
4231: '&udom='.$udom.'" '.$target.'>'.$text.'</a>';
1.116 albertel 4232: }
4233: ##############################################
1.37 matthew 4234:
1.112 bowersj2 4235: =pod
4236:
4237: =back
4238:
4239: =cut
4240:
1.37 matthew 4241: ###############################################
1.51 www 4242:
4243:
4244: sub timehash {
1.687 raeburn 4245: my ($thistime) = @_;
4246: my $timezone = &Apache::lonlocal::gettimezone();
4247: my $dt = DateTime->from_epoch(epoch => $thistime)
4248: ->set_time_zone($timezone);
4249: my $wday = $dt->day_of_week();
4250: if ($wday == 7) { $wday = 0; }
4251: return ( 'second' => $dt->second(),
4252: 'minute' => $dt->minute(),
4253: 'hour' => $dt->hour(),
4254: 'day' => $dt->day_of_month(),
4255: 'month' => $dt->month(),
4256: 'year' => $dt->year(),
4257: 'weekday' => $wday,
4258: 'dayyear' => $dt->day_of_year(),
4259: 'dlsav' => $dt->is_dst() );
1.51 www 4260: }
4261:
1.370 www 4262: sub utc_string {
4263: my ($date)=@_;
1.371 www 4264: return strftime("%Y%m%dT%H%M%SZ",gmtime($date));
1.370 www 4265: }
4266:
1.51 www 4267: sub maketime {
4268: my %th=@_;
1.687 raeburn 4269: my ($epoch_time,$timezone,$dt);
4270: $timezone = &Apache::lonlocal::gettimezone();
4271: eval {
4272: $dt = DateTime->new( year => $th{'year'},
4273: month => $th{'month'},
4274: day => $th{'day'},
4275: hour => $th{'hour'},
4276: minute => $th{'minute'},
4277: second => $th{'second'},
4278: time_zone => $timezone,
4279: );
4280: };
4281: if (!$@) {
4282: $epoch_time = $dt->epoch;
4283: if ($epoch_time) {
4284: return $epoch_time;
4285: }
4286: }
1.51 www 4287: return POSIX::mktime(
4288: ($th{'seconds'},$th{'minutes'},$th{'hours'},
1.210 www 4289: $th{'day'},$th{'month'}-1,$th{'year'}-1900,0,0,-1));
1.70 www 4290: }
4291:
4292: #########################################
1.51 www 4293:
4294: sub findallcourses {
1.482 raeburn 4295: my ($roles,$uname,$udom) = @_;
1.355 albertel 4296: my %roles;
4297: if (ref($roles)) { %roles = map { $_ => 1 } @{$roles}; }
1.348 albertel 4298: my %courses;
1.51 www 4299: my $now=time;
1.482 raeburn 4300: if (!defined($uname)) {
4301: $uname = $env{'user.name'};
4302: }
4303: if (!defined($udom)) {
4304: $udom = $env{'user.domain'};
4305: }
4306: if (($uname ne $env{'user.name'}) || ($udom ne $env{'user.domain'})) {
1.1073 raeburn 4307: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname);
1.482 raeburn 4308: if (!%roles) {
4309: %roles = (
4310: cc => 1,
1.907 raeburn 4311: co => 1,
1.482 raeburn 4312: in => 1,
4313: ep => 1,
4314: ta => 1,
4315: cr => 1,
4316: st => 1,
4317: );
4318: }
4319: foreach my $entry (keys(%roleshash)) {
4320: my ($trole,$tend,$tstart) = split(/_/,$roleshash{$entry});
4321: if ($trole =~ /^cr/) {
4322: next if (!exists($roles{$trole}) && !exists($roles{'cr'}));
4323: } else {
4324: next if (!exists($roles{$trole}));
4325: }
4326: if ($tend) {
4327: next if ($tend < $now);
4328: }
4329: if ($tstart) {
4330: next if ($tstart > $now);
4331: }
1.1058 raeburn 4332: my ($cdom,$cnum,$sec,$cnumpart,$secpart,$role);
1.482 raeburn 4333: (undef,$cdom,$cnumpart,$secpart) = split(/\//,$entry);
1.1058 raeburn 4334: my $value = $trole.'/'.$cdom.'/';
1.482 raeburn 4335: if ($secpart eq '') {
4336: ($cnum,$role) = split(/_/,$cnumpart);
4337: $sec = 'none';
1.1058 raeburn 4338: $value .= $cnum.'/';
1.482 raeburn 4339: } else {
4340: $cnum = $cnumpart;
4341: ($sec,$role) = split(/_/,$secpart);
1.1058 raeburn 4342: $value .= $cnum.'/'.$sec;
4343: }
4344: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4345: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4346: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4347: }
4348: } else {
4349: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.490 raeburn 4350: }
1.482 raeburn 4351: }
4352: } else {
4353: foreach my $key (keys(%env)) {
1.483 albertel 4354: if ( $key=~m{^user\.role\.(\w+)\./($match_domain)/($match_courseid)/?(\w*)$} ||
4355: $key=~m{^user\.role\.(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_courseid)/?(\w*)$}) {
1.482 raeburn 4356: my ($role,$cdom,$cnum,$sec) = ($1,$2,$3,$4);
4357: next if ($role eq 'ca' || $role eq 'aa');
4358: next if (%roles && !exists($roles{$role}));
4359: my ($starttime,$endtime)=split(/\./,$env{$key});
4360: my $active=1;
4361: if ($starttime) {
4362: if ($now<$starttime) { $active=0; }
4363: }
4364: if ($endtime) {
4365: if ($now>$endtime) { $active=0; }
4366: }
4367: if ($active) {
1.1058 raeburn 4368: my $value = $role.'/'.$cdom.'/'.$cnum.'/';
1.482 raeburn 4369: if ($sec eq '') {
4370: $sec = 'none';
1.1058 raeburn 4371: } else {
4372: $value .= $sec;
4373: }
4374: if (ref($courses{$cdom.'_'.$cnum}{$sec}) eq 'ARRAY') {
4375: unless (grep(/^\Q$value\E$/,@{$courses{$cdom.'_'.$cnum}{$sec}})) {
4376: push(@{$courses{$cdom.'_'.$cnum}{$sec}},$value);
4377: }
4378: } else {
4379: @{$courses{$cdom.'_'.$cnum}{$sec}} = ($value);
1.482 raeburn 4380: }
1.474 raeburn 4381: }
4382: }
1.51 www 4383: }
4384: }
1.474 raeburn 4385: return %courses;
1.51 www 4386: }
1.37 matthew 4387:
1.54 www 4388: ###############################################
1.474 raeburn 4389:
4390: sub blockcheck {
1.1189 raeburn 4391: my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
1.490 raeburn 4392:
1.1189 raeburn 4393: if (defined($udom) && defined($uname)) {
4394: # If uname and udom are for a course, check for blocks in the course.
4395: if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
4396: my ($startblock,$endblock,$triggerblock) =
4397: &get_blocks($setters,$activity,$udom,$uname,$url);
4398: return ($startblock,$endblock,$triggerblock);
4399: }
4400: } else {
1.490 raeburn 4401: $udom = $env{'user.domain'};
4402: $uname = $env{'user.name'};
4403: }
4404:
1.502 raeburn 4405: my $startblock = 0;
4406: my $endblock = 0;
1.1062 raeburn 4407: my $triggerblock = '';
1.482 raeburn 4408: my %live_courses = &findallcourses(undef,$uname,$udom);
1.474 raeburn 4409:
1.490 raeburn 4410: # If uname is for a user, and activity is course-specific, i.e.,
4411: # boards, chat or groups, check for blocking in current course only.
1.474 raeburn 4412:
1.490 raeburn 4413: if (($activity eq 'boards' || $activity eq 'chat' ||
1.1189 raeburn 4414: $activity eq 'groups' || $activity eq 'printout') &&
4415: ($env{'request.course.id'})) {
1.490 raeburn 4416: foreach my $key (keys(%live_courses)) {
4417: if ($key ne $env{'request.course.id'}) {
4418: delete($live_courses{$key});
4419: }
4420: }
4421: }
4422:
4423: my $otheruser = 0;
4424: my %own_courses;
4425: if ((($uname ne $env{'user.name'})) || ($udom ne $env{'user.domain'})) {
4426: # Resource belongs to user other than current user.
4427: $otheruser = 1;
4428: # Gather courses for current user
4429: %own_courses =
4430: &findallcourses(undef,$env{'user.name'},$env{'user.domain'});
4431: }
4432:
4433: # Gather active course roles - course coordinator, instructor,
4434: # exam proctor, ta, student, or custom role.
1.474 raeburn 4435:
4436: foreach my $course (keys(%live_courses)) {
1.482 raeburn 4437: my ($cdom,$cnum);
4438: if ((defined($env{'course.'.$course.'.domain'})) && (defined($env{'course.'.$course.'.num'}))) {
4439: $cdom = $env{'course.'.$course.'.domain'};
4440: $cnum = $env{'course.'.$course.'.num'};
4441: } else {
1.490 raeburn 4442: ($cdom,$cnum) = split(/_/,$course);
1.482 raeburn 4443: }
4444: my $no_ownblock = 0;
4445: my $no_userblock = 0;
1.533 raeburn 4446: if ($otheruser && $activity ne 'com') {
1.490 raeburn 4447: # Check if current user has 'evb' priv for this
4448: if (defined($own_courses{$course})) {
4449: foreach my $sec (keys(%{$own_courses{$course}})) {
4450: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
4451: if ($sec ne 'none') {
4452: $checkrole .= '/'.$sec;
4453: }
4454: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4455: $no_ownblock = 1;
4456: last;
4457: }
4458: }
4459: }
4460: # if they have 'evb' priv and are currently not playing student
4461: next if (($no_ownblock) &&
4462: ($env{'request.role'} !~ m{^st\./$cdom/$cnum}));
4463: }
1.474 raeburn 4464: foreach my $sec (keys(%{$live_courses{$course}})) {
1.482 raeburn 4465: my $checkrole = 'cm./'.$cdom.'/'.$cnum;
1.474 raeburn 4466: if ($sec ne 'none') {
1.482 raeburn 4467: $checkrole .= '/'.$sec;
1.474 raeburn 4468: }
1.490 raeburn 4469: if ($otheruser) {
4470: # Resource belongs to user other than current user.
4471: # Assemble privs for that user, and check for 'evb' priv.
1.1058 raeburn 4472: my (%allroles,%userroles);
4473: if (ref($live_courses{$course}{$sec}) eq 'ARRAY') {
4474: foreach my $entry (@{$live_courses{$course}{$sec}}) {
4475: my ($trole,$tdom,$tnum,$tsec);
4476: if ($entry =~ /^cr/) {
4477: ($trole,$tdom,$tnum,$tsec) =
4478: ($entry =~ m|^(cr/$match_domain/$match_username/\w+)\./($match_domain)/($match_username)/?(\w*)$|);
4479: } else {
4480: ($trole,$tdom,$tnum,$tsec) = split(/\//,$entry);
4481: }
4482: my ($spec,$area,$trest);
4483: $area = '/'.$tdom.'/'.$tnum;
4484: $trest = $tnum;
4485: if ($tsec ne '') {
4486: $area .= '/'.$tsec;
4487: $trest .= '/'.$tsec;
4488: }
4489: $spec = $trole.'.'.$area;
4490: if ($trole =~ /^cr/) {
4491: &Apache::lonnet::custom_roleprivs(\%allroles,$trole,
4492: $tdom,$spec,$trest,$area);
4493: } else {
4494: &Apache::lonnet::standard_roleprivs(\%allroles,$trole,
4495: $tdom,$spec,$trest,$area);
4496: }
4497: }
4498: my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
4499: if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
4500: if ($1) {
4501: $no_userblock = 1;
4502: last;
4503: }
1.486 raeburn 4504: }
4505: }
1.490 raeburn 4506: } else {
4507: # Resource belongs to current user
4508: # Check for 'evb' priv via lonnet::allowed().
1.482 raeburn 4509: if (&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) {
4510: $no_ownblock = 1;
4511: last;
4512: }
1.474 raeburn 4513: }
4514: }
4515: # if they have the evb priv and are currently not playing student
1.482 raeburn 4516: next if (($no_ownblock) &&
1.491 albertel 4517: ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
1.482 raeburn 4518: next if ($no_userblock);
1.474 raeburn 4519:
1.866 kalberla 4520: # Retrieve blocking times and identity of locker for course
1.490 raeburn 4521: # of specified user, unless user has 'evb' privilege.
1.502 raeburn 4522:
1.1062 raeburn 4523: my ($start,$end,$trigger) =
4524: &get_blocks($setters,$activity,$cdom,$cnum,$url);
1.502 raeburn 4525: if (($start != 0) &&
4526: (($startblock == 0) || ($startblock > $start))) {
4527: $startblock = $start;
1.1062 raeburn 4528: if ($trigger ne '') {
4529: $triggerblock = $trigger;
4530: }
1.502 raeburn 4531: }
4532: if (($end != 0) &&
4533: (($endblock == 0) || ($endblock < $end))) {
4534: $endblock = $end;
1.1062 raeburn 4535: if ($trigger ne '') {
4536: $triggerblock = $trigger;
4537: }
1.502 raeburn 4538: }
1.490 raeburn 4539: }
1.1062 raeburn 4540: return ($startblock,$endblock,$triggerblock);
1.490 raeburn 4541: }
4542:
4543: sub get_blocks {
1.1062 raeburn 4544: my ($setters,$activity,$cdom,$cnum,$url) = @_;
1.490 raeburn 4545: my $startblock = 0;
4546: my $endblock = 0;
1.1062 raeburn 4547: my $triggerblock = '';
1.490 raeburn 4548: my $course = $cdom.'_'.$cnum;
4549: $setters->{$course} = {};
4550: $setters->{$course}{'staff'} = [];
4551: $setters->{$course}{'times'} = [];
1.1062 raeburn 4552: $setters->{$course}{'triggers'} = [];
4553: my (@blockers,%triggered);
4554: my $now = time;
4555: my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
4556: if ($activity eq 'docs') {
4557: @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
4558: foreach my $block (@blockers) {
4559: if ($block =~ /^firstaccess____(.+)$/) {
4560: my $item = $1;
4561: my $type = 'map';
4562: my $timersymb = $item;
4563: if ($item eq 'course') {
4564: $type = 'course';
4565: } elsif ($item =~ /___\d+___/) {
4566: $type = 'resource';
4567: } else {
4568: $timersymb = &Apache::lonnet::symbread($item);
4569: }
4570: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4571: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4572: $triggered{$block} = {
4573: start => $start,
4574: end => $end,
4575: type => $type,
4576: };
4577: }
4578: }
4579: } else {
4580: foreach my $block (keys(%commblocks)) {
4581: if ($block =~ m/^(\d+)____(\d+)$/) {
4582: my ($start,$end) = ($1,$2);
4583: if ($start <= time && $end >= time) {
4584: if (ref($commblocks{$block}) eq 'HASH') {
4585: if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
4586: if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
4587: unless(grep(/^\Q$block\E$/,@blockers)) {
4588: push(@blockers,$block);
4589: }
4590: }
4591: }
4592: }
4593: }
4594: } elsif ($block =~ /^firstaccess____(.+)$/) {
4595: my $item = $1;
4596: my $timersymb = $item;
4597: my $type = 'map';
4598: if ($item eq 'course') {
4599: $type = 'course';
4600: } elsif ($item =~ /___\d+___/) {
4601: $type = 'resource';
4602: } else {
4603: $timersymb = &Apache::lonnet::symbread($item);
4604: }
4605: my $start = $env{'course.'.$cdom.'_'.$cnum.'.firstaccess.'.$timersymb};
4606: my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
4607: if ($start && $end) {
4608: if (($start <= time) && ($end >= time)) {
4609: unless (grep(/^\Q$block\E$/,@blockers)) {
4610: push(@blockers,$block);
4611: $triggered{$block} = {
4612: start => $start,
4613: end => $end,
4614: type => $type,
4615: };
4616: }
4617: }
1.490 raeburn 4618: }
1.1062 raeburn 4619: }
4620: }
4621: }
4622: foreach my $blocker (@blockers) {
4623: my ($staff_name,$staff_dom,$title,$blocks) =
4624: &parse_block_record($commblocks{$blocker});
4625: push(@{$$setters{$course}{'staff'}},[$staff_name,$staff_dom]);
4626: my ($start,$end,$triggertype);
4627: if ($blocker =~ m/^(\d+)____(\d+)$/) {
4628: ($start,$end) = ($1,$2);
4629: } elsif (ref($triggered{$blocker}) eq 'HASH') {
4630: $start = $triggered{$blocker}{'start'};
4631: $end = $triggered{$blocker}{'end'};
4632: $triggertype = $triggered{$blocker}{'type'};
4633: }
4634: if ($start) {
4635: push(@{$$setters{$course}{'times'}}, [$start,$end]);
4636: if ($triggertype) {
4637: push(@{$$setters{$course}{'triggers'}},$triggertype);
4638: } else {
4639: push(@{$$setters{$course}{'triggers'}},0);
4640: }
4641: if ( ($startblock == 0) || ($startblock > $start) ) {
4642: $startblock = $start;
4643: if ($triggertype) {
4644: $triggerblock = $blocker;
1.474 raeburn 4645: }
4646: }
1.1062 raeburn 4647: if ( ($endblock == 0) || ($endblock < $end) ) {
4648: $endblock = $end;
4649: if ($triggertype) {
4650: $triggerblock = $blocker;
4651: }
4652: }
1.474 raeburn 4653: }
4654: }
1.1062 raeburn 4655: return ($startblock,$endblock,$triggerblock);
1.474 raeburn 4656: }
4657:
4658: sub parse_block_record {
4659: my ($record) = @_;
4660: my ($setuname,$setudom,$title,$blocks);
4661: if (ref($record) eq 'HASH') {
4662: ($setuname,$setudom) = split(/:/,$record->{'setter'});
4663: $title = &unescape($record->{'event'});
4664: $blocks = $record->{'blocks'};
4665: } else {
4666: my @data = split(/:/,$record,3);
4667: if (scalar(@data) eq 2) {
4668: $title = $data[1];
4669: ($setuname,$setudom) = split(/@/,$data[0]);
4670: } else {
4671: ($setuname,$setudom,$title) = @data;
4672: }
4673: $blocks = { 'com' => 'on' };
4674: }
4675: return ($setuname,$setudom,$title,$blocks);
4676: }
4677:
1.854 kalberla 4678: sub blocking_status {
1.1189 raeburn 4679: my ($activity,$uname,$udom,$url,$is_course) = @_;
1.1061 raeburn 4680: my %setters;
1.890 droeschl 4681:
1.1061 raeburn 4682: # check for active blocking
1.1062 raeburn 4683: my ($startblock,$endblock,$triggerblock) =
1.1189 raeburn 4684: &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
1.1062 raeburn 4685: my $blocked = 0;
4686: if ($startblock && $endblock) {
4687: $blocked = 1;
4688: }
1.890 droeschl 4689:
1.1061 raeburn 4690: # caller just wants to know whether a block is active
4691: if (!wantarray) { return $blocked; }
4692:
4693: # build a link to a popup window containing the details
4694: my $querystring = "?activity=$activity";
4695: # $uname and $udom decide whose portfolio the user is trying to look at
1.1062 raeburn 4696: if ($activity eq 'port') {
4697: $querystring .= "&udom=$udom" if $udom;
4698: $querystring .= "&uname=$uname" if $uname;
4699: } elsif ($activity eq 'docs') {
4700: $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
4701: }
1.1061 raeburn 4702:
4703: my $output .= <<'END_MYBLOCK';
4704: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
4705: var options = "width=" + w + ",height=" + h + ",";
4706: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
4707: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
4708: var newWin = window.open(url, wdwName, options);
4709: newWin.focus();
4710: }
1.890 droeschl 4711: END_MYBLOCK
1.854 kalberla 4712:
1.1061 raeburn 4713: $output = Apache::lonhtmlcommon::scripttag($output);
1.890 droeschl 4714:
1.1061 raeburn 4715: my $popupUrl = "/adm/blockingstatus/$querystring";
1.1062 raeburn 4716: my $text = &mt('Communication Blocked');
4717: if ($activity eq 'docs') {
4718: $text = &mt('Content Access Blocked');
1.1063 raeburn 4719: } elsif ($activity eq 'printout') {
4720: $text = &mt('Printing Blocked');
1.1062 raeburn 4721: }
1.1061 raeburn 4722: $output .= <<"END_BLOCK";
1.867 kalberla 4723: <div class='LC_comblock'>
1.869 kalberla 4724: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4725: title='$text'>
4726: <img class='LC_noBorder LC_middle' title='$text' src='/res/adm/pages/comblock.png' alt='$text'/></a>
1.869 kalberla 4727: <a onclick='openWindow("$popupUrl","Blocking Table",600,300,"no","no");return false;' href='/adm/blockingstatus/$querystring'
1.890 droeschl 4728: title='$text'>$text</a>
1.867 kalberla 4729: </div>
4730:
4731: END_BLOCK
1.474 raeburn 4732:
1.1061 raeburn 4733: return ($blocked, $output);
1.854 kalberla 4734: }
1.490 raeburn 4735:
1.60 matthew 4736: ###############################################
4737:
1.682 raeburn 4738: sub check_ip_acc {
4739: my ($acc)=@_;
4740: &Apache::lonxml::debug("acc is $acc");
4741: if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
4742: return 1;
4743: }
4744: my $allowed=0;
4745: my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'};
4746:
4747: my $name;
4748: foreach my $pattern (split(',',$acc)) {
4749: $pattern =~ s/^\s*//;
4750: $pattern =~ s/\s*$//;
4751: if ($pattern =~ /\*$/) {
4752: #35.8.*
4753: $pattern=~s/\*//;
4754: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4755: } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
4756: #35.8.3.[34-56]
4757: my $low=$2;
4758: my $high=$3;
4759: $pattern=$1;
4760: if ($ip =~ /^\Q$pattern\E/) {
4761: my $last=(split(/\./,$ip))[3];
4762: if ($last <=$high && $last >=$low) { $allowed=1; }
4763: }
4764: } elsif ($pattern =~ /^\*/) {
4765: #*.msu.edu
4766: $pattern=~s/\*//;
4767: if (!defined($name)) {
4768: use Socket;
4769: my $netaddr=inet_aton($ip);
4770: ($name)=gethostbyaddr($netaddr,AF_INET);
4771: }
4772: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4773: } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
4774: #127.0.0.1
4775: if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
4776: } else {
4777: #some.name.com
4778: if (!defined($name)) {
4779: use Socket;
4780: my $netaddr=inet_aton($ip);
4781: ($name)=gethostbyaddr($netaddr,AF_INET);
4782: }
4783: if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
4784: }
4785: if ($allowed) { last; }
4786: }
4787: return $allowed;
4788: }
4789:
4790: ###############################################
4791:
1.60 matthew 4792: =pod
4793:
1.112 bowersj2 4794: =head1 Domain Template Functions
4795:
4796: =over 4
4797:
4798: =item * &determinedomain()
1.60 matthew 4799:
4800: Inputs: $domain (usually will be undef)
4801:
1.63 www 4802: Returns: Determines which domain should be used for designs
1.60 matthew 4803:
4804: =cut
1.54 www 4805:
1.60 matthew 4806: ###############################################
1.63 www 4807: sub determinedomain {
4808: my $domain=shift;
1.531 albertel 4809: if (! $domain) {
1.60 matthew 4810: # Determine domain if we have not been given one
1.893 raeburn 4811: $domain = &Apache::lonnet::default_login_domain();
1.258 albertel 4812: if ($env{'user.domain'}) { $domain=$env{'user.domain'}; }
4813: if ($env{'request.role.domain'}) {
4814: $domain=$env{'request.role.domain'};
1.60 matthew 4815: }
4816: }
1.63 www 4817: return $domain;
4818: }
4819: ###############################################
1.517 raeburn 4820:
1.518 albertel 4821: sub devalidate_domconfig_cache {
4822: my ($udom)=@_;
4823: &Apache::lonnet::devalidate_cache_new('domainconfig',$udom);
4824: }
4825:
4826: # ---------------------- Get domain configuration for a domain
4827: sub get_domainconf {
4828: my ($udom) = @_;
4829: my $cachetime=1800;
4830: my ($result,$cached)=&Apache::lonnet::is_cached_new('domainconfig',$udom);
4831: if (defined($cached)) { return %{$result}; }
4832:
4833: my %domconfig = &Apache::lonnet::get_dom('configuration',
1.948 raeburn 4834: ['login','rolecolors','autoenroll'],$udom);
1.632 raeburn 4835: my (%designhash,%legacy);
1.518 albertel 4836: if (keys(%domconfig) > 0) {
4837: if (ref($domconfig{'login'}) eq 'HASH') {
1.632 raeburn 4838: if (keys(%{$domconfig{'login'}})) {
4839: foreach my $key (keys(%{$domconfig{'login'}})) {
1.699 raeburn 4840: if (ref($domconfig{'login'}{$key}) eq 'HASH') {
1.946 raeburn 4841: if ($key eq 'loginvia') {
4842: if (ref($domconfig{'login'}{'loginvia'}) eq 'HASH') {
1.1013 raeburn 4843: foreach my $hostname (keys(%{$domconfig{'login'}{'loginvia'}})) {
1.948 raeburn 4844: if (ref($domconfig{'login'}{'loginvia'}{$hostname}) eq 'HASH') {
4845: if ($domconfig{'login'}{'loginvia'}{$hostname}{'server'}) {
4846: my $server = $domconfig{'login'}{'loginvia'}{$hostname}{'server'};
4847: $designhash{$udom.'.login.loginvia'} = $server;
4848: if ($domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'} eq 'custom') {
4849:
4850: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'custompath'};
4851: } else {
1.1013 raeburn 4852: $designhash{$udom.'.login.loginvia_'.$hostname} = $server.':'.$domconfig{'login'}{'loginvia'}{$hostname}{'serverpath'};
1.948 raeburn 4853: }
4854: if ($domconfig{'login'}{'loginvia'}{$hostname}{'exempt'}) {
4855: $designhash{$udom.'.login.loginvia_exempt_'.$hostname} = $domconfig{'login'}{'loginvia'}{$hostname}{'exempt'};
4856: }
1.946 raeburn 4857: }
4858: }
4859: }
4860: }
4861: } else {
4862: foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
4863: $designhash{$udom.'.login.'.$key.'_'.$img} =
4864: $domconfig{'login'}{$key}{$img};
4865: }
1.699 raeburn 4866: }
4867: } else {
4868: $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key};
4869: }
1.632 raeburn 4870: }
4871: } else {
4872: $legacy{'login'} = 1;
1.518 albertel 4873: }
1.632 raeburn 4874: } else {
4875: $legacy{'login'} = 1;
1.518 albertel 4876: }
4877: if (ref($domconfig{'rolecolors'}) eq 'HASH') {
1.632 raeburn 4878: if (keys(%{$domconfig{'rolecolors'}})) {
4879: foreach my $role (keys(%{$domconfig{'rolecolors'}})) {
4880: if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') {
4881: foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) {
4882: $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item};
4883: }
1.518 albertel 4884: }
4885: }
1.632 raeburn 4886: } else {
4887: $legacy{'rolecolors'} = 1;
1.518 albertel 4888: }
1.632 raeburn 4889: } else {
4890: $legacy{'rolecolors'} = 1;
1.518 albertel 4891: }
1.948 raeburn 4892: if (ref($domconfig{'autoenroll'}) eq 'HASH') {
4893: if ($domconfig{'autoenroll'}{'co-owners'}) {
4894: $designhash{$udom.'.autoassign.co-owners'}=$domconfig{'autoenroll'}{'co-owners'};
4895: }
4896: }
1.632 raeburn 4897: if (keys(%legacy) > 0) {
4898: my %legacyhash = &get_legacy_domconf($udom);
4899: foreach my $item (keys(%legacyhash)) {
4900: if ($item =~ /^\Q$udom\E\.login/) {
4901: if ($legacy{'login'}) {
4902: $designhash{$item} = $legacyhash{$item};
4903: }
4904: } else {
4905: if ($legacy{'rolecolors'}) {
4906: $designhash{$item} = $legacyhash{$item};
4907: }
1.518 albertel 4908: }
4909: }
4910: }
1.632 raeburn 4911: } else {
4912: %designhash = &get_legacy_domconf($udom);
1.518 albertel 4913: }
4914: &Apache::lonnet::do_cache_new('domainconfig',$udom,\%designhash,
4915: $cachetime);
4916: return %designhash;
4917: }
4918:
1.632 raeburn 4919: sub get_legacy_domconf {
4920: my ($udom) = @_;
4921: my %legacyhash;
4922: my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
4923: my $designfile = $designdir.'/'.$udom.'.tab';
4924: if (-e $designfile) {
4925: if ( open (my $fh,"<$designfile") ) {
4926: while (my $line = <$fh>) {
4927: next if ($line =~ /^\#/);
4928: chomp($line);
4929: my ($key,$val)=(split(/\=/,$line));
4930: if ($val) { $legacyhash{$udom.'.'.$key}=$val; }
4931: }
4932: close($fh);
4933: }
4934: }
1.1026 raeburn 4935: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/lonDomLogos/'.$udom.'.gif') {
1.632 raeburn 4936: $legacyhash{$udom.'.login.domlogo'} = "/adm/lonDomLogos/$udom.gif";
4937: }
4938: return %legacyhash;
4939: }
4940:
1.63 www 4941: =pod
4942:
1.112 bowersj2 4943: =item * &domainlogo()
1.63 www 4944:
4945: Inputs: $domain (usually will be undef)
4946:
4947: Returns: A link to a domain logo, if the domain logo exists.
4948: If the domain logo does not exist, a description of the domain.
4949:
4950: =cut
1.112 bowersj2 4951:
1.63 www 4952: ###############################################
4953: sub domainlogo {
1.517 raeburn 4954: my $domain = &determinedomain(shift);
1.518 albertel 4955: my %designhash = &get_domainconf($domain);
1.517 raeburn 4956: # See if there is a logo
4957: if ($designhash{$domain.'.login.domlogo'} ne '') {
1.519 raeburn 4958: my $imgsrc = $designhash{$domain.'.login.domlogo'};
1.538 albertel 4959: if ($imgsrc =~ m{^/(adm|res)/}) {
4960: if ($imgsrc =~ m{^/res/}) {
4961: my $local_name = &Apache::lonnet::filelocation('',$imgsrc);
4962: &Apache::lonnet::repcopy($local_name);
4963: }
4964: $imgsrc = &lonhttpdurl($imgsrc);
1.519 raeburn 4965: }
4966: return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
1.514 albertel 4967: } elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
4968: return &Apache::lonnet::domain($domain,'description');
1.59 www 4969: } else {
1.60 matthew 4970: return '';
1.59 www 4971: }
4972: }
1.63 www 4973: ##############################################
4974:
4975: =pod
4976:
1.112 bowersj2 4977: =item * &designparm()
1.63 www 4978:
4979: Inputs: $which parameter; $domain (usually will be undef)
4980:
4981: Returns: value of designparamter $which
4982:
4983: =cut
1.112 bowersj2 4984:
1.397 albertel 4985:
1.400 albertel 4986: ##############################################
1.397 albertel 4987: sub designparm {
4988: my ($which,$domain)=@_;
4989: if (exists($env{'environment.color.'.$which})) {
1.817 bisitz 4990: return $env{'environment.color.'.$which};
1.96 www 4991: }
1.63 www 4992: $domain=&determinedomain($domain);
1.1016 raeburn 4993: my %domdesign;
4994: unless ($domain eq 'public') {
4995: %domdesign = &get_domainconf($domain);
4996: }
1.520 raeburn 4997: my $output;
1.517 raeburn 4998: if ($domdesign{$domain.'.'.$which} ne '') {
1.817 bisitz 4999: $output = $domdesign{$domain.'.'.$which};
1.63 www 5000: } else {
1.520 raeburn 5001: $output = $defaultdesign{$which};
5002: }
5003: if (($which =~ /^(student|coordinator|author|admin)\.img$/) ||
1.635 raeburn 5004: ($which =~ /login\.(img|logo|domlogo|login)/)) {
1.538 albertel 5005: if ($output =~ m{^/(adm|res)/}) {
1.817 bisitz 5006: if ($output =~ m{^/res/}) {
5007: my $local_name = &Apache::lonnet::filelocation('',$output);
5008: &Apache::lonnet::repcopy($local_name);
5009: }
1.520 raeburn 5010: $output = &lonhttpdurl($output);
5011: }
1.63 www 5012: }
1.520 raeburn 5013: return $output;
1.63 www 5014: }
1.59 www 5015:
1.822 bisitz 5016: ##############################################
5017: =pod
5018:
1.832 bisitz 5019: =item * &authorspace()
5020:
1.1028 raeburn 5021: Inputs: $url (usually will be undef).
1.832 bisitz 5022:
1.1132 raeburn 5023: Returns: Path to Authoring Space containing the resource or
1.1028 raeburn 5024: directory being viewed (or for which action is being taken).
5025: If $url is provided, and begins /priv/<domain>/<uname>
5026: the path will be that portion of the $context argument.
5027: Otherwise the path will be for the author space of the current
5028: user when the current role is author, or for that of the
5029: co-author/assistant co-author space when the current role
5030: is co-author or assistant co-author.
1.832 bisitz 5031:
5032: =cut
5033:
5034: sub authorspace {
1.1028 raeburn 5035: my ($url) = @_;
5036: if ($url ne '') {
5037: if ($url =~ m{^(/priv/$match_domain/$match_username/)}) {
5038: return $1;
5039: }
5040: }
1.832 bisitz 5041: my $caname = '';
1.1024 www 5042: my $cadom = '';
1.1028 raeburn 5043: if ($env{'request.role'} =~ /^(?:ca|aa)/) {
1.1024 www 5044: ($cadom,$caname) =
1.832 bisitz 5045: ($env{'request.role'}=~/($match_domain)\/($match_username)$/);
1.1028 raeburn 5046: } elsif ($env{'request.role'} =~ m{^au\./($match_domain)/}) {
1.832 bisitz 5047: $caname = $env{'user.name'};
1.1024 www 5048: $cadom = $env{'user.domain'};
1.832 bisitz 5049: }
1.1028 raeburn 5050: if (($caname ne '') && ($cadom ne '')) {
5051: return "/priv/$cadom/$caname/";
5052: }
5053: return;
1.832 bisitz 5054: }
5055:
5056: ##############################################
5057: =pod
5058:
1.822 bisitz 5059: =item * &head_subbox()
5060:
5061: Inputs: $content (contains HTML code with page functions, etc.)
5062:
5063: Returns: HTML div with $content
5064: To be included in page header
5065:
5066: =cut
5067:
5068: sub head_subbox {
5069: my ($content)=@_;
5070: my $output =
1.993 raeburn 5071: '<div class="LC_head_subbox">'
1.822 bisitz 5072: .$content
5073: .'</div>'
5074: }
5075:
5076: ##############################################
5077: =pod
5078:
5079: =item * &CSTR_pageheader()
5080:
1.1026 raeburn 5081: Input: (optional) filename from which breadcrumb trail is built.
5082: In most cases no input as needed, as $env{'request.filename'}
5083: is appropriate for use in building the breadcrumb trail.
1.822 bisitz 5084:
5085: Returns: HTML div with CSTR path and recent box
1.1132 raeburn 5086: To be included on Authoring Space pages
1.822 bisitz 5087:
5088: =cut
5089:
5090: sub CSTR_pageheader {
1.1026 raeburn 5091: my ($trailfile) = @_;
5092: if ($trailfile eq '') {
5093: $trailfile = $env{'request.filename'};
5094: }
5095:
5096: # this is for resources; directories have customtitle, and crumbs
5097: # and select recent are created in lonpubdir.pm
5098:
5099: my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
1.1022 www 5100: my ($udom,$uname,$thisdisfn)=
1.1113 raeburn 5101: ($trailfile =~ m{^\Q$londocroot\E/priv/([^/]+)/([^/]+)(?:|/(.*))$});
1.1026 raeburn 5102: my $formaction = "/priv/$udom/$uname/$thisdisfn";
5103: $formaction =~ s{/+}{/}g;
1.822 bisitz 5104:
5105: my $parentpath = '';
5106: my $lastitem = '';
5107: if ($thisdisfn =~ m-(.+/)([^/]*)$-) {
5108: $parentpath = $1;
5109: $lastitem = $2;
5110: } else {
5111: $lastitem = $thisdisfn;
5112: }
1.921 bisitz 5113:
5114: my $output =
1.822 bisitz 5115: '<div>'
5116: .&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
1.1132 raeburn 5117: .'<b>'.&mt('Authoring Space:').'</b> '
1.822 bisitz 5118: .'<form name="dirs" method="post" action="'.$formaction
1.921 bisitz 5119: .'" target="_top">' #FIXME lonpubdir: target="_parent"
1.1024 www 5120: .&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);
1.921 bisitz 5121:
5122: if ($lastitem) {
5123: $output .=
5124: '<span class="LC_filename">'
5125: .$lastitem
5126: .'</span>';
5127: }
5128: $output .=
5129: '<br />'
1.822 bisitz 5130: #FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"
5131: .&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
5132: .'</form>'
5133: .&Apache::lonmenu::constspaceform()
5134: .'</div>';
1.921 bisitz 5135:
5136: return $output;
1.822 bisitz 5137: }
5138:
1.60 matthew 5139: ###############################################
5140: ###############################################
5141:
5142: =pod
5143:
1.112 bowersj2 5144: =back
5145:
1.549 albertel 5146: =head1 HTML Helpers
1.112 bowersj2 5147:
5148: =over 4
5149:
5150: =item * &bodytag()
1.60 matthew 5151:
5152: Returns a uniform header for LON-CAPA web pages.
5153:
5154: Inputs:
5155:
1.112 bowersj2 5156: =over 4
5157:
5158: =item * $title, A title to be displayed on the page.
5159:
5160: =item * $function, the current role (can be undef).
5161:
5162: =item * $addentries, extra parameters for the <body> tag.
5163:
5164: =item * $bodyonly, if defined, only return the <body> tag.
5165:
5166: =item * $domain, if defined, force a given domain.
5167:
5168: =item * $forcereg, if page should register as content page (relevant for
1.86 www 5169: text interface only)
1.60 matthew 5170:
1.814 bisitz 5171: =item * $no_nav_bar, if true, keep the 'what is this' info but remove the
5172: navigational links
1.317 albertel 5173:
1.338 albertel 5174: =item * $bgcolor, used to override the bgcolor on a webpage to a specific value
5175:
1.460 albertel 5176: =item * $args, optional argument valid values are
5177: no_auto_mt_title -> prevents &mt()ing the title arg
1.562 albertel 5178: inherit_jsmath -> when creating popup window in a page,
5179: should it have jsmath forced on by the
5180: current page
1.460 albertel 5181:
1.1096 raeburn 5182: =item * $advtoolsref, optional argument, ref to an array containing
5183: inlineremote items to be added in "Functions" menu below
5184: breadcrumbs.
5185:
1.112 bowersj2 5186: =back
5187:
1.60 matthew 5188: Returns: A uniform header for LON-CAPA web pages.
5189: If $bodyonly is nonzero, a string containing a <body> tag will be returned.
5190: If $bodyonly is undef or zero, an html string containing a <body> tag and
5191: other decorations will be returned.
5192:
5193: =cut
5194:
1.54 www 5195: sub bodytag {
1.831 bisitz 5196: my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
1.1096 raeburn 5197: $no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;
1.339 albertel 5198:
1.954 raeburn 5199: my $public;
5200: if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
5201: || ($env{'user.name'} eq '') && ($env{'user.domain'} eq '')) {
5202: $public = 1;
5203: }
1.460 albertel 5204: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
1.1154 raeburn 5205: my $httphost = $args->{'use_absolute'};
1.339 albertel 5206:
1.183 matthew 5207: $function = &get_users_function() if (!$function);
1.339 albertel 5208: my $img = &designparm($function.'.img',$domain);
5209: my $font = &designparm($function.'.font',$domain);
5210: my $pgbg = $bgcolor || &designparm($function.'.pgbg',$domain);
5211:
1.803 bisitz 5212: my %design = ( 'style' => 'margin-top: 0',
1.535 albertel 5213: 'bgcolor' => $pgbg,
1.339 albertel 5214: 'text' => $font,
5215: 'alink' => &designparm($function.'.alink',$domain),
5216: 'vlink' => &designparm($function.'.vlink',$domain),
5217: 'link' => &designparm($function.'.link',$domain),);
1.438 albertel 5218: @design{keys(%$addentries)} = @$addentries{keys(%$addentries)};
1.339 albertel 5219:
1.63 www 5220: # role and realm
1.1178 raeburn 5221: my ($role,$realm) = split(m{\./},$env{'request.role'},2);
5222: if ($realm) {
5223: $realm = '/'.$realm;
5224: }
1.378 raeburn 5225: if ($role eq 'ca') {
1.479 albertel 5226: my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
1.500 albertel 5227: $realm = &plainname($rname,$rdom);
1.378 raeburn 5228: }
1.55 www 5229: # realm
1.258 albertel 5230: if ($env{'request.course.id'}) {
1.378 raeburn 5231: if ($env{'request.role'} !~ /^cr/) {
5232: $role = &Apache::lonnet::plaintext($role,&course_type());
5233: }
1.898 raeburn 5234: if ($env{'request.course.sec'}) {
5235: $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
5236: }
1.359 albertel 5237: $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
1.378 raeburn 5238: } else {
5239: $role = &Apache::lonnet::plaintext($role);
1.54 www 5240: }
1.433 albertel 5241:
1.359 albertel 5242: if (!$realm) { $realm=' '; }
1.330 albertel 5243:
1.438 albertel 5244: my $extra_body_attr = &make_attr_string($forcereg,\%design);
1.329 albertel 5245:
1.101 www 5246: # construct main body tag
1.359 albertel 5247: my $bodytag = "<body $extra_body_attr>".
1.562 albertel 5248: &Apache::lontexconvert::init_math_support($args->{'inherit_jsmath'});
1.252 albertel 5249:
1.1131 raeburn 5250: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
5251:
1.1130 raeburn 5252: if (($bodyonly) || ($no_nav_bar) || ($env{'form.inhibitmenu'} eq 'yes')) {
1.60 matthew 5253: return $bodytag;
1.1130 raeburn 5254: }
1.359 albertel 5255:
1.954 raeburn 5256: if ($public) {
1.433 albertel 5257: undef($role);
5258: }
1.359 albertel 5259:
1.762 bisitz 5260: my $titleinfo = '<h1>'.$title.'</h1>';
1.359 albertel 5261: #
5262: # Extra info if you are the DC
5263: my $dc_info = '';
5264: if ($env{'user.adv'} && exists($env{'user.role.dc./'.
5265: $env{'course.'.$env{'request.course.id'}.
5266: '.domain'}.'/'})) {
5267: my $cid = $env{'request.course.id'};
1.917 raeburn 5268: $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
1.380 www 5269: $dc_info =~ s/\s+$//;
1.359 albertel 5270: }
5271:
1.898 raeburn 5272: $role = '<span class="LC_nobreak">('.$role.')</span>' if $role;
1.853 droeschl 5273:
1.903 droeschl 5274: if ($env{'request.state'} eq 'construct') { $forcereg=1; }
5275:
5276: # if ($env{'request.state'} eq 'construct') {
5277: # $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
5278: # }
5279:
1.1130 raeburn 5280: $bodytag .= Apache::lonhtmlcommon::scripttag(
1.1154 raeburn 5281: Apache::lonmenu::utilityfunctions($httphost), 'start');
1.359 albertel 5282:
1.1130 raeburn 5283: my ($left,$right) = Apache::lonmenu::primary_menu();
1.359 albertel 5284:
1.916 droeschl 5285: if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
1.917 raeburn 5286: if ($dc_info) {
5287: $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|;
5288: }
1.1130 raeburn 5289: $bodytag .= qq|<div id="LC_nav_bar">$left $role<br />
1.916 droeschl 5290: <em>$realm</em> $dc_info</div>|;
1.903 droeschl 5291: return $bodytag;
5292: }
1.894 droeschl 5293:
1.927 raeburn 5294: unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
1.1130 raeburn 5295: $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|;
1.927 raeburn 5296: }
1.916 droeschl 5297:
1.1130 raeburn 5298: $bodytag .= $right;
1.852 droeschl 5299:
1.917 raeburn 5300: if ($dc_info) {
5301: $dc_info = &dc_courseid_toggle($dc_info);
5302: }
5303: $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|;
1.916 droeschl 5304:
1.1169 raeburn 5305: #if directed to not display the secondary menu, don't.
1.1168 raeburn 5306: if ($args->{'no_secondary_menu'}) {
5307: return $bodytag;
5308: }
1.1169 raeburn 5309: #don't show menus for public users
1.954 raeburn 5310: if (!$public){
1.1154 raeburn 5311: $bodytag .= Apache::lonmenu::secondary_menu($httphost);
1.903 droeschl 5312: $bodytag .= Apache::lonmenu::serverform();
1.920 raeburn 5313: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
5314: if ($env{'request.state'} eq 'construct') {
1.962 droeschl 5315: $bodytag .= &Apache::lonmenu::innerregister($forcereg,
1.920 raeburn 5316: $args->{'bread_crumbs'});
1.1096 raeburn 5317: } elsif ($forcereg) {
5318: $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
5319: $args->{'group'});
5320: } else {
5321: $bodytag .=
5322: &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
5323: $forcereg,$args->{'group'},
5324: $args->{'bread_crumbs'},
5325: $advtoolsref);
1.920 raeburn 5326: }
1.903 droeschl 5327: }else{
5328: # this is to seperate menu from content when there's no secondary
5329: # menu. Especially needed for public accessible ressources.
5330: $bodytag .= '<hr style="clear:both" />';
5331: $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
1.235 raeburn 5332: }
1.903 droeschl 5333:
1.235 raeburn 5334: return $bodytag;
1.182 matthew 5335: }
5336:
1.917 raeburn 5337: sub dc_courseid_toggle {
5338: my ($dc_info) = @_;
1.980 raeburn 5339: return ' <span id="dccidtext" class="LC_cusr_subheading LC_nobreak">'.
1.1069 raeburn 5340: '<a href="javascript:showCourseID();" class="LC_menubuttons_link">'.
1.917 raeburn 5341: &mt('(More ...)').'</a></span>'.
5342: '<div id="dccid" class="LC_dccid">'.$dc_info.'</div>';
5343: }
5344:
1.330 albertel 5345: sub make_attr_string {
5346: my ($register,$attr_ref) = @_;
5347:
5348: if ($attr_ref && !ref($attr_ref)) {
5349: die("addentries Must be a hash ref ".
5350: join(':',caller(1))." ".
5351: join(':',caller(0))." ");
5352: }
5353:
5354: if ($register) {
1.339 albertel 5355: my ($on_load,$on_unload);
5356: foreach my $key (keys(%{$attr_ref})) {
5357: if (lc($key) eq 'onload') {
5358: $on_load.=$attr_ref->{$key}.';';
5359: delete($attr_ref->{$key});
5360:
5361: } elsif (lc($key) eq 'onunload') {
5362: $on_unload.=$attr_ref->{$key}.';';
5363: delete($attr_ref->{$key});
5364: }
5365: }
1.953 droeschl 5366: $attr_ref->{'onload'} = $on_load;
5367: $attr_ref->{'onunload'}= $on_unload;
1.330 albertel 5368: }
1.339 albertel 5369:
1.330 albertel 5370: my $attr_string;
1.1159 raeburn 5371: foreach my $attr (sort(keys(%$attr_ref))) {
1.330 albertel 5372: $attr_string .= " $attr=\"".$attr_ref->{$attr}.'" ';
5373: }
5374: return $attr_string;
5375: }
5376:
5377:
1.182 matthew 5378: ###############################################
1.251 albertel 5379: ###############################################
5380:
5381: =pod
5382:
5383: =item * &endbodytag()
5384:
5385: Returns a uniform footer for LON-CAPA web pages.
5386:
1.635 raeburn 5387: Inputs: 1 - optional reference to an args hash
5388: If in the hash, key for noredirectlink has a value which evaluates to true,
5389: a 'Continue' link is not displayed if the page contains an
5390: internal redirect in the <head></head> section,
5391: i.e., $env{'internal.head.redirect'} exists
1.251 albertel 5392:
5393: =cut
5394:
5395: sub endbodytag {
1.635 raeburn 5396: my ($args) = @_;
1.1080 raeburn 5397: my $endbodytag;
5398: unless ((ref($args) eq 'HASH') && ($args->{'notbody'})) {
5399: $endbodytag='</body>';
5400: }
1.269 albertel 5401: $endbodytag=&Apache::lontexconvert::jsMath_process()."\n".$endbodytag;
1.315 albertel 5402: if ( exists( $env{'internal.head.redirect'} ) ) {
1.635 raeburn 5403: if (!(ref($args) eq 'HASH' && $args->{'noredirectlink'})) {
5404: $endbodytag=
5405: "<br /><a href=\"$env{'internal.head.redirect'}\">".
5406: &mt('Continue').'</a>'.
5407: $endbodytag;
5408: }
1.315 albertel 5409: }
1.251 albertel 5410: return $endbodytag;
5411: }
5412:
1.352 albertel 5413: =pod
5414:
5415: =item * &standard_css()
5416:
5417: Returns a style sheet
5418:
5419: Inputs: (all optional)
5420: domain -> force to color decorate a page for a specific
5421: domain
5422: function -> force usage of a specific rolish color scheme
5423: bgcolor -> override the default page bgcolor
5424:
5425: =cut
5426:
1.343 albertel 5427: sub standard_css {
1.345 albertel 5428: my ($function,$domain,$bgcolor) = @_;
1.352 albertel 5429: $function = &get_users_function() if (!$function);
5430: my $img = &designparm($function.'.img', $domain);
5431: my $tabbg = &designparm($function.'.tabbg', $domain);
5432: my $font = &designparm($function.'.font', $domain);
1.801 tempelho 5433: my $fontmenu = &designparm($function.'.fontmenu', $domain);
1.791 tempelho 5434: #second colour for later usage
1.345 albertel 5435: my $sidebg = &designparm($function.'.sidebg',$domain);
1.382 albertel 5436: my $pgbg_or_bgcolor =
5437: $bgcolor ||
1.352 albertel 5438: &designparm($function.'.pgbg', $domain);
1.382 albertel 5439: my $pgbg = &designparm($function.'.pgbg', $domain);
1.352 albertel 5440: my $alink = &designparm($function.'.alink', $domain);
5441: my $vlink = &designparm($function.'.vlink', $domain);
5442: my $link = &designparm($function.'.link', $domain);
5443:
1.602 albertel 5444: my $sans = 'Verdana,Arial,Helvetica,sans-serif';
1.395 albertel 5445: my $mono = 'monospace';
1.850 bisitz 5446: my $data_table_head = $sidebg;
5447: my $data_table_light = '#FAFAFA';
1.1060 bisitz 5448: my $data_table_dark = '#E0E0E0';
1.470 banghart 5449: my $data_table_darker = '#CCCCCC';
1.349 albertel 5450: my $data_table_highlight = '#FFFF00';
1.352 albertel 5451: my $mail_new = '#FFBB77';
5452: my $mail_new_hover = '#DD9955';
5453: my $mail_read = '#BBBB77';
5454: my $mail_read_hover = '#999944';
5455: my $mail_replied = '#AAAA88';
5456: my $mail_replied_hover = '#888855';
5457: my $mail_other = '#99BBBB';
5458: my $mail_other_hover = '#669999';
1.391 albertel 5459: my $table_header = '#DDDDDD';
1.489 raeburn 5460: my $feedback_link_bg = '#BBBBBB';
1.911 bisitz 5461: my $lg_border_color = '#C8C8C8';
1.952 onken 5462: my $button_hover = '#BF2317';
1.392 albertel 5463:
1.608 albertel 5464: my $border = ($env{'browser.type'} eq 'explorer' ||
1.911 bisitz 5465: $env{'browser.type'} eq 'safari' ) ? '0 2px 0 2px'
5466: : '0 3px 0 4px';
1.448 albertel 5467:
1.523 albertel 5468:
1.343 albertel 5469: return <<END;
1.947 droeschl 5470:
5471: /* needed for iframe to allow 100% height in FF */
5472: body, html {
5473: margin: 0;
5474: padding: 0 0.5%;
5475: height: 99%; /* to avoid scrollbars */
5476: }
5477:
1.795 www 5478: body {
1.911 bisitz 5479: font-family: $sans;
5480: line-height:130%;
5481: font-size:0.83em;
5482: color:$font;
1.795 www 5483: }
5484:
1.959 onken 5485: a:focus,
5486: a:focus img {
1.795 www 5487: color: red;
5488: }
1.698 harmsja 5489:
1.911 bisitz 5490: form, .inline {
5491: display: inline;
1.795 www 5492: }
1.721 harmsja 5493:
1.795 www 5494: .LC_right {
1.911 bisitz 5495: text-align:right;
1.795 www 5496: }
5497:
5498: .LC_middle {
1.911 bisitz 5499: vertical-align:middle;
1.795 www 5500: }
1.721 harmsja 5501:
1.1130 raeburn 5502: .LC_floatleft {
5503: float: left;
5504: }
5505:
5506: .LC_floatright {
5507: float: right;
5508: }
5509:
1.911 bisitz 5510: .LC_400Box {
5511: width:400px;
5512: }
1.721 harmsja 5513:
1.947 droeschl 5514: .LC_iframecontainer {
5515: width: 98%;
5516: margin: 0;
5517: position: fixed;
5518: top: 8.5em;
5519: bottom: 0;
5520: }
5521:
5522: .LC_iframecontainer iframe{
5523: border: none;
5524: width: 100%;
5525: height: 100%;
5526: }
5527:
1.778 bisitz 5528: .LC_filename {
5529: font-family: $mono;
5530: white-space:pre;
1.921 bisitz 5531: font-size: 120%;
1.778 bisitz 5532: }
5533:
5534: .LC_fileicon {
5535: border: none;
5536: height: 1.3em;
5537: vertical-align: text-bottom;
5538: margin-right: 0.3em;
5539: text-decoration:none;
5540: }
5541:
1.1008 www 5542: .LC_setting {
5543: text-decoration:underline;
5544: }
5545:
1.350 albertel 5546: .LC_error {
5547: color: red;
5548: }
1.795 www 5549:
1.1097 bisitz 5550: .LC_warning {
5551: color: darkorange;
5552: }
5553:
1.457 albertel 5554: .LC_diff_removed {
1.733 bisitz 5555: color: red;
1.394 albertel 5556: }
1.532 albertel 5557:
5558: .LC_info,
1.457 albertel 5559: .LC_success,
5560: .LC_diff_added {
1.350 albertel 5561: color: green;
5562: }
1.795 www 5563:
1.802 bisitz 5564: div.LC_confirm_box {
5565: background-color: #FAFAFA;
5566: border: 1px solid $lg_border_color;
5567: margin-right: 0;
5568: padding: 5px;
5569: }
5570:
5571: div.LC_confirm_box .LC_error img,
5572: div.LC_confirm_box .LC_success img {
5573: vertical-align: middle;
5574: }
5575:
1.440 albertel 5576: .LC_icon {
1.771 droeschl 5577: border: none;
1.790 droeschl 5578: vertical-align: middle;
1.771 droeschl 5579: }
5580:
1.543 albertel 5581: .LC_docs_spacer {
5582: width: 25px;
5583: height: 1px;
1.771 droeschl 5584: border: none;
1.543 albertel 5585: }
1.346 albertel 5586:
1.532 albertel 5587: .LC_internal_info {
1.735 bisitz 5588: color: #999999;
1.532 albertel 5589: }
5590:
1.794 www 5591: .LC_discussion {
1.1050 www 5592: background: $data_table_dark;
1.911 bisitz 5593: border: 1px solid black;
5594: margin: 2px;
1.794 www 5595: }
5596:
5597: .LC_disc_action_left {
1.1050 www 5598: background: $sidebg;
1.911 bisitz 5599: text-align: left;
1.1050 www 5600: padding: 4px;
5601: margin: 2px;
1.794 www 5602: }
5603:
5604: .LC_disc_action_right {
1.1050 www 5605: background: $sidebg;
1.911 bisitz 5606: text-align: right;
1.1050 www 5607: padding: 4px;
5608: margin: 2px;
1.794 www 5609: }
5610:
5611: .LC_disc_new_item {
1.911 bisitz 5612: background: white;
5613: border: 2px solid red;
1.1050 www 5614: margin: 4px;
5615: padding: 4px;
1.794 www 5616: }
5617:
5618: .LC_disc_old_item {
1.911 bisitz 5619: background: white;
1.1050 www 5620: margin: 4px;
5621: padding: 4px;
1.794 www 5622: }
5623:
1.458 albertel 5624: table.LC_pastsubmission {
5625: border: 1px solid black;
5626: margin: 2px;
5627: }
5628:
1.924 bisitz 5629: table#LC_menubuttons {
1.345 albertel 5630: width: 100%;
5631: background: $pgbg;
1.392 albertel 5632: border: 2px;
1.402 albertel 5633: border-collapse: separate;
1.803 bisitz 5634: padding: 0;
1.345 albertel 5635: }
1.392 albertel 5636:
1.801 tempelho 5637: table#LC_title_bar a {
5638: color: $fontmenu;
5639: }
1.836 bisitz 5640:
1.807 droeschl 5641: table#LC_title_bar {
1.819 tempelho 5642: clear: both;
1.836 bisitz 5643: display: none;
1.807 droeschl 5644: }
5645:
1.795 www 5646: table#LC_title_bar,
1.933 droeschl 5647: table.LC_breadcrumbs, /* obsolete? */
1.393 albertel 5648: table#LC_title_bar.LC_with_remote {
1.359 albertel 5649: width: 100%;
1.392 albertel 5650: border-color: $pgbg;
5651: border-style: solid;
5652: border-width: $border;
1.379 albertel 5653: background: $pgbg;
1.801 tempelho 5654: color: $fontmenu;
1.392 albertel 5655: border-collapse: collapse;
1.803 bisitz 5656: padding: 0;
1.819 tempelho 5657: margin: 0;
1.359 albertel 5658: }
1.795 www 5659:
1.933 droeschl 5660: ul.LC_breadcrumb_tools_outerlist {
1.913 droeschl 5661: margin: 0;
5662: padding: 0;
1.933 droeschl 5663: position: relative;
5664: list-style: none;
1.913 droeschl 5665: }
1.933 droeschl 5666: ul.LC_breadcrumb_tools_outerlist li {
1.913 droeschl 5667: display: inline;
5668: }
1.933 droeschl 5669:
5670: .LC_breadcrumb_tools_navigation {
1.913 droeschl 5671: padding: 0;
1.933 droeschl 5672: margin: 0;
5673: float: left;
1.913 droeschl 5674: }
1.933 droeschl 5675: .LC_breadcrumb_tools_tools {
5676: padding: 0;
5677: margin: 0;
1.913 droeschl 5678: float: right;
5679: }
5680:
1.359 albertel 5681: table#LC_title_bar td {
5682: background: $tabbg;
5683: }
1.795 www 5684:
1.911 bisitz 5685: table#LC_menubuttons img {
1.803 bisitz 5686: border: none;
1.346 albertel 5687: }
1.795 www 5688:
1.842 droeschl 5689: .LC_breadcrumbs_component {
1.911 bisitz 5690: float: right;
5691: margin: 0 1em;
1.357 albertel 5692: }
1.842 droeschl 5693: .LC_breadcrumbs_component img {
1.911 bisitz 5694: vertical-align: middle;
1.777 tempelho 5695: }
1.795 www 5696:
1.383 albertel 5697: td.LC_table_cell_checkbox {
5698: text-align: center;
5699: }
1.795 www 5700:
5701: .LC_fontsize_small {
1.911 bisitz 5702: font-size: 70%;
1.705 tempelho 5703: }
5704:
1.844 bisitz 5705: #LC_breadcrumbs {
1.911 bisitz 5706: clear:both;
5707: background: $sidebg;
5708: border-bottom: 1px solid $lg_border_color;
5709: line-height: 2.5em;
1.933 droeschl 5710: overflow: hidden;
1.911 bisitz 5711: margin: 0;
5712: padding: 0;
1.995 raeburn 5713: text-align: left;
1.819 tempelho 5714: }
1.862 bisitz 5715:
1.1098 bisitz 5716: .LC_head_subbox, .LC_actionbox {
1.911 bisitz 5717: clear:both;
5718: background: #F8F8F8; /* $sidebg; */
1.915 droeschl 5719: border: 1px solid $sidebg;
1.1098 bisitz 5720: margin: 0 0 10px 0;
1.966 bisitz 5721: padding: 3px;
1.995 raeburn 5722: text-align: left;
1.822 bisitz 5723: }
5724:
1.795 www 5725: .LC_fontsize_medium {
1.911 bisitz 5726: font-size: 85%;
1.705 tempelho 5727: }
5728:
1.795 www 5729: .LC_fontsize_large {
1.911 bisitz 5730: font-size: 120%;
1.705 tempelho 5731: }
5732:
1.346 albertel 5733: .LC_menubuttons_inline_text {
5734: color: $font;
1.698 harmsja 5735: font-size: 90%;
1.701 harmsja 5736: padding-left:3px;
1.346 albertel 5737: }
5738:
1.934 droeschl 5739: .LC_menubuttons_inline_text img{
5740: vertical-align: middle;
5741: }
5742:
1.1051 www 5743: li.LC_menubuttons_inline_text img {
1.951 onken 5744: cursor:pointer;
1.1002 droeschl 5745: text-decoration: none;
1.951 onken 5746: }
5747:
1.526 www 5748: .LC_menubuttons_link {
5749: text-decoration: none;
5750: }
1.795 www 5751:
1.522 albertel 5752: .LC_menubuttons_category {
1.521 www 5753: color: $font;
1.526 www 5754: background: $pgbg;
1.521 www 5755: font-size: larger;
5756: font-weight: bold;
5757: }
5758:
1.346 albertel 5759: td.LC_menubuttons_text {
1.911 bisitz 5760: color: $font;
1.346 albertel 5761: }
1.706 harmsja 5762:
1.346 albertel 5763: .LC_current_location {
5764: background: $tabbg;
5765: }
1.795 www 5766:
1.938 bisitz 5767: table.LC_data_table {
1.347 albertel 5768: border: 1px solid #000000;
1.402 albertel 5769: border-collapse: separate;
1.426 albertel 5770: border-spacing: 1px;
1.610 albertel 5771: background: $pgbg;
1.347 albertel 5772: }
1.795 www 5773:
1.422 albertel 5774: .LC_data_table_dense {
5775: font-size: small;
5776: }
1.795 www 5777:
1.507 raeburn 5778: table.LC_nested_outer {
5779: border: 1px solid #000000;
1.589 raeburn 5780: border-collapse: collapse;
1.803 bisitz 5781: border-spacing: 0;
1.507 raeburn 5782: width: 100%;
5783: }
1.795 www 5784:
1.879 raeburn 5785: table.LC_innerpickbox,
1.507 raeburn 5786: table.LC_nested {
1.803 bisitz 5787: border: none;
1.589 raeburn 5788: border-collapse: collapse;
1.803 bisitz 5789: border-spacing: 0;
1.507 raeburn 5790: width: 100%;
5791: }
1.795 www 5792:
1.911 bisitz 5793: table.LC_data_table tr th,
5794: table.LC_calendar tr th,
1.879 raeburn 5795: table.LC_prior_tries tr th,
5796: table.LC_innerpickbox tr th {
1.349 albertel 5797: font-weight: bold;
5798: background-color: $data_table_head;
1.801 tempelho 5799: color:$fontmenu;
1.701 harmsja 5800: font-size:90%;
1.347 albertel 5801: }
1.795 www 5802:
1.879 raeburn 5803: table.LC_innerpickbox tr th,
5804: table.LC_innerpickbox tr td {
5805: vertical-align: top;
5806: }
5807:
1.711 raeburn 5808: table.LC_data_table tr.LC_info_row > td {
1.735 bisitz 5809: background-color: #CCCCCC;
1.711 raeburn 5810: font-weight: bold;
5811: text-align: left;
5812: }
1.795 www 5813:
1.912 bisitz 5814: table.LC_data_table tr.LC_odd_row > td {
5815: background-color: $data_table_light;
5816: padding: 2px;
5817: vertical-align: top;
5818: }
5819:
1.809 bisitz 5820: table.LC_pick_box tr > td.LC_odd_row {
1.349 albertel 5821: background-color: $data_table_light;
1.912 bisitz 5822: vertical-align: top;
5823: }
5824:
5825: table.LC_data_table tr.LC_even_row > td {
5826: background-color: $data_table_dark;
1.425 albertel 5827: padding: 2px;
1.900 bisitz 5828: vertical-align: top;
1.347 albertel 5829: }
1.795 www 5830:
1.809 bisitz 5831: table.LC_pick_box tr > td.LC_even_row {
1.349 albertel 5832: background-color: $data_table_dark;
1.900 bisitz 5833: vertical-align: top;
1.347 albertel 5834: }
1.795 www 5835:
1.425 albertel 5836: table.LC_data_table tr.LC_data_table_highlight td {
5837: background-color: $data_table_darker;
5838: }
1.795 www 5839:
1.639 raeburn 5840: table.LC_data_table tr td.LC_leftcol_header {
5841: background-color: $data_table_head;
5842: font-weight: bold;
5843: }
1.795 www 5844:
1.451 albertel 5845: table.LC_data_table tr.LC_empty_row td,
1.507 raeburn 5846: table.LC_nested tr.LC_empty_row td {
1.421 albertel 5847: font-weight: bold;
5848: font-style: italic;
5849: text-align: center;
5850: padding: 8px;
1.347 albertel 5851: }
1.795 www 5852:
1.1114 raeburn 5853: table.LC_data_table tr.LC_empty_row td,
5854: table.LC_data_table tr.LC_footer_row td {
1.940 bisitz 5855: background-color: $sidebg;
5856: }
5857:
5858: table.LC_nested tr.LC_empty_row td {
5859: background-color: #FFFFFF;
5860: }
5861:
1.890 droeschl 5862: table.LC_caption {
5863: }
5864:
1.507 raeburn 5865: table.LC_nested tr.LC_empty_row td {
1.465 albertel 5866: padding: 4ex
5867: }
1.795 www 5868:
1.507 raeburn 5869: table.LC_nested_outer tr th {
5870: font-weight: bold;
1.801 tempelho 5871: color:$fontmenu;
1.507 raeburn 5872: background-color: $data_table_head;
1.701 harmsja 5873: font-size: small;
1.507 raeburn 5874: border-bottom: 1px solid #000000;
5875: }
1.795 www 5876:
1.507 raeburn 5877: table.LC_nested_outer tr td.LC_subheader {
5878: background-color: $data_table_head;
5879: font-weight: bold;
5880: font-size: small;
5881: border-bottom: 1px solid #000000;
5882: text-align: right;
1.451 albertel 5883: }
1.795 www 5884:
1.507 raeburn 5885: table.LC_nested tr.LC_info_row td {
1.735 bisitz 5886: background-color: #CCCCCC;
1.451 albertel 5887: font-weight: bold;
5888: font-size: small;
1.507 raeburn 5889: text-align: center;
5890: }
1.795 www 5891:
1.589 raeburn 5892: table.LC_nested tr.LC_info_row td.LC_left_item,
5893: table.LC_nested_outer tr th.LC_left_item {
1.507 raeburn 5894: text-align: left;
1.451 albertel 5895: }
1.795 www 5896:
1.507 raeburn 5897: table.LC_nested td {
1.735 bisitz 5898: background-color: #FFFFFF;
1.451 albertel 5899: font-size: small;
1.507 raeburn 5900: }
1.795 www 5901:
1.507 raeburn 5902: table.LC_nested_outer tr th.LC_right_item,
5903: table.LC_nested tr.LC_info_row td.LC_right_item,
5904: table.LC_nested tr.LC_odd_row td.LC_right_item,
5905: table.LC_nested tr td.LC_right_item {
1.451 albertel 5906: text-align: right;
5907: }
5908:
1.507 raeburn 5909: table.LC_nested tr.LC_odd_row td {
1.735 bisitz 5910: background-color: #EEEEEE;
1.451 albertel 5911: }
5912:
1.473 raeburn 5913: table.LC_createuser {
5914: }
5915:
5916: table.LC_createuser tr.LC_section_row td {
1.701 harmsja 5917: font-size: small;
1.473 raeburn 5918: }
5919:
5920: table.LC_createuser tr.LC_info_row td {
1.735 bisitz 5921: background-color: #CCCCCC;
1.473 raeburn 5922: font-weight: bold;
5923: text-align: center;
5924: }
5925:
1.349 albertel 5926: table.LC_calendar {
5927: border: 1px solid #000000;
5928: border-collapse: collapse;
1.917 raeburn 5929: width: 98%;
1.349 albertel 5930: }
1.795 www 5931:
1.349 albertel 5932: table.LC_calendar_pickdate {
5933: font-size: xx-small;
5934: }
1.795 www 5935:
1.349 albertel 5936: table.LC_calendar tr td {
5937: border: 1px solid #000000;
5938: vertical-align: top;
1.917 raeburn 5939: width: 14%;
1.349 albertel 5940: }
1.795 www 5941:
1.349 albertel 5942: table.LC_calendar tr td.LC_calendar_day_empty {
5943: background-color: $data_table_dark;
5944: }
1.795 www 5945:
1.779 bisitz 5946: table.LC_calendar tr td.LC_calendar_day_current {
5947: background-color: $data_table_highlight;
1.777 tempelho 5948: }
1.795 www 5949:
1.938 bisitz 5950: table.LC_data_table tr td.LC_mail_new {
1.349 albertel 5951: background-color: $mail_new;
5952: }
1.795 www 5953:
1.938 bisitz 5954: table.LC_data_table tr.LC_mail_new:hover {
1.349 albertel 5955: background-color: $mail_new_hover;
5956: }
1.795 www 5957:
1.938 bisitz 5958: table.LC_data_table tr td.LC_mail_read {
1.349 albertel 5959: background-color: $mail_read;
5960: }
1.795 www 5961:
1.938 bisitz 5962: /*
5963: table.LC_data_table tr.LC_mail_read:hover {
1.349 albertel 5964: background-color: $mail_read_hover;
5965: }
1.938 bisitz 5966: */
1.795 www 5967:
1.938 bisitz 5968: table.LC_data_table tr td.LC_mail_replied {
1.349 albertel 5969: background-color: $mail_replied;
5970: }
1.795 www 5971:
1.938 bisitz 5972: /*
5973: table.LC_data_table tr.LC_mail_replied:hover {
1.349 albertel 5974: background-color: $mail_replied_hover;
5975: }
1.938 bisitz 5976: */
1.795 www 5977:
1.938 bisitz 5978: table.LC_data_table tr td.LC_mail_other {
1.349 albertel 5979: background-color: $mail_other;
5980: }
1.795 www 5981:
1.938 bisitz 5982: /*
5983: table.LC_data_table tr.LC_mail_other:hover {
1.349 albertel 5984: background-color: $mail_other_hover;
5985: }
1.938 bisitz 5986: */
1.494 raeburn 5987:
1.777 tempelho 5988: table.LC_data_table tr > td.LC_browser_file,
5989: table.LC_data_table tr > td.LC_browser_file_published {
1.899 bisitz 5990: background: #AAEE77;
1.389 albertel 5991: }
1.795 www 5992:
1.777 tempelho 5993: table.LC_data_table tr > td.LC_browser_file_locked,
5994: table.LC_data_table tr > td.LC_browser_file_unpublished {
1.389 albertel 5995: background: #FFAA99;
1.387 albertel 5996: }
1.795 www 5997:
1.777 tempelho 5998: table.LC_data_table tr > td.LC_browser_file_obsolete {
1.899 bisitz 5999: background: #888888;
1.779 bisitz 6000: }
1.795 www 6001:
1.777 tempelho 6002: table.LC_data_table tr > td.LC_browser_file_modified,
1.779 bisitz 6003: table.LC_data_table tr > td.LC_browser_file_metamodified {
1.899 bisitz 6004: background: #F8F866;
1.777 tempelho 6005: }
1.795 www 6006:
1.696 bisitz 6007: table.LC_data_table tr.LC_browser_folder > td {
1.899 bisitz 6008: background: #E0E8FF;
1.387 albertel 6009: }
1.696 bisitz 6010:
1.707 bisitz 6011: table.LC_data_table tr > td.LC_roles_is {
1.911 bisitz 6012: /* background: #77FF77; */
1.707 bisitz 6013: }
1.795 www 6014:
1.707 bisitz 6015: table.LC_data_table tr > td.LC_roles_future {
1.939 bisitz 6016: border-right: 8px solid #FFFF77;
1.707 bisitz 6017: }
1.795 www 6018:
1.707 bisitz 6019: table.LC_data_table tr > td.LC_roles_will {
1.939 bisitz 6020: border-right: 8px solid #FFAA77;
1.707 bisitz 6021: }
1.795 www 6022:
1.707 bisitz 6023: table.LC_data_table tr > td.LC_roles_expired {
1.939 bisitz 6024: border-right: 8px solid #FF7777;
1.707 bisitz 6025: }
1.795 www 6026:
1.707 bisitz 6027: table.LC_data_table tr > td.LC_roles_will_not {
1.939 bisitz 6028: border-right: 8px solid #AAFF77;
1.707 bisitz 6029: }
1.795 www 6030:
1.707 bisitz 6031: table.LC_data_table tr > td.LC_roles_selected {
1.939 bisitz 6032: border-right: 8px solid #11CC55;
1.707 bisitz 6033: }
6034:
1.388 albertel 6035: span.LC_current_location {
1.701 harmsja 6036: font-size:larger;
1.388 albertel 6037: background: $pgbg;
6038: }
1.387 albertel 6039:
1.1029 www 6040: span.LC_current_nav_location {
6041: font-weight:bold;
6042: background: $sidebg;
6043: }
6044:
1.395 albertel 6045: span.LC_parm_menu_item {
6046: font-size: larger;
6047: }
1.795 www 6048:
1.395 albertel 6049: span.LC_parm_scope_all {
6050: color: red;
6051: }
1.795 www 6052:
1.395 albertel 6053: span.LC_parm_scope_folder {
6054: color: green;
6055: }
1.795 www 6056:
1.395 albertel 6057: span.LC_parm_scope_resource {
6058: color: orange;
6059: }
1.795 www 6060:
1.395 albertel 6061: span.LC_parm_part {
6062: color: blue;
6063: }
1.795 www 6064:
1.911 bisitz 6065: span.LC_parm_folder,
6066: span.LC_parm_symb {
1.395 albertel 6067: font-size: x-small;
6068: font-family: $mono;
6069: color: #AAAAAA;
6070: }
6071:
1.977 bisitz 6072: ul.LC_parm_parmlist li {
6073: display: inline-block;
6074: padding: 0.3em 0.8em;
6075: vertical-align: top;
6076: width: 150px;
6077: border-top:1px solid $lg_border_color;
6078: }
6079:
1.795 www 6080: td.LC_parm_overview_level_menu,
6081: td.LC_parm_overview_map_menu,
6082: td.LC_parm_overview_parm_selectors,
6083: td.LC_parm_overview_restrictions {
1.396 albertel 6084: border: 1px solid black;
6085: border-collapse: collapse;
6086: }
1.795 www 6087:
1.396 albertel 6088: table.LC_parm_overview_restrictions td {
6089: border-width: 1px 4px 1px 4px;
6090: border-style: solid;
6091: border-color: $pgbg;
6092: text-align: center;
6093: }
1.795 www 6094:
1.396 albertel 6095: table.LC_parm_overview_restrictions th {
6096: background: $tabbg;
6097: border-width: 1px 4px 1px 4px;
6098: border-style: solid;
6099: border-color: $pgbg;
6100: }
1.795 www 6101:
1.398 albertel 6102: table#LC_helpmenu {
1.803 bisitz 6103: border: none;
1.398 albertel 6104: height: 55px;
1.803 bisitz 6105: border-spacing: 0;
1.398 albertel 6106: }
6107:
6108: table#LC_helpmenu fieldset legend {
6109: font-size: larger;
6110: }
1.795 www 6111:
1.397 albertel 6112: table#LC_helpmenu_links {
6113: width: 100%;
6114: border: 1px solid black;
6115: background: $pgbg;
1.803 bisitz 6116: padding: 0;
1.397 albertel 6117: border-spacing: 1px;
6118: }
1.795 www 6119:
1.397 albertel 6120: table#LC_helpmenu_links tr td {
6121: padding: 1px;
6122: background: $tabbg;
1.399 albertel 6123: text-align: center;
6124: font-weight: bold;
1.397 albertel 6125: }
1.396 albertel 6126:
1.795 www 6127: table#LC_helpmenu_links a:link,
6128: table#LC_helpmenu_links a:visited,
1.397 albertel 6129: table#LC_helpmenu_links a:active {
6130: text-decoration: none;
6131: color: $font;
6132: }
1.795 www 6133:
1.397 albertel 6134: table#LC_helpmenu_links a:hover {
6135: text-decoration: underline;
6136: color: $vlink;
6137: }
1.396 albertel 6138:
1.417 albertel 6139: .LC_chrt_popup_exists {
6140: border: 1px solid #339933;
6141: margin: -1px;
6142: }
1.795 www 6143:
1.417 albertel 6144: .LC_chrt_popup_up {
6145: border: 1px solid yellow;
6146: margin: -1px;
6147: }
1.795 www 6148:
1.417 albertel 6149: .LC_chrt_popup {
6150: border: 1px solid #8888FF;
6151: background: #CCCCFF;
6152: }
1.795 www 6153:
1.421 albertel 6154: table.LC_pick_box {
6155: border-collapse: separate;
6156: background: white;
6157: border: 1px solid black;
6158: border-spacing: 1px;
6159: }
1.795 www 6160:
1.421 albertel 6161: table.LC_pick_box td.LC_pick_box_title {
1.850 bisitz 6162: background: $sidebg;
1.421 albertel 6163: font-weight: bold;
1.900 bisitz 6164: text-align: left;
1.740 bisitz 6165: vertical-align: top;
1.421 albertel 6166: width: 184px;
6167: padding: 8px;
6168: }
1.795 www 6169:
1.579 raeburn 6170: table.LC_pick_box td.LC_pick_box_value {
6171: text-align: left;
6172: padding: 8px;
6173: }
1.795 www 6174:
1.579 raeburn 6175: table.LC_pick_box td.LC_pick_box_select {
6176: text-align: left;
6177: padding: 8px;
6178: }
1.795 www 6179:
1.424 albertel 6180: table.LC_pick_box td.LC_pick_box_separator {
1.803 bisitz 6181: padding: 0;
1.421 albertel 6182: height: 1px;
6183: background: black;
6184: }
1.795 www 6185:
1.421 albertel 6186: table.LC_pick_box td.LC_pick_box_submit {
6187: text-align: right;
6188: }
1.795 www 6189:
1.579 raeburn 6190: table.LC_pick_box td.LC_evenrow_value {
6191: text-align: left;
6192: padding: 8px;
6193: background-color: $data_table_light;
6194: }
1.795 www 6195:
1.579 raeburn 6196: table.LC_pick_box td.LC_oddrow_value {
6197: text-align: left;
6198: padding: 8px;
6199: background-color: $data_table_light;
6200: }
1.795 www 6201:
1.579 raeburn 6202: span.LC_helpform_receipt_cat {
6203: font-weight: bold;
6204: }
1.795 www 6205:
1.424 albertel 6206: table.LC_group_priv_box {
6207: background: white;
6208: border: 1px solid black;
6209: border-spacing: 1px;
6210: }
1.795 www 6211:
1.424 albertel 6212: table.LC_group_priv_box td.LC_pick_box_title {
6213: background: $tabbg;
6214: font-weight: bold;
6215: text-align: right;
6216: width: 184px;
6217: }
1.795 www 6218:
1.424 albertel 6219: table.LC_group_priv_box td.LC_groups_fixed {
6220: background: $data_table_light;
6221: text-align: center;
6222: }
1.795 www 6223:
1.424 albertel 6224: table.LC_group_priv_box td.LC_groups_optional {
6225: background: $data_table_dark;
6226: text-align: center;
6227: }
1.795 www 6228:
1.424 albertel 6229: table.LC_group_priv_box td.LC_groups_functionality {
6230: background: $data_table_darker;
6231: text-align: center;
6232: font-weight: bold;
6233: }
1.795 www 6234:
1.424 albertel 6235: table.LC_group_priv td {
6236: text-align: left;
1.803 bisitz 6237: padding: 0;
1.424 albertel 6238: }
6239:
6240: .LC_navbuttons {
6241: margin: 2ex 0ex 2ex 0ex;
6242: }
1.795 www 6243:
1.423 albertel 6244: .LC_topic_bar {
6245: font-weight: bold;
6246: background: $tabbg;
1.918 wenzelju 6247: margin: 1em 0em 1em 2em;
1.805 bisitz 6248: padding: 3px;
1.918 wenzelju 6249: font-size: 1.2em;
1.423 albertel 6250: }
1.795 www 6251:
1.423 albertel 6252: .LC_topic_bar span {
1.918 wenzelju 6253: left: 0.5em;
6254: position: absolute;
1.423 albertel 6255: vertical-align: middle;
1.918 wenzelju 6256: font-size: 1.2em;
1.423 albertel 6257: }
1.795 www 6258:
1.423 albertel 6259: table.LC_course_group_status {
6260: margin: 20px;
6261: }
1.795 www 6262:
1.423 albertel 6263: table.LC_status_selector td {
6264: vertical-align: top;
6265: text-align: center;
1.424 albertel 6266: padding: 4px;
6267: }
1.795 www 6268:
1.599 albertel 6269: div.LC_feedback_link {
1.616 albertel 6270: clear: both;
1.829 kalberla 6271: background: $sidebg;
1.779 bisitz 6272: width: 100%;
1.829 kalberla 6273: padding-bottom: 10px;
6274: border: 1px $tabbg solid;
1.833 kalberla 6275: height: 22px;
6276: line-height: 22px;
6277: padding-top: 5px;
6278: }
6279:
6280: div.LC_feedback_link img {
6281: height: 22px;
1.867 kalberla 6282: vertical-align:middle;
1.829 kalberla 6283: }
6284:
1.911 bisitz 6285: div.LC_feedback_link a {
1.829 kalberla 6286: text-decoration: none;
1.489 raeburn 6287: }
1.795 www 6288:
1.867 kalberla 6289: div.LC_comblock {
1.911 bisitz 6290: display:inline;
1.867 kalberla 6291: color:$font;
6292: font-size:90%;
6293: }
6294:
6295: div.LC_feedback_link div.LC_comblock {
6296: padding-left:5px;
6297: }
6298:
6299: div.LC_feedback_link div.LC_comblock a {
6300: color:$font;
6301: }
6302:
1.489 raeburn 6303: span.LC_feedback_link {
1.858 bisitz 6304: /* background: $feedback_link_bg; */
1.599 albertel 6305: font-size: larger;
6306: }
1.795 www 6307:
1.599 albertel 6308: span.LC_message_link {
1.858 bisitz 6309: /* background: $feedback_link_bg; */
1.599 albertel 6310: font-size: larger;
6311: position: absolute;
6312: right: 1em;
1.489 raeburn 6313: }
1.421 albertel 6314:
1.515 albertel 6315: table.LC_prior_tries {
1.524 albertel 6316: border: 1px solid #000000;
6317: border-collapse: separate;
6318: border-spacing: 1px;
1.515 albertel 6319: }
1.523 albertel 6320:
1.515 albertel 6321: table.LC_prior_tries td {
1.524 albertel 6322: padding: 2px;
1.515 albertel 6323: }
1.523 albertel 6324:
6325: .LC_answer_correct {
1.795 www 6326: background: lightgreen;
6327: color: darkgreen;
6328: padding: 6px;
1.523 albertel 6329: }
1.795 www 6330:
1.523 albertel 6331: .LC_answer_charged_try {
1.797 www 6332: background: #FFAAAA;
1.795 www 6333: color: darkred;
6334: padding: 6px;
1.523 albertel 6335: }
1.795 www 6336:
1.779 bisitz 6337: .LC_answer_not_charged_try,
1.523 albertel 6338: .LC_answer_no_grade,
6339: .LC_answer_late {
1.795 www 6340: background: lightyellow;
1.523 albertel 6341: color: black;
1.795 www 6342: padding: 6px;
1.523 albertel 6343: }
1.795 www 6344:
1.523 albertel 6345: .LC_answer_previous {
1.795 www 6346: background: lightblue;
6347: color: darkblue;
6348: padding: 6px;
1.523 albertel 6349: }
1.795 www 6350:
1.779 bisitz 6351: .LC_answer_no_message {
1.777 tempelho 6352: background: #FFFFFF;
6353: color: black;
1.795 www 6354: padding: 6px;
1.779 bisitz 6355: }
1.795 www 6356:
1.779 bisitz 6357: .LC_answer_unknown {
6358: background: orange;
6359: color: black;
1.795 www 6360: padding: 6px;
1.777 tempelho 6361: }
1.795 www 6362:
1.529 albertel 6363: span.LC_prior_numerical,
6364: span.LC_prior_string,
6365: span.LC_prior_custom,
6366: span.LC_prior_reaction,
6367: span.LC_prior_math {
1.925 bisitz 6368: font-family: $mono;
1.523 albertel 6369: white-space: pre;
6370: }
6371:
1.525 albertel 6372: span.LC_prior_string {
1.925 bisitz 6373: font-family: $mono;
1.525 albertel 6374: white-space: pre;
6375: }
6376:
1.523 albertel 6377: table.LC_prior_option {
6378: width: 100%;
6379: border-collapse: collapse;
6380: }
1.795 www 6381:
1.911 bisitz 6382: table.LC_prior_rank,
1.795 www 6383: table.LC_prior_match {
1.528 albertel 6384: border-collapse: collapse;
6385: }
1.795 www 6386:
1.528 albertel 6387: table.LC_prior_option tr td,
6388: table.LC_prior_rank tr td,
6389: table.LC_prior_match tr td {
1.524 albertel 6390: border: 1px solid #000000;
1.515 albertel 6391: }
6392:
1.855 bisitz 6393: .LC_nobreak {
1.544 albertel 6394: white-space: nowrap;
1.519 raeburn 6395: }
6396:
1.576 raeburn 6397: span.LC_cusr_emph {
6398: font-style: italic;
6399: }
6400:
1.633 raeburn 6401: span.LC_cusr_subheading {
6402: font-weight: normal;
6403: font-size: 85%;
6404: }
6405:
1.861 bisitz 6406: div.LC_docs_entry_move {
1.859 bisitz 6407: border: 1px solid #BBBBBB;
1.545 albertel 6408: background: #DDDDDD;
1.861 bisitz 6409: width: 22px;
1.859 bisitz 6410: padding: 1px;
6411: margin: 0;
1.545 albertel 6412: }
6413:
1.861 bisitz 6414: table.LC_data_table tr > td.LC_docs_entry_commands,
6415: table.LC_data_table tr > td.LC_docs_entry_parameter {
1.545 albertel 6416: font-size: x-small;
6417: }
1.795 www 6418:
1.861 bisitz 6419: .LC_docs_entry_parameter {
6420: white-space: nowrap;
6421: }
6422:
1.544 albertel 6423: .LC_docs_copy {
1.545 albertel 6424: color: #000099;
1.544 albertel 6425: }
1.795 www 6426:
1.544 albertel 6427: .LC_docs_cut {
1.545 albertel 6428: color: #550044;
1.544 albertel 6429: }
1.795 www 6430:
1.544 albertel 6431: .LC_docs_rename {
1.545 albertel 6432: color: #009900;
1.544 albertel 6433: }
1.795 www 6434:
1.544 albertel 6435: .LC_docs_remove {
1.545 albertel 6436: color: #990000;
6437: }
6438:
1.547 albertel 6439: .LC_docs_reinit_warn,
6440: .LC_docs_ext_edit {
6441: font-size: x-small;
6442: }
6443:
1.545 albertel 6444: table.LC_docs_adddocs td,
6445: table.LC_docs_adddocs th {
6446: border: 1px solid #BBBBBB;
6447: padding: 4px;
6448: background: #DDDDDD;
1.543 albertel 6449: }
6450:
1.584 albertel 6451: table.LC_sty_begin {
6452: background: #BBFFBB;
6453: }
1.795 www 6454:
1.584 albertel 6455: table.LC_sty_end {
6456: background: #FFBBBB;
6457: }
6458:
1.589 raeburn 6459: table.LC_double_column {
1.803 bisitz 6460: border-width: 0;
1.589 raeburn 6461: border-collapse: collapse;
6462: width: 100%;
6463: padding: 2px;
6464: }
6465:
6466: table.LC_double_column tr td.LC_left_col {
1.590 raeburn 6467: top: 2px;
1.589 raeburn 6468: left: 2px;
6469: width: 47%;
6470: vertical-align: top;
6471: }
6472:
6473: table.LC_double_column tr td.LC_right_col {
6474: top: 2px;
1.779 bisitz 6475: right: 2px;
1.589 raeburn 6476: width: 47%;
6477: vertical-align: top;
6478: }
6479:
1.591 raeburn 6480: div.LC_left_float {
6481: float: left;
6482: padding-right: 5%;
1.597 albertel 6483: padding-bottom: 4px;
1.591 raeburn 6484: }
6485:
6486: div.LC_clear_float_header {
1.597 albertel 6487: padding-bottom: 2px;
1.591 raeburn 6488: }
6489:
6490: div.LC_clear_float_footer {
1.597 albertel 6491: padding-top: 10px;
1.591 raeburn 6492: clear: both;
6493: }
6494:
1.597 albertel 6495: div.LC_grade_show_user {
1.941 bisitz 6496: /* border-left: 5px solid $sidebg; */
6497: border-top: 5px solid #000000;
6498: margin: 50px 0 0 0;
1.936 bisitz 6499: padding: 15px 0 5px 10px;
1.597 albertel 6500: }
1.795 www 6501:
1.936 bisitz 6502: div.LC_grade_show_user_odd_row {
1.941 bisitz 6503: /* border-left: 5px solid #000000; */
6504: }
6505:
6506: div.LC_grade_show_user div.LC_Box {
6507: margin-right: 50px;
1.597 albertel 6508: }
6509:
6510: div.LC_grade_submissions,
6511: div.LC_grade_message_center,
1.936 bisitz 6512: div.LC_grade_info_links {
1.597 albertel 6513: margin: 5px;
6514: width: 99%;
6515: background: #FFFFFF;
6516: }
1.795 www 6517:
1.597 albertel 6518: div.LC_grade_submissions_header,
1.936 bisitz 6519: div.LC_grade_message_center_header {
1.705 tempelho 6520: font-weight: bold;
6521: font-size: large;
1.597 albertel 6522: }
1.795 www 6523:
1.597 albertel 6524: div.LC_grade_submissions_body,
1.936 bisitz 6525: div.LC_grade_message_center_body {
1.597 albertel 6526: border: 1px solid black;
6527: width: 99%;
6528: background: #FFFFFF;
6529: }
1.795 www 6530:
1.613 albertel 6531: table.LC_scantron_action {
6532: width: 100%;
6533: }
1.795 www 6534:
1.613 albertel 6535: table.LC_scantron_action tr th {
1.698 harmsja 6536: font-weight:bold;
6537: font-style:normal;
1.613 albertel 6538: }
1.795 www 6539:
1.779 bisitz 6540: .LC_edit_problem_header,
1.614 albertel 6541: div.LC_edit_problem_footer {
1.705 tempelho 6542: font-weight: normal;
6543: font-size: medium;
1.602 albertel 6544: margin: 2px;
1.1060 bisitz 6545: background-color: $sidebg;
1.600 albertel 6546: }
1.795 www 6547:
1.600 albertel 6548: div.LC_edit_problem_header,
1.602 albertel 6549: div.LC_edit_problem_header div,
1.614 albertel 6550: div.LC_edit_problem_footer,
6551: div.LC_edit_problem_footer div,
1.602 albertel 6552: div.LC_edit_problem_editxml_header,
6553: div.LC_edit_problem_editxml_header div {
1.600 albertel 6554: margin-top: 5px;
6555: }
1.795 www 6556:
1.600 albertel 6557: div.LC_edit_problem_header_title {
1.705 tempelho 6558: font-weight: bold;
6559: font-size: larger;
1.602 albertel 6560: background: $tabbg;
6561: padding: 3px;
1.1060 bisitz 6562: margin: 0 0 5px 0;
1.602 albertel 6563: }
1.795 www 6564:
1.602 albertel 6565: table.LC_edit_problem_header_title {
6566: width: 100%;
1.600 albertel 6567: background: $tabbg;
1.602 albertel 6568: }
6569:
6570: div.LC_edit_problem_discards {
6571: float: left;
6572: padding-bottom: 5px;
6573: }
1.795 www 6574:
1.602 albertel 6575: div.LC_edit_problem_saves {
6576: float: right;
6577: padding-bottom: 5px;
1.600 albertel 6578: }
1.795 www 6579:
1.1124 bisitz 6580: .LC_edit_opt {
6581: padding-left: 1em;
6582: white-space: nowrap;
6583: }
6584:
1.1152 golterma 6585: .LC_edit_problem_latexhelper{
6586: text-align: right;
6587: }
6588:
6589: #LC_edit_problem_colorful div{
6590: margin-left: 40px;
6591: }
6592:
1.911 bisitz 6593: img.stift {
1.803 bisitz 6594: border-width: 0;
6595: vertical-align: middle;
1.677 riegler 6596: }
1.680 riegler 6597:
1.923 bisitz 6598: table td.LC_mainmenu_col_fieldset {
1.680 riegler 6599: vertical-align: top;
1.777 tempelho 6600: }
1.795 www 6601:
1.716 raeburn 6602: div.LC_createcourse {
1.911 bisitz 6603: margin: 10px 10px 10px 10px;
1.716 raeburn 6604: }
6605:
1.917 raeburn 6606: .LC_dccid {
1.1130 raeburn 6607: float: right;
1.917 raeburn 6608: margin: 0.2em 0 0 0;
6609: padding: 0;
6610: font-size: 90%;
6611: display:none;
6612: }
6613:
1.897 wenzelju 6614: ol.LC_primary_menu a:hover,
1.721 harmsja 6615: ol#LC_MenuBreadcrumbs a:hover,
6616: ol#LC_PathBreadcrumbs a:hover,
1.897 wenzelju 6617: ul#LC_secondary_menu a:hover,
1.721 harmsja 6618: .LC_FormSectionClearButton input:hover
1.795 www 6619: ul.LC_TabContent li:hover a {
1.952 onken 6620: color:$button_hover;
1.911 bisitz 6621: text-decoration:none;
1.693 droeschl 6622: }
6623:
1.779 bisitz 6624: h1 {
1.911 bisitz 6625: padding: 0;
6626: line-height:130%;
1.693 droeschl 6627: }
1.698 harmsja 6628:
1.911 bisitz 6629: h2,
6630: h3,
6631: h4,
6632: h5,
6633: h6 {
6634: margin: 5px 0 5px 0;
6635: padding: 0;
6636: line-height:130%;
1.693 droeschl 6637: }
1.795 www 6638:
6639: .LC_hcell {
1.911 bisitz 6640: padding:3px 15px 3px 15px;
6641: margin: 0;
6642: background-color:$tabbg;
6643: color:$fontmenu;
6644: border-bottom:solid 1px $lg_border_color;
1.693 droeschl 6645: }
1.795 www 6646:
1.840 bisitz 6647: .LC_Box > .LC_hcell {
1.911 bisitz 6648: margin: 0 -10px 10px -10px;
1.835 bisitz 6649: }
6650:
1.721 harmsja 6651: .LC_noBorder {
1.911 bisitz 6652: border: 0;
1.698 harmsja 6653: }
1.693 droeschl 6654:
1.721 harmsja 6655: .LC_FormSectionClearButton input {
1.911 bisitz 6656: background-color:transparent;
6657: border: none;
6658: cursor:pointer;
6659: text-decoration:underline;
1.693 droeschl 6660: }
1.763 bisitz 6661:
6662: .LC_help_open_topic {
1.911 bisitz 6663: color: #FFFFFF;
6664: background-color: #EEEEFF;
6665: margin: 1px;
6666: padding: 4px;
6667: border: 1px solid #000033;
6668: white-space: nowrap;
6669: /* vertical-align: middle; */
1.759 neumanie 6670: }
1.693 droeschl 6671:
1.911 bisitz 6672: dl,
6673: ul,
6674: div,
6675: fieldset {
6676: margin: 10px 10px 10px 0;
6677: /* overflow: hidden; */
1.693 droeschl 6678: }
1.795 www 6679:
1.838 bisitz 6680: fieldset > legend {
1.911 bisitz 6681: font-weight: bold;
6682: padding: 0 5px 0 5px;
1.838 bisitz 6683: }
6684:
1.813 bisitz 6685: #LC_nav_bar {
1.911 bisitz 6686: float: left;
1.995 raeburn 6687: background-color: $pgbg_or_bgcolor;
1.966 bisitz 6688: margin: 0 0 2px 0;
1.807 droeschl 6689: }
6690:
1.916 droeschl 6691: #LC_realm {
6692: margin: 0.2em 0 0 0;
6693: padding: 0;
6694: font-weight: bold;
6695: text-align: center;
1.995 raeburn 6696: background-color: $pgbg_or_bgcolor;
1.916 droeschl 6697: }
6698:
1.911 bisitz 6699: #LC_nav_bar em {
6700: font-weight: bold;
6701: font-style: normal;
1.807 droeschl 6702: }
6703:
1.897 wenzelju 6704: ol.LC_primary_menu {
1.934 droeschl 6705: margin: 0;
1.1076 raeburn 6706: padding: 0;
1.995 raeburn 6707: background-color: $pgbg_or_bgcolor;
1.807 droeschl 6708: }
6709:
1.852 droeschl 6710: ol#LC_PathBreadcrumbs {
1.911 bisitz 6711: margin: 0;
1.693 droeschl 6712: }
6713:
1.897 wenzelju 6714: ol.LC_primary_menu li {
1.1076 raeburn 6715: color: RGB(80, 80, 80);
6716: vertical-align: middle;
6717: text-align: left;
6718: list-style: none;
6719: float: left;
6720: }
6721:
6722: ol.LC_primary_menu li a {
6723: display: block;
6724: margin: 0;
6725: padding: 0 5px 0 10px;
6726: text-decoration: none;
6727: }
6728:
6729: ol.LC_primary_menu li ul {
6730: display: none;
6731: width: 10em;
6732: background-color: $data_table_light;
6733: }
6734:
6735: ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
6736: display: block;
6737: position: absolute;
6738: margin: 0;
6739: padding: 0;
1.1078 raeburn 6740: z-index: 2;
1.1076 raeburn 6741: }
6742:
6743: ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
6744: font-size: 90%;
1.911 bisitz 6745: vertical-align: top;
1.1076 raeburn 6746: float: none;
1.1079 raeburn 6747: border-left: 1px solid black;
6748: border-right: 1px solid black;
1.1076 raeburn 6749: }
6750:
6751: ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
1.1078 raeburn 6752: background-color:$data_table_light;
1.1076 raeburn 6753: }
6754:
6755: ol.LC_primary_menu li li a:hover {
6756: color:$button_hover;
6757: background-color:$data_table_dark;
1.693 droeschl 6758: }
6759:
1.897 wenzelju 6760: ol.LC_primary_menu li img {
1.911 bisitz 6761: vertical-align: bottom;
1.934 droeschl 6762: height: 1.1em;
1.1077 raeburn 6763: margin: 0.2em 0 0 0;
1.693 droeschl 6764: }
6765:
1.897 wenzelju 6766: ol.LC_primary_menu a {
1.911 bisitz 6767: color: RGB(80, 80, 80);
6768: text-decoration: none;
1.693 droeschl 6769: }
1.795 www 6770:
1.949 droeschl 6771: ol.LC_primary_menu a.LC_new_message {
6772: font-weight:bold;
6773: color: darkred;
6774: }
6775:
1.975 raeburn 6776: ol.LC_docs_parameters {
6777: margin-left: 0;
6778: padding: 0;
6779: list-style: none;
6780: }
6781:
6782: ol.LC_docs_parameters li {
6783: margin: 0;
6784: padding-right: 20px;
6785: display: inline;
6786: }
6787:
1.976 raeburn 6788: ol.LC_docs_parameters li:before {
6789: content: "\\002022 \\0020";
6790: }
6791:
6792: li.LC_docs_parameters_title {
6793: font-weight: bold;
6794: }
6795:
6796: ol.LC_docs_parameters li.LC_docs_parameters_title:before {
6797: content: "";
6798: }
6799:
1.897 wenzelju 6800: ul#LC_secondary_menu {
1.1107 raeburn 6801: clear: right;
1.911 bisitz 6802: color: $fontmenu;
6803: background: $tabbg;
6804: list-style: none;
6805: padding: 0;
6806: margin: 0;
6807: width: 100%;
1.995 raeburn 6808: text-align: left;
1.1107 raeburn 6809: float: left;
1.808 droeschl 6810: }
6811:
1.897 wenzelju 6812: ul#LC_secondary_menu li {
1.911 bisitz 6813: font-weight: bold;
6814: line-height: 1.8em;
1.1107 raeburn 6815: border-right: 1px solid black;
6816: float: left;
6817: }
6818:
6819: ul#LC_secondary_menu li.LC_hoverable:hover, ul#LC_secondary_menu li.hover {
6820: background-color: $data_table_light;
6821: }
6822:
6823: ul#LC_secondary_menu li a {
1.911 bisitz 6824: padding: 0 0.8em;
1.1107 raeburn 6825: }
6826:
6827: ul#LC_secondary_menu li ul {
6828: display: none;
6829: }
6830:
6831: ul#LC_secondary_menu li:hover ul, ul#LC_secondary_menu li.hover ul {
6832: display: block;
6833: position: absolute;
6834: margin: 0;
6835: padding: 0;
6836: list-style:none;
6837: float: none;
6838: background-color: $data_table_light;
6839: z-index: 2;
6840: margin-left: -1px;
6841: }
6842:
6843: ul#LC_secondary_menu li ul li {
6844: font-size: 90%;
6845: vertical-align: top;
6846: border-left: 1px solid black;
1.911 bisitz 6847: border-right: 1px solid black;
1.1119 raeburn 6848: background-color: $data_table_light;
1.1107 raeburn 6849: list-style:none;
6850: float: none;
6851: }
6852:
6853: ul#LC_secondary_menu li ul li:hover, ul#LC_secondary_menu li ul li.hover {
6854: background-color: $data_table_dark;
1.807 droeschl 6855: }
6856:
1.847 tempelho 6857: ul.LC_TabContent {
1.911 bisitz 6858: display:block;
6859: background: $sidebg;
6860: border-bottom: solid 1px $lg_border_color;
6861: list-style:none;
1.1020 raeburn 6862: margin: -1px -10px 0 -10px;
1.911 bisitz 6863: padding: 0;
1.693 droeschl 6864: }
6865:
1.795 www 6866: ul.LC_TabContent li,
6867: ul.LC_TabContentBigger li {
1.911 bisitz 6868: float:left;
1.741 harmsja 6869: }
1.795 www 6870:
1.897 wenzelju 6871: ul#LC_secondary_menu li a {
1.911 bisitz 6872: color: $fontmenu;
6873: text-decoration: none;
1.693 droeschl 6874: }
1.795 www 6875:
1.721 harmsja 6876: ul.LC_TabContent {
1.952 onken 6877: min-height:20px;
1.721 harmsja 6878: }
1.795 www 6879:
6880: ul.LC_TabContent li {
1.911 bisitz 6881: vertical-align:middle;
1.959 onken 6882: padding: 0 16px 0 10px;
1.911 bisitz 6883: background-color:$tabbg;
6884: border-bottom:solid 1px $lg_border_color;
1.1020 raeburn 6885: border-left: solid 1px $font;
1.721 harmsja 6886: }
1.795 www 6887:
1.847 tempelho 6888: ul.LC_TabContent .right {
1.911 bisitz 6889: float:right;
1.847 tempelho 6890: }
6891:
1.911 bisitz 6892: ul.LC_TabContent li a,
6893: ul.LC_TabContent li {
6894: color:rgb(47,47,47);
6895: text-decoration:none;
6896: font-size:95%;
6897: font-weight:bold;
1.952 onken 6898: min-height:20px;
6899: }
6900:
1.959 onken 6901: ul.LC_TabContent li a:hover,
6902: ul.LC_TabContent li a:focus {
1.952 onken 6903: color: $button_hover;
1.959 onken 6904: background:none;
6905: outline:none;
1.952 onken 6906: }
6907:
6908: ul.LC_TabContent li:hover {
6909: color: $button_hover;
6910: cursor:pointer;
1.721 harmsja 6911: }
1.795 www 6912:
1.911 bisitz 6913: ul.LC_TabContent li.active {
1.952 onken 6914: color: $font;
1.911 bisitz 6915: background:#FFFFFF url(/adm/lonIcons/open.gif) no-repeat scroll right center;
1.952 onken 6916: border-bottom:solid 1px #FFFFFF;
6917: cursor: default;
1.744 ehlerst 6918: }
1.795 www 6919:
1.959 onken 6920: ul.LC_TabContent li.active a {
6921: color:$font;
6922: background:#FFFFFF;
6923: outline: none;
6924: }
1.1047 raeburn 6925:
6926: ul.LC_TabContent li.goback {
6927: float: left;
6928: border-left: none;
6929: }
6930:
1.870 tempelho 6931: #maincoursedoc {
1.911 bisitz 6932: clear:both;
1.870 tempelho 6933: }
6934:
6935: ul.LC_TabContentBigger {
1.911 bisitz 6936: display:block;
6937: list-style:none;
6938: padding: 0;
1.870 tempelho 6939: }
6940:
1.795 www 6941: ul.LC_TabContentBigger li {
1.911 bisitz 6942: vertical-align:bottom;
6943: height: 30px;
6944: font-size:110%;
6945: font-weight:bold;
6946: color: #737373;
1.841 tempelho 6947: }
6948:
1.957 onken 6949: ul.LC_TabContentBigger li.active {
6950: position: relative;
6951: top: 1px;
6952: }
6953:
1.870 tempelho 6954: ul.LC_TabContentBigger li a {
1.911 bisitz 6955: background:url('/adm/lonIcons/tabbgleft.gif') left bottom no-repeat;
6956: height: 30px;
6957: line-height: 30px;
6958: text-align: center;
6959: display: block;
6960: text-decoration: none;
1.958 onken 6961: outline: none;
1.741 harmsja 6962: }
1.795 www 6963:
1.870 tempelho 6964: ul.LC_TabContentBigger li.active a {
1.911 bisitz 6965: background:url('/adm/lonIcons/tabbgleft.gif') left top no-repeat;
6966: color:$font;
1.744 ehlerst 6967: }
1.795 www 6968:
1.870 tempelho 6969: ul.LC_TabContentBigger li b {
1.911 bisitz 6970: background: url('/adm/lonIcons/tabbgright.gif') no-repeat right bottom;
6971: display: block;
6972: float: left;
6973: padding: 0 30px;
1.957 onken 6974: border-bottom: 1px solid $lg_border_color;
1.870 tempelho 6975: }
6976:
1.956 onken 6977: ul.LC_TabContentBigger li:hover b {
6978: color:$button_hover;
6979: }
6980:
1.870 tempelho 6981: ul.LC_TabContentBigger li.active b {
1.911 bisitz 6982: background:url('/adm/lonIcons/tabbgright.gif') right top no-repeat;
6983: color:$font;
1.957 onken 6984: border: 0;
1.741 harmsja 6985: }
1.693 droeschl 6986:
1.870 tempelho 6987:
1.862 bisitz 6988: ul.LC_CourseBreadcrumbs {
6989: background: $sidebg;
1.1020 raeburn 6990: height: 2em;
1.862 bisitz 6991: padding-left: 10px;
1.1020 raeburn 6992: margin: 0;
1.862 bisitz 6993: list-style-position: inside;
6994: }
6995:
1.911 bisitz 6996: ol#LC_MenuBreadcrumbs,
1.862 bisitz 6997: ol#LC_PathBreadcrumbs {
1.911 bisitz 6998: padding-left: 10px;
6999: margin: 0;
1.933 droeschl 7000: height: 2.5em; /* equal to #LC_breadcrumbs line-height */
1.693 droeschl 7001: }
7002:
1.911 bisitz 7003: ol#LC_MenuBreadcrumbs li,
7004: ol#LC_PathBreadcrumbs li,
1.862 bisitz 7005: ul.LC_CourseBreadcrumbs li {
1.911 bisitz 7006: display: inline;
1.933 droeschl 7007: white-space: normal;
1.693 droeschl 7008: }
7009:
1.823 bisitz 7010: ol#LC_MenuBreadcrumbs li a,
1.862 bisitz 7011: ul.LC_CourseBreadcrumbs li a {
1.911 bisitz 7012: text-decoration: none;
7013: font-size:90%;
1.693 droeschl 7014: }
1.795 www 7015:
1.969 droeschl 7016: ol#LC_MenuBreadcrumbs h1 {
7017: display: inline;
7018: font-size: 90%;
7019: line-height: 2.5em;
7020: margin: 0;
7021: padding: 0;
7022: }
7023:
1.795 www 7024: ol#LC_PathBreadcrumbs li a {
1.911 bisitz 7025: text-decoration:none;
7026: font-size:100%;
7027: font-weight:bold;
1.693 droeschl 7028: }
1.795 www 7029:
1.840 bisitz 7030: .LC_Box {
1.911 bisitz 7031: border: solid 1px $lg_border_color;
7032: padding: 0 10px 10px 10px;
1.746 neumanie 7033: }
1.795 www 7034:
1.1020 raeburn 7035: .LC_DocsBox {
7036: border: solid 1px $lg_border_color;
7037: padding: 0 0 10px 10px;
7038: }
7039:
1.795 www 7040: .LC_AboutMe_Image {
1.911 bisitz 7041: float:left;
7042: margin-right:10px;
1.747 neumanie 7043: }
1.795 www 7044:
7045: .LC_Clear_AboutMe_Image {
1.911 bisitz 7046: clear:left;
1.747 neumanie 7047: }
1.795 www 7048:
1.721 harmsja 7049: dl.LC_ListStyleClean dt {
1.911 bisitz 7050: padding-right: 5px;
7051: display: table-header-group;
1.693 droeschl 7052: }
7053:
1.721 harmsja 7054: dl.LC_ListStyleClean dd {
1.911 bisitz 7055: display: table-row;
1.693 droeschl 7056: }
7057:
1.721 harmsja 7058: .LC_ListStyleClean,
7059: .LC_ListStyleSimple,
7060: .LC_ListStyleNormal,
1.795 www 7061: .LC_ListStyleSpecial {
1.911 bisitz 7062: /* display:block; */
7063: list-style-position: inside;
7064: list-style-type: none;
7065: overflow: hidden;
7066: padding: 0;
1.693 droeschl 7067: }
7068:
1.721 harmsja 7069: .LC_ListStyleSimple li,
7070: .LC_ListStyleSimple dd,
7071: .LC_ListStyleNormal li,
7072: .LC_ListStyleNormal dd,
7073: .LC_ListStyleSpecial li,
1.795 www 7074: .LC_ListStyleSpecial dd {
1.911 bisitz 7075: margin: 0;
7076: padding: 5px 5px 5px 10px;
7077: clear: both;
1.693 droeschl 7078: }
7079:
1.721 harmsja 7080: .LC_ListStyleClean li,
7081: .LC_ListStyleClean dd {
1.911 bisitz 7082: padding-top: 0;
7083: padding-bottom: 0;
1.693 droeschl 7084: }
7085:
1.721 harmsja 7086: .LC_ListStyleSimple dd,
1.795 www 7087: .LC_ListStyleSimple li {
1.911 bisitz 7088: border-bottom: solid 1px $lg_border_color;
1.693 droeschl 7089: }
7090:
1.721 harmsja 7091: .LC_ListStyleSpecial li,
7092: .LC_ListStyleSpecial dd {
1.911 bisitz 7093: list-style-type: none;
7094: background-color: RGB(220, 220, 220);
7095: margin-bottom: 4px;
1.693 droeschl 7096: }
7097:
1.721 harmsja 7098: table.LC_SimpleTable {
1.911 bisitz 7099: margin:5px;
7100: border:solid 1px $lg_border_color;
1.795 www 7101: }
1.693 droeschl 7102:
1.721 harmsja 7103: table.LC_SimpleTable tr {
1.911 bisitz 7104: padding: 0;
7105: border:solid 1px $lg_border_color;
1.693 droeschl 7106: }
1.795 www 7107:
7108: table.LC_SimpleTable thead {
1.911 bisitz 7109: background:rgb(220,220,220);
1.693 droeschl 7110: }
7111:
1.721 harmsja 7112: div.LC_columnSection {
1.911 bisitz 7113: display: block;
7114: clear: both;
7115: overflow: hidden;
7116: margin: 0;
1.693 droeschl 7117: }
7118:
1.721 harmsja 7119: div.LC_columnSection>* {
1.911 bisitz 7120: float: left;
7121: margin: 10px 20px 10px 0;
7122: overflow:hidden;
1.693 droeschl 7123: }
1.721 harmsja 7124:
1.795 www 7125: table em {
1.911 bisitz 7126: font-weight: bold;
7127: font-style: normal;
1.748 schulted 7128: }
1.795 www 7129:
1.779 bisitz 7130: table.LC_tableBrowseRes,
1.795 www 7131: table.LC_tableOfContent {
1.911 bisitz 7132: border:none;
7133: border-spacing: 1px;
7134: padding: 3px;
7135: background-color: #FFFFFF;
7136: font-size: 90%;
1.753 droeschl 7137: }
1.789 droeschl 7138:
1.911 bisitz 7139: table.LC_tableOfContent {
7140: border-collapse: collapse;
1.789 droeschl 7141: }
7142:
1.771 droeschl 7143: table.LC_tableBrowseRes a,
1.768 schulted 7144: table.LC_tableOfContent a {
1.911 bisitz 7145: background-color: transparent;
7146: text-decoration: none;
1.753 droeschl 7147: }
7148:
1.795 www 7149: table.LC_tableOfContent img {
1.911 bisitz 7150: border: none;
7151: height: 1.3em;
7152: vertical-align: text-bottom;
7153: margin-right: 0.3em;
1.753 droeschl 7154: }
1.757 schulted 7155:
1.795 www 7156: a#LC_content_toolbar_firsthomework {
1.911 bisitz 7157: background-image:url(/res/adm/pages/open-first-problem.gif);
1.774 ehlerst 7158: }
7159:
1.795 www 7160: a#LC_content_toolbar_everything {
1.911 bisitz 7161: background-image:url(/res/adm/pages/show-all.gif);
1.774 ehlerst 7162: }
7163:
1.795 www 7164: a#LC_content_toolbar_uncompleted {
1.911 bisitz 7165: background-image:url(/res/adm/pages/show-incomplete-problems.gif);
1.774 ehlerst 7166: }
7167:
1.795 www 7168: #LC_content_toolbar_clearbubbles {
1.911 bisitz 7169: background-image:url(/res/adm/pages/mark-discussionentries-read.gif);
1.774 ehlerst 7170: }
7171:
1.795 www 7172: a#LC_content_toolbar_changefolder {
1.911 bisitz 7173: background : url(/res/adm/pages/close-all-folders.gif) top center ;
1.757 schulted 7174: }
7175:
1.795 www 7176: a#LC_content_toolbar_changefolder_toggled {
1.911 bisitz 7177: background-image:url(/res/adm/pages/open-all-folders.gif);
1.757 schulted 7178: }
7179:
1.1043 raeburn 7180: a#LC_content_toolbar_edittoplevel {
7181: background-image:url(/res/adm/pages/edittoplevel.gif);
7182: }
7183:
1.795 www 7184: ul#LC_toolbar li a:hover {
1.911 bisitz 7185: background-position: bottom center;
1.757 schulted 7186: }
7187:
1.795 www 7188: ul#LC_toolbar {
1.911 bisitz 7189: padding: 0;
7190: margin: 2px;
7191: list-style:none;
7192: position:relative;
7193: background-color:white;
1.1082 raeburn 7194: overflow: auto;
1.757 schulted 7195: }
7196:
1.795 www 7197: ul#LC_toolbar li {
1.911 bisitz 7198: border:1px solid white;
7199: padding: 0;
7200: margin: 0;
7201: float: left;
7202: display:inline;
7203: vertical-align:middle;
1.1082 raeburn 7204: white-space: nowrap;
1.911 bisitz 7205: }
1.757 schulted 7206:
1.783 amueller 7207:
1.795 www 7208: a.LC_toolbarItem {
1.911 bisitz 7209: display:block;
7210: padding: 0;
7211: margin: 0;
7212: height: 32px;
7213: width: 32px;
7214: color:white;
7215: border: none;
7216: background-repeat:no-repeat;
7217: background-color:transparent;
1.757 schulted 7218: }
7219:
1.915 droeschl 7220: ul.LC_funclist {
7221: margin: 0;
7222: padding: 0.5em 1em 0.5em 0;
7223: }
7224:
1.933 droeschl 7225: ul.LC_funclist > li:first-child {
7226: font-weight:bold;
7227: margin-left:0.8em;
7228: }
7229:
1.915 droeschl 7230: ul.LC_funclist + ul.LC_funclist {
7231: /*
7232: left border as a seperator if we have more than
7233: one list
7234: */
7235: border-left: 1px solid $sidebg;
7236: /*
7237: this hides the left border behind the border of the
7238: outer box if element is wrapped to the next 'line'
7239: */
7240: margin-left: -1px;
7241: }
7242:
1.843 bisitz 7243: ul.LC_funclist li {
1.915 droeschl 7244: display: inline;
1.782 bisitz 7245: white-space: nowrap;
1.915 droeschl 7246: margin: 0 0 0 25px;
7247: line-height: 150%;
1.782 bisitz 7248: }
7249:
1.974 wenzelju 7250: .LC_hidden {
7251: display: none;
7252: }
7253:
1.1030 www 7254: .LCmodal-overlay {
7255: position:fixed;
7256: top:0;
7257: right:0;
7258: bottom:0;
7259: left:0;
7260: height:100%;
7261: width:100%;
7262: margin:0;
7263: padding:0;
7264: background:#999;
7265: opacity:.75;
7266: filter: alpha(opacity=75);
7267: -moz-opacity: 0.75;
7268: z-index:101;
7269: }
7270:
7271: * html .LCmodal-overlay {
7272: position: absolute;
7273: height: expression(document.body.scrollHeight > document.body.offsetHeight ? document.body.scrollHeight : document.body.offsetHeight + 'px');
7274: }
7275:
7276: .LCmodal-window {
7277: position:fixed;
7278: top:50%;
7279: left:50%;
7280: margin:0;
7281: padding:0;
7282: z-index:102;
7283: }
7284:
7285: * html .LCmodal-window {
7286: position:absolute;
7287: }
7288:
7289: .LCclose-window {
7290: position:absolute;
7291: width:32px;
7292: height:32px;
7293: right:8px;
7294: top:8px;
7295: background:transparent url('/res/adm/pages/process-stop.png') no-repeat scroll right top;
7296: text-indent:-99999px;
7297: overflow:hidden;
7298: cursor:pointer;
7299: }
7300:
1.1100 raeburn 7301: /*
7302: styles used by TTH when "Default set of options to pass to tth/m
7303: when converting TeX" in course settings has been set
7304:
7305: option passed: -t
7306:
7307: */
7308:
7309: td div.comp { margin-top: -0.6ex; margin-bottom: -1ex;}
7310: td div.comb { margin-top: -0.6ex; margin-bottom: -.6ex;}
7311: td div.hrcomp { line-height: 0.9; margin-top: -0.8ex; margin-bottom: -1ex;}
7312: td div.norm {line-height:normal;}
7313:
7314: /*
7315: option passed -y3
7316: */
7317:
7318: span.roman {font-family: serif; font-style: normal; font-weight: normal;}
7319: span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
7320: span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
7321:
1.343 albertel 7322: END
7323: }
7324:
1.306 albertel 7325: =pod
7326:
7327: =item * &headtag()
7328:
7329: Returns a uniform footer for LON-CAPA web pages.
7330:
1.307 albertel 7331: Inputs: $title - optional title for the head
7332: $head_extra - optional extra HTML to put inside the <head>
1.315 albertel 7333: $args - optional arguments
1.319 albertel 7334: force_register - if is true call registerurl so the remote is
7335: informed
1.415 albertel 7336: redirect -> array ref of
7337: 1- seconds before redirect occurs
7338: 2- url to redirect to
7339: 3- whether the side effect should occur
1.315 albertel 7340: (side effect of setting
7341: $env{'internal.head.redirect'} to the url
7342: redirected too)
1.352 albertel 7343: domain -> force to color decorate a page for a specific
7344: domain
7345: function -> force usage of a specific rolish color scheme
7346: bgcolor -> override the default page bgcolor
1.460 albertel 7347: no_auto_mt_title
7348: -> prevent &mt()ing the title arg
1.464 albertel 7349:
1.306 albertel 7350: =cut
7351:
7352: sub headtag {
1.313 albertel 7353: my ($title,$head_extra,$args) = @_;
1.306 albertel 7354:
1.363 albertel 7355: my $function = $args->{'function'} || &get_users_function();
7356: my $domain = $args->{'domain'} || &determinedomain();
7357: my $bgcolor = $args->{'bgcolor'} || &designparm($function.'.pgbg',$domain);
1.1154 raeburn 7358: my $httphost = $args->{'use_absolute'};
1.418 albertel 7359: my $url = join(':',$env{'user.name'},$env{'user.domain'},
1.458 albertel 7360: $Apache::lonnet::perlvar{'lonVersion'},
1.531 albertel 7361: #time(),
1.418 albertel 7362: $env{'environment.color.timestamp'},
1.363 albertel 7363: $function,$domain,$bgcolor);
7364:
1.369 www 7365: $url = '/adm/css/'.&escape($url).'.css';
1.363 albertel 7366:
1.308 albertel 7367: my $result =
7368: '<head>'.
1.1160 raeburn 7369: &font_settings($args);
1.319 albertel 7370:
1.1188 raeburn 7371: my $inhibitprint;
7372: if ($args->{'print_suppress'}) {
7373: $inhibitprint = &print_suppression();
7374: }
1.1064 raeburn 7375:
1.461 albertel 7376: if (!$args->{'frameset'}) {
7377: $result .= &Apache::lonhtmlcommon::htmlareaheaders();
7378: }
1.962 droeschl 7379: if ($args->{'force_register'} && $env{'request.noversionuri'} !~ m{^/res/adm/pages/}) {
7380: $result .= Apache::lonxml::display_title();
1.319 albertel 7381: }
1.436 albertel 7382: if (!$args->{'no_nav_bar'}
7383: && !$args->{'only_body'}
7384: && !$args->{'frameset'}) {
1.1154 raeburn 7385: $result .= &help_menu_js($httphost);
1.1032 www 7386: $result.=&modal_window();
1.1038 www 7387: $result.=&togglebox_script();
1.1034 www 7388: $result.=&wishlist_window();
1.1041 www 7389: $result.=&LCprogressbarUpdate_script();
1.1034 www 7390: } else {
7391: if ($args->{'add_modal'}) {
7392: $result.=&modal_window();
7393: }
7394: if ($args->{'add_wishlist'}) {
7395: $result.=&wishlist_window();
7396: }
1.1038 www 7397: if ($args->{'add_togglebox'}) {
7398: $result.=&togglebox_script();
7399: }
1.1041 www 7400: if ($args->{'add_progressbar'}) {
7401: $result.=&LCprogressbarUpdate_script();
7402: }
1.436 albertel 7403: }
1.314 albertel 7404: if (ref($args->{'redirect'})) {
1.414 albertel 7405: my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
1.315 albertel 7406: $url = &Apache::lonenc::check_encrypt($url);
1.414 albertel 7407: if (!$inhibit_continue) {
7408: $env{'internal.head.redirect'} = $url;
7409: }
1.313 albertel 7410: $result.=<<ADDMETA
7411: <meta http-equiv="pragma" content="no-cache" />
1.344 albertel 7412: <meta http-equiv="Refresh" content="$time; url=$url" />
1.313 albertel 7413: ADDMETA
7414: }
1.306 albertel 7415: if (!defined($title)) {
7416: $title = 'The LearningOnline Network with CAPA';
7417: }
1.460 albertel 7418: if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
7419: $result .= '<title> LON-CAPA '.$title.'</title>'
1.1168 raeburn 7420: .'<link rel="stylesheet" type="text/css" href="'.$url.'"';
7421: if (!$args->{'frameset'}) {
7422: $result .= ' /';
7423: }
7424: $result .= '>'
1.1064 raeburn 7425: .$inhibitprint
1.414 albertel 7426: .$head_extra;
1.1137 raeburn 7427: if ($env{'browser.mobile'}) {
7428: $result .= '
7429: <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
7430: <meta name="apple-mobile-web-app-capable" content="yes" />';
7431: }
1.962 droeschl 7432: return $result.'</head>';
1.306 albertel 7433: }
7434:
7435: =pod
7436:
1.340 albertel 7437: =item * &font_settings()
7438:
7439: Returns neccessary <meta> to set the proper encoding
7440:
1.1160 raeburn 7441: Inputs: optional reference to HASH -- $args passed to &headtag()
1.340 albertel 7442:
7443: =cut
7444:
7445: sub font_settings {
1.1160 raeburn 7446: my ($args) = @_;
1.340 albertel 7447: my $headerstring='';
1.1160 raeburn 7448: if ((!$env{'browser.mathml'} && $env{'browser.unicode'}) ||
7449: ((ref($args) eq 'HASH') && ($args->{'browser.unicode'}))) {
1.1168 raeburn 7450: $headerstring.=
7451: '<meta http-equiv="Content-Type" content="text/html; charset=utf-8"';
7452: if (!$args->{'frameset'}) {
7453: $headerstring.= ' /';
7454: }
7455: $headerstring .= '>'."\n";
1.340 albertel 7456: }
7457: return $headerstring;
7458: }
7459:
1.341 albertel 7460: =pod
7461:
1.1064 raeburn 7462: =item * &print_suppression()
7463:
7464: In course context returns css which causes the body to be blank when media="print",
7465: if printout generation is unavailable for the current resource.
7466:
7467: This could be because:
7468:
7469: (a) printstartdate is in the future
7470:
7471: (b) printenddate is in the past
7472:
7473: (c) there is an active exam block with "printout"
7474: functionality blocked
7475:
7476: Users with pav, pfo or evb privileges are exempt.
7477:
7478: Inputs: none
7479:
7480: =cut
7481:
7482:
7483: sub print_suppression {
7484: my $noprint;
7485: if ($env{'request.course.id'}) {
7486: my $scope = $env{'request.course.id'};
7487: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7488: (&Apache::lonnet::allowed('pfo',$scope))) {
7489: return;
7490: }
7491: if ($env{'request.course.sec'} ne '') {
7492: $scope .= "/$env{'request.course.sec'}";
7493: if ((&Apache::lonnet::allowed('pav',$scope)) ||
7494: (&Apache::lonnet::allowed('pfo',$scope))) {
1.1065 raeburn 7495: return;
1.1064 raeburn 7496: }
7497: }
7498: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
7499: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1189 raeburn 7500: my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
1.1064 raeburn 7501: if ($blocked) {
7502: my $checkrole = "cm./$cdom/$cnum";
7503: if ($env{'request.course.sec'} ne '') {
7504: $checkrole .= "/$env{'request.course.sec'}";
7505: }
7506: unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
7507: ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
7508: $noprint = 1;
7509: }
7510: }
7511: unless ($noprint) {
7512: my $symb = &Apache::lonnet::symbread();
7513: if ($symb ne '') {
7514: my $navmap = Apache::lonnavmaps::navmap->new();
7515: if (ref($navmap)) {
7516: my $res = $navmap->getBySymb($symb);
7517: if (ref($res)) {
7518: if (!$res->resprintable()) {
7519: $noprint = 1;
7520: }
7521: }
7522: }
7523: }
7524: }
7525: if ($noprint) {
7526: return <<"ENDSTYLE";
7527: <style type="text/css" media="print">
7528: body { display:none }
7529: </style>
7530: ENDSTYLE
7531: }
7532: }
7533: return;
7534: }
7535:
7536: =pod
7537:
1.341 albertel 7538: =item * &xml_begin()
7539:
7540: Returns the needed doctype and <html>
7541:
7542: Inputs: none
7543:
7544: =cut
7545:
7546: sub xml_begin {
1.1168 raeburn 7547: my ($is_frameset) = @_;
1.341 albertel 7548: my $output='';
7549:
7550: if ($env{'browser.mathml'}) {
7551: $output='<?xml version="1.0"?>'
7552: #.'<?xml-stylesheet type="text/css" href="/adm/MathML/mathml.css"?>'."\n"
7553: # .'<!DOCTYPE html SYSTEM "/adm/MathML/mathml.dtd" '
7554:
7555: # .'<!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">] >'
7556: .'<!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">'
7557: .'<html xmlns:math="http://www.w3.org/1998/Math/MathML" '
7558: .'xmlns="http://www.w3.org/1999/xhtml">';
1.1168 raeburn 7559: } elsif ($is_frameset) {
7560: $output='<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">'."\n".
7561: '<html>'."\n";
1.341 albertel 7562: } else {
1.1168 raeburn 7563: $output='<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'."\n".
7564: '<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'."\n";
1.341 albertel 7565: }
7566: return $output;
7567: }
1.340 albertel 7568:
7569: =pod
7570:
1.306 albertel 7571: =item * &start_page()
7572:
7573: Returns a complete <html> .. <body> section for LON-CAPA web pages.
7574:
1.648 raeburn 7575: Inputs:
7576:
7577: =over 4
7578:
7579: $title - optional title for the page
7580:
7581: $head_extra - optional extra HTML to incude inside the <head>
7582:
7583: $args - additional optional args supported are:
7584:
7585: =over 8
7586:
7587: only_body -> is true will set &bodytag() onlybodytag
1.317 albertel 7588: arg on
1.814 bisitz 7589: no_nav_bar -> is true will set &bodytag() no_nav_bar arg on
1.648 raeburn 7590: add_entries -> additional attributes to add to the <body>
7591: domain -> force to color decorate a page for a
1.317 albertel 7592: specific domain
1.648 raeburn 7593: function -> force usage of a specific rolish color
1.317 albertel 7594: scheme
1.648 raeburn 7595: redirect -> see &headtag()
7596: bgcolor -> override the default page bg color
7597: js_ready -> return a string ready for being used in
1.317 albertel 7598: a javascript writeln
1.648 raeburn 7599: html_encode -> return a string ready for being used in
1.320 albertel 7600: a html attribute
1.648 raeburn 7601: force_register -> if is true will turn on the &bodytag()
1.317 albertel 7602: $forcereg arg
1.648 raeburn 7603: frameset -> if true will start with a <frameset>
1.330 albertel 7604: rather than <body>
1.648 raeburn 7605: skip_phases -> hash ref of
1.338 albertel 7606: head -> skip the <html><head> generation
7607: body -> skip all <body> generation
1.648 raeburn 7608: no_auto_mt_title -> prevent &mt()ing the title arg
7609: inherit_jsmath -> when creating popup window in a page,
7610: should it have jsmath forced on by the
7611: current page
1.867 kalberla 7612: bread_crumbs -> Array containing breadcrumbs
1.983 raeburn 7613: bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
1.1096 raeburn 7614: group -> includes the current group, if page is for a
7615: specific group
1.361 albertel 7616:
1.648 raeburn 7617: =back
1.460 albertel 7618:
1.648 raeburn 7619: =back
1.562 albertel 7620:
1.306 albertel 7621: =cut
7622:
7623: sub start_page {
1.309 albertel 7624: my ($title,$head_extra,$args) = @_;
1.318 albertel 7625: #&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
1.319 albertel 7626:
1.315 albertel 7627: $env{'internal.start_page'}++;
1.1096 raeburn 7628: my ($result,@advtools);
1.964 droeschl 7629:
1.338 albertel 7630: if (! exists($args->{'skip_phases'}{'head'}) ) {
1.1168 raeburn 7631: $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
1.338 albertel 7632: }
7633:
7634: if (! exists($args->{'skip_phases'}{'body'}) ) {
7635: if ($args->{'frameset'}) {
7636: my $attr_string = &make_attr_string($args->{'force_register'},
7637: $args->{'add_entries'});
7638: $result .= "\n<frameset $attr_string>\n";
1.831 bisitz 7639: } else {
7640: $result .=
7641: &bodytag($title,
7642: $args->{'function'}, $args->{'add_entries'},
7643: $args->{'only_body'}, $args->{'domain'},
7644: $args->{'force_register'}, $args->{'no_nav_bar'},
1.1096 raeburn 7645: $args->{'bgcolor'}, $args,
7646: \@advtools);
1.831 bisitz 7647: }
1.330 albertel 7648: }
1.338 albertel 7649:
1.315 albertel 7650: if ($args->{'js_ready'}) {
1.713 kaisler 7651: $result = &js_ready($result);
1.315 albertel 7652: }
1.320 albertel 7653: if ($args->{'html_encode'}) {
1.713 kaisler 7654: $result = &html_encode($result);
7655: }
7656:
1.813 bisitz 7657: # Preparation for new and consistent functionlist at top of screen
7658: # if ($args->{'functionlist'}) {
7659: # $result .= &build_functionlist();
7660: #}
7661:
1.964 droeschl 7662: # Don't add anything more if only_body wanted or in const space
7663: return $result if $args->{'only_body'}
7664: || $env{'request.state'} eq 'construct';
1.813 bisitz 7665:
7666: #Breadcrumbs
1.758 kaisler 7667: if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
7668: &Apache::lonhtmlcommon::clear_breadcrumbs();
7669: #if any br links exists, add them to the breadcrumbs
7670: if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
7671: foreach my $crumb (@{$args->{'bread_crumbs'}}){
7672: &Apache::lonhtmlcommon::add_breadcrumb($crumb);
7673: }
7674: }
1.1096 raeburn 7675: # if @advtools array contains items add then to the breadcrumbs
7676: if (@advtools > 0) {
7677: &Apache::lonmenu::advtools_crumbs(@advtools);
7678: }
1.758 kaisler 7679:
7680: #if bread_crumbs_component exists show it as headline else show only the breadcrumbs
7681: if(exists($args->{'bread_crumbs_component'})){
7682: $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
7683: }else{
7684: $result .= &Apache::lonhtmlcommon::breadcrumbs();
7685: }
1.320 albertel 7686: }
1.315 albertel 7687: return $result;
1.306 albertel 7688: }
7689:
7690: sub end_page {
1.315 albertel 7691: my ($args) = @_;
7692: $env{'internal.end_page'}++;
1.330 albertel 7693: my $result;
1.335 albertel 7694: if ($args->{'discussion'}) {
7695: my ($target,$parser);
7696: if (ref($args->{'discussion'})) {
7697: ($target,$parser) =($args->{'discussion'}{'target'},
7698: $args->{'discussion'}{'parser'});
7699: }
7700: $result .= &Apache::lonxml::xmlend($target,$parser);
7701: }
1.330 albertel 7702: if ($args->{'frameset'}) {
7703: $result .= '</frameset>';
7704: } else {
1.635 raeburn 7705: $result .= &endbodytag($args);
1.330 albertel 7706: }
1.1080 raeburn 7707: unless ($args->{'notbody'}) {
7708: $result .= "\n</html>";
7709: }
1.330 albertel 7710:
1.315 albertel 7711: if ($args->{'js_ready'}) {
1.317 albertel 7712: $result = &js_ready($result);
1.315 albertel 7713: }
1.335 albertel 7714:
1.320 albertel 7715: if ($args->{'html_encode'}) {
7716: $result = &html_encode($result);
7717: }
1.335 albertel 7718:
1.315 albertel 7719: return $result;
7720: }
7721:
1.1034 www 7722: sub wishlist_window {
7723: return(<<'ENDWISHLIST');
1.1046 raeburn 7724: <script type="text/javascript">
1.1034 www 7725: // <![CDATA[
7726: // <!-- BEGIN LON-CAPA Internal
7727: function set_wishlistlink(title, path) {
7728: if (!title) {
7729: title = document.title;
7730: title = title.replace(/^LON-CAPA /,'');
7731: }
1.1175 raeburn 7732: title = encodeURIComponent(title);
1.1034 www 7733: if (!path) {
7734: path = location.pathname;
7735: }
1.1175 raeburn 7736: path = encodeURIComponent(path);
1.1034 www 7737: Win = window.open('/adm/wishlist?mode=newLink&setTitle='+title+'&setPath='+path,
7738: 'wishlistNewLink','width=560,height=350,scrollbars=0');
7739: }
7740: // END LON-CAPA Internal -->
7741: // ]]>
7742: </script>
7743: ENDWISHLIST
7744: }
7745:
1.1030 www 7746: sub modal_window {
7747: return(<<'ENDMODAL');
1.1046 raeburn 7748: <script type="text/javascript">
1.1030 www 7749: // <![CDATA[
7750: // <!-- BEGIN LON-CAPA Internal
7751: var modalWindow = {
7752: parent:"body",
7753: windowId:null,
7754: content:null,
7755: width:null,
7756: height:null,
7757: close:function()
7758: {
7759: $(".LCmodal-window").remove();
7760: $(".LCmodal-overlay").remove();
7761: },
7762: open:function()
7763: {
7764: var modal = "";
7765: modal += "<div class=\"LCmodal-overlay\"></div>";
7766: 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;\">";
7767: modal += this.content;
7768: modal += "</div>";
7769:
7770: $(this.parent).append(modal);
7771:
7772: $(".LCmodal-window").append("<a class=\"LCclose-window\"></a>");
7773: $(".LCclose-window").click(function(){modalWindow.close();});
7774: $(".LCmodal-overlay").click(function(){modalWindow.close();});
7775: }
7776: };
1.1140 raeburn 7777: var openMyModal = function(source,width,height,scrolling,transparency,style)
1.1030 www 7778: {
7779: modalWindow.windowId = "myModal";
7780: modalWindow.width = width;
7781: modalWindow.height = height;
1.1196 raeburn 7782: modalWindow.content = "<iframe width='"+width+"' height='"+height+"' frameborder='0' scrolling='"+scrolling+"' allowtransparency='"+transparency+"' src='" + source + "' style='"+style+"'></iframe>";
1.1030 www 7783: modalWindow.open();
7784: };
7785: // END LON-CAPA Internal -->
7786: // ]]>
7787: </script>
7788: ENDMODAL
7789: }
7790:
7791: sub modal_link {
1.1140 raeburn 7792: my ($link,$linktext,$width,$height,$target,$scrolling,$title,$transparency,$style)=@_;
1.1030 www 7793: unless ($width) { $width=480; }
7794: unless ($height) { $height=400; }
1.1031 www 7795: unless ($scrolling) { $scrolling='yes'; }
1.1140 raeburn 7796: unless ($transparency) { $transparency='true'; }
7797:
1.1074 raeburn 7798: my $target_attr;
7799: if (defined($target)) {
7800: $target_attr = 'target="'.$target.'"';
7801: }
7802: return <<"ENDLINK";
1.1140 raeburn 7803: <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">
1.1074 raeburn 7804: $linktext</a>
7805: ENDLINK
1.1030 www 7806: }
7807:
1.1032 www 7808: sub modal_adhoc_script {
7809: my ($funcname,$width,$height,$content)=@_;
7810: return (<<ENDADHOC);
1.1046 raeburn 7811: <script type="text/javascript">
1.1032 www 7812: // <![CDATA[
7813: var $funcname = function()
7814: {
7815: modalWindow.windowId = "myModal";
7816: modalWindow.width = $width;
7817: modalWindow.height = $height;
7818: modalWindow.content = '$content';
7819: modalWindow.open();
7820: };
7821: // ]]>
7822: </script>
7823: ENDADHOC
7824: }
7825:
1.1041 www 7826: sub modal_adhoc_inner {
7827: my ($funcname,$width,$height,$content)=@_;
7828: my $innerwidth=$width-20;
7829: $content=&js_ready(
1.1140 raeburn 7830: &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
7831: &start_scrollbox($width.'px',$innerwidth.'px',$height.'px','myModal','#FFFFFF',undef,1).
7832: $content.
1.1041 www 7833: &end_scrollbox().
1.1140 raeburn 7834: &end_page()
1.1041 www 7835: );
7836: return &modal_adhoc_script($funcname,$width,$height,$content);
7837: }
7838:
7839: sub modal_adhoc_window {
7840: my ($funcname,$width,$height,$content,$linktext)=@_;
7841: return &modal_adhoc_inner($funcname,$width,$height,$content).
7842: "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
7843: }
7844:
7845: sub modal_adhoc_launch {
7846: my ($funcname,$width,$height,$content)=@_;
7847: return &modal_adhoc_inner($funcname,$width,$height,$content).(<<ENDLAUNCH);
7848: <script type="text/javascript">
7849: // <![CDATA[
7850: $funcname();
7851: // ]]>
7852: </script>
7853: ENDLAUNCH
7854: }
7855:
7856: sub modal_adhoc_close {
7857: return (<<ENDCLOSE);
7858: <script type="text/javascript">
7859: // <![CDATA[
7860: modalWindow.close();
7861: // ]]>
7862: </script>
7863: ENDCLOSE
7864: }
7865:
1.1038 www 7866: sub togglebox_script {
7867: return(<<ENDTOGGLE);
7868: <script type="text/javascript">
7869: // <![CDATA[
7870: function LCtoggleDisplay(id,hidetext,showtext) {
7871: link = document.getElementById(id + "link").childNodes[0];
7872: with (document.getElementById(id).style) {
7873: if (display == "none" ) {
7874: display = "inline";
7875: link.nodeValue = hidetext;
7876: } else {
7877: display = "none";
7878: link.nodeValue = showtext;
7879: }
7880: }
7881: }
7882: // ]]>
7883: </script>
7884: ENDTOGGLE
7885: }
7886:
1.1039 www 7887: sub start_togglebox {
7888: my ($id,$heading,$headerbg,$hidetext,$showtext)=@_;
7889: unless ($heading) { $heading=''; } else { $heading.=' '; }
7890: unless ($showtext) { $showtext=&mt('show'); }
7891: unless ($hidetext) { $hidetext=&mt('hide'); }
7892: unless ($headerbg) { $headerbg='#FFFFFF'; }
7893: return &start_data_table().
7894: &start_data_table_header_row().
7895: '<td bgcolor="'.$headerbg.'">'.$heading.
7896: '[<a id="'.$id.'link" href="javascript:LCtoggleDisplay(\''.$id.'\',\''.$hidetext.'\',\''.
7897: $showtext.'\')">'.$showtext.'</a>]</td>'.
7898: &end_data_table_header_row().
7899: '<tr id="'.$id.'" style="display:none""><td>';
7900: }
7901:
7902: sub end_togglebox {
7903: return '</td></tr>'.&end_data_table();
7904: }
7905:
1.1041 www 7906: sub LCprogressbar_script {
1.1045 www 7907: my ($id)=@_;
1.1041 www 7908: return(<<ENDPROGRESS);
7909: <script type="text/javascript">
7910: // <![CDATA[
1.1045 www 7911: \$('#progressbar$id').progressbar({
1.1041 www 7912: value: 0,
7913: change: function(event, ui) {
7914: var newVal = \$(this).progressbar('option', 'value');
7915: \$('.pblabel', this).text(LCprogressTxt);
7916: }
7917: });
7918: // ]]>
7919: </script>
7920: ENDPROGRESS
7921: }
7922:
7923: sub LCprogressbarUpdate_script {
7924: return(<<ENDPROGRESSUPDATE);
7925: <style type="text/css">
7926: .ui-progressbar { position:relative; }
7927: .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
7928: </style>
7929: <script type="text/javascript">
7930: // <![CDATA[
1.1045 www 7931: var LCprogressTxt='---';
7932:
7933: function LCupdateProgress(percent,progresstext,id) {
1.1041 www 7934: LCprogressTxt=progresstext;
1.1045 www 7935: \$('#progressbar'+id).progressbar('value',percent);
1.1041 www 7936: }
7937: // ]]>
7938: </script>
7939: ENDPROGRESSUPDATE
7940: }
7941:
1.1042 www 7942: my $LClastpercent;
1.1045 www 7943: my $LCidcnt;
7944: my $LCcurrentid;
1.1042 www 7945:
1.1041 www 7946: sub LCprogressbar {
1.1042 www 7947: my ($r)=(@_);
7948: $LClastpercent=0;
1.1045 www 7949: $LCidcnt++;
7950: $LCcurrentid=$$.'_'.$LCidcnt;
1.1041 www 7951: my $starting=&mt('Starting');
7952: my $content=(<<ENDPROGBAR);
1.1045 www 7953: <div id="progressbar$LCcurrentid">
1.1041 www 7954: <span class="pblabel">$starting</span>
7955: </div>
7956: ENDPROGBAR
1.1045 www 7957: &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
1.1041 www 7958: }
7959:
7960: sub LCprogressbarUpdate {
1.1042 www 7961: my ($r,$val,$text)=@_;
7962: unless ($val) {
7963: if ($LClastpercent) {
7964: $val=$LClastpercent;
7965: } else {
7966: $val=0;
7967: }
7968: }
1.1041 www 7969: if ($val<0) { $val=0; }
7970: if ($val>100) { $val=0; }
1.1042 www 7971: $LClastpercent=$val;
1.1041 www 7972: unless ($text) { $text=$val.'%'; }
7973: $text=&js_ready($text);
1.1044 www 7974: &r_print($r,<<ENDUPDATE);
1.1041 www 7975: <script type="text/javascript">
7976: // <![CDATA[
1.1045 www 7977: LCupdateProgress($val,'$text','$LCcurrentid');
1.1041 www 7978: // ]]>
7979: </script>
7980: ENDUPDATE
1.1035 www 7981: }
7982:
1.1042 www 7983: sub LCprogressbarClose {
7984: my ($r)=@_;
7985: $LClastpercent=0;
1.1044 www 7986: &r_print($r,<<ENDCLOSE);
1.1042 www 7987: <script type="text/javascript">
7988: // <![CDATA[
1.1045 www 7989: \$("#progressbar$LCcurrentid").hide('slow');
1.1042 www 7990: // ]]>
7991: </script>
7992: ENDCLOSE
1.1044 www 7993: }
7994:
7995: sub r_print {
7996: my ($r,$to_print)=@_;
7997: if ($r) {
7998: $r->print($to_print);
7999: $r->rflush();
8000: } else {
8001: print($to_print);
8002: }
1.1042 www 8003: }
8004:
1.320 albertel 8005: sub html_encode {
8006: my ($result) = @_;
8007:
1.322 albertel 8008: $result = &HTML::Entities::encode($result,'<>&"');
1.320 albertel 8009:
8010: return $result;
8011: }
1.1044 www 8012:
1.317 albertel 8013: sub js_ready {
8014: my ($result) = @_;
8015:
1.323 albertel 8016: $result =~ s/[\n\r]/ /xmsg;
8017: $result =~ s/\\/\\\\/xmsg;
8018: $result =~ s/'/\\'/xmsg;
1.372 albertel 8019: $result =~ s{</}{<\\/}xmsg;
1.317 albertel 8020:
8021: return $result;
8022: }
8023:
1.315 albertel 8024: sub validate_page {
8025: if ( exists($env{'internal.start_page'})
1.316 albertel 8026: && $env{'internal.start_page'} > 1) {
8027: &Apache::lonnet::logthis('start_page called multiple times '.
1.318 albertel 8028: $env{'internal.start_page'}.' '.
1.316 albertel 8029: $ENV{'request.filename'});
1.315 albertel 8030: }
8031: if ( exists($env{'internal.end_page'})
1.316 albertel 8032: && $env{'internal.end_page'} > 1) {
8033: &Apache::lonnet::logthis('end_page called multiple times '.
1.318 albertel 8034: $env{'internal.end_page'}.' '.
1.316 albertel 8035: $env{'request.filename'});
1.315 albertel 8036: }
8037: if ( exists($env{'internal.start_page'})
8038: && ! exists($env{'internal.end_page'})) {
1.316 albertel 8039: &Apache::lonnet::logthis('start_page called without end_page '.
8040: $env{'request.filename'});
1.315 albertel 8041: }
8042: if ( ! exists($env{'internal.start_page'})
8043: && exists($env{'internal.end_page'})) {
1.316 albertel 8044: &Apache::lonnet::logthis('end_page called without start_page'.
8045: $env{'request.filename'});
1.315 albertel 8046: }
1.306 albertel 8047: }
1.315 albertel 8048:
1.996 www 8049:
8050: sub start_scrollbox {
1.1140 raeburn 8051: my ($outerwidth,$width,$height,$id,$bgcolor,$cursor,$needjsready) = @_;
1.998 raeburn 8052: unless ($outerwidth) { $outerwidth='520px'; }
8053: unless ($width) { $width='500px'; }
8054: unless ($height) { $height='200px'; }
1.1075 raeburn 8055: my ($table_id,$div_id,$tdcol);
1.1018 raeburn 8056: if ($id ne '') {
1.1140 raeburn 8057: $table_id = ' id="table_'.$id.'"';
1.1137 raeburn 8058: $div_id = ' id="div_'.$id.'"';
1.1018 raeburn 8059: }
1.1075 raeburn 8060: if ($bgcolor ne '') {
8061: $tdcol = "background-color: $bgcolor;";
8062: }
1.1137 raeburn 8063: my $nicescroll_js;
8064: if ($env{'browser.mobile'}) {
1.1140 raeburn 8065: $nicescroll_js = &nicescroll_javascript('div_'.$id,$cursor,$needjsready);
8066: }
8067: return <<"END";
8068: $nicescroll_js
8069:
8070: <table style="width: $outerwidth; border: 1px solid none;"$table_id><tr><td style="width: $width;$tdcol">
8071: <div style="overflow:auto; width:$width; height:$height;"$div_id>
8072: END
8073: }
8074:
8075: sub end_scrollbox {
8076: return '</div></td></tr></table>';
8077: }
8078:
8079: sub nicescroll_javascript {
8080: my ($id,$cursor,$needjsready,$framecheck,$location) = @_;
8081: my %options;
8082: if (ref($cursor) eq 'HASH') {
8083: %options = %{$cursor};
8084: }
8085: unless ($options{'railalign'} =~ /^left|right$/) {
8086: $options{'railalign'} = 'left';
8087: }
8088: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
8089: my $function = &get_users_function();
8090: $options{'cursorcolor'} = &designparm($function.'.sidebg',$env{'request.role.domain'});
1.1138 raeburn 8091: unless ($options{'cursorcolor'} =~ /^\#\w+$/) {
1.1140 raeburn 8092: $options{'cursorcolor'} = '#00F';
1.1138 raeburn 8093: }
1.1140 raeburn 8094: }
8095: if ($options{'cursoropacity'} =~ /^[\d.]+$/) {
8096: unless ($options{'cursoropacity'} >= 0.0 && $options{'cursoropacity'} <=1.0) {
1.1138 raeburn 8097: $options{'cursoropacity'}='1.0';
8098: }
1.1140 raeburn 8099: } else {
8100: $options{'cursoropacity'}='1.0';
8101: }
8102: if ($options{'cursorfixedheight'} eq 'none') {
8103: delete($options{'cursorfixedheight'});
8104: } else {
8105: unless ($options{'cursorfixedheight'} =~ /^\d+$/) { $options{'cursorfixedheight'}='50'; }
8106: }
8107: unless ($options{'railoffset'} =~ /^{[\w\:\d\-,]+}$/) {
8108: delete($options{'railoffset'});
8109: }
8110: my @niceoptions;
8111: while (my($key,$value) = each(%options)) {
8112: if ($value =~ /^\{.+\}$/) {
8113: push(@niceoptions,$key.':'.$value);
1.1138 raeburn 8114: } else {
1.1140 raeburn 8115: push(@niceoptions,$key.':"'.$value.'"');
1.1138 raeburn 8116: }
1.1140 raeburn 8117: }
8118: my $nicescroll_js = '
1.1137 raeburn 8119: $(document).ready(
1.1140 raeburn 8120: function() {
8121: $("#'.$id.'").niceScroll({'.join(',',@niceoptions).'});
8122: }
1.1137 raeburn 8123: );
8124: ';
1.1140 raeburn 8125: if ($framecheck) {
8126: $nicescroll_js .= '
8127: function expand_div(caller) {
8128: if (top === self) {
8129: document.getElementById("'.$id.'").style.width = "auto";
8130: document.getElementById("'.$id.'").style.height = "auto";
8131: } else {
8132: try {
8133: if (parent.frames) {
8134: if (parent.frames.length > 1) {
8135: var framesrc = parent.frames[1].location.href;
8136: var currsrc = framesrc.replace(/\#.*$/,"");
8137: if ((caller == "search") || (currsrc == "'.$location.'")) {
8138: document.getElementById("'.$id.'").style.width = "auto";
8139: document.getElementById("'.$id.'").style.height = "auto";
8140: }
8141: }
8142: }
8143: } catch (e) {
8144: return;
8145: }
1.1137 raeburn 8146: }
1.1140 raeburn 8147: return;
1.996 www 8148: }
1.1140 raeburn 8149: ';
8150: }
8151: if ($needjsready) {
8152: $nicescroll_js = '
8153: <script type="text/javascript">'."\n".$nicescroll_js."\n</script>\n";
8154: } else {
8155: $nicescroll_js = &Apache::lonhtmlcommon::scripttag($nicescroll_js);
8156: }
8157: return $nicescroll_js;
1.996 www 8158: }
8159:
1.318 albertel 8160: sub simple_error_page {
1.1150 bisitz 8161: my ($r,$title,$msg,$args) = @_;
1.1151 raeburn 8162: if (ref($args) eq 'HASH') {
8163: if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
8164: } else {
8165: $msg = &mt($msg);
8166: }
1.1150 bisitz 8167:
1.318 albertel 8168: my $page =
8169: &Apache::loncommon::start_page($title).
1.1150 bisitz 8170: '<p class="LC_error">'.$msg.'</p>'.
1.318 albertel 8171: &Apache::loncommon::end_page();
8172: if (ref($r)) {
8173: $r->print($page);
1.327 albertel 8174: return;
1.318 albertel 8175: }
8176: return $page;
8177: }
1.347 albertel 8178:
8179: {
1.610 albertel 8180: my @row_count;
1.961 onken 8181:
8182: sub start_data_table_count {
8183: unshift(@row_count, 0);
8184: return;
8185: }
8186:
8187: sub end_data_table_count {
8188: shift(@row_count);
8189: return;
8190: }
8191:
1.347 albertel 8192: sub start_data_table {
1.1018 raeburn 8193: my ($add_class,$id) = @_;
1.422 albertel 8194: my $css_class = (join(' ','LC_data_table',$add_class));
1.1018 raeburn 8195: my $table_id;
8196: if (defined($id)) {
8197: $table_id = ' id="'.$id.'"';
8198: }
1.961 onken 8199: &start_data_table_count();
1.1018 raeburn 8200: return '<table class="'.$css_class.'"'.$table_id.'>'."\n";
1.347 albertel 8201: }
8202:
8203: sub end_data_table {
1.961 onken 8204: &end_data_table_count();
1.389 albertel 8205: return '</table>'."\n";;
1.347 albertel 8206: }
8207:
8208: sub start_data_table_row {
1.974 wenzelju 8209: my ($add_class, $id) = @_;
1.610 albertel 8210: $row_count[0]++;
8211: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.900 bisitz 8212: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
1.974 wenzelju 8213: $id = (' id="'.$id.'"') unless ($id eq '');
8214: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.347 albertel 8215: }
1.471 banghart 8216:
8217: sub continue_data_table_row {
1.974 wenzelju 8218: my ($add_class, $id) = @_;
1.610 albertel 8219: my $css_class = ($row_count[0] % 2)?'LC_odd_row':'LC_even_row';
1.974 wenzelju 8220: $css_class = (join(' ',$css_class,$add_class)) unless ($add_class eq '');
8221: $id = (' id="'.$id.'"') unless ($id eq '');
8222: return '<tr class="'.$css_class.'"'.$id.'>'."\n";
1.471 banghart 8223: }
1.347 albertel 8224:
8225: sub end_data_table_row {
1.389 albertel 8226: return '</tr>'."\n";;
1.347 albertel 8227: }
1.367 www 8228:
1.421 albertel 8229: sub start_data_table_empty_row {
1.707 bisitz 8230: # $row_count[0]++;
1.421 albertel 8231: return '<tr class="LC_empty_row" >'."\n";;
8232: }
8233:
8234: sub end_data_table_empty_row {
8235: return '</tr>'."\n";;
8236: }
8237:
1.367 www 8238: sub start_data_table_header_row {
1.389 albertel 8239: return '<tr class="LC_header_row">'."\n";;
1.367 www 8240: }
8241:
8242: sub end_data_table_header_row {
1.389 albertel 8243: return '</tr>'."\n";;
1.367 www 8244: }
1.890 droeschl 8245:
8246: sub data_table_caption {
8247: my $caption = shift;
8248: return "<caption class=\"LC_caption\">$caption</caption>";
8249: }
1.347 albertel 8250: }
8251:
1.548 albertel 8252: =pod
8253:
8254: =item * &inhibit_menu_check($arg)
8255:
8256: Checks for a inhibitmenu state and generates output to preserve it
8257:
8258: Inputs: $arg - can be any of
8259: - undef - in which case the return value is a string
8260: to add into arguments list of a uri
8261: - 'input' - in which case the return value is a HTML
8262: <form> <input> field of type hidden to
8263: preserve the value
8264: - a url - in which case the return value is the url with
8265: the neccesary cgi args added to preserve the
8266: inhibitmenu state
8267: - a ref to a url - no return value, but the string is
8268: updated to include the neccessary cgi
8269: args to preserve the inhibitmenu state
8270:
8271: =cut
8272:
8273: sub inhibit_menu_check {
8274: my ($arg) = @_;
8275: &get_unprocessed_cgi($ENV{'QUERY_STRING'}, ['inhibitmenu']);
8276: if ($arg eq 'input') {
8277: if ($env{'form.inhibitmenu'}) {
8278: return '<input type="hidden" name="inhibitmenu" value="'.$env{'form.inhibitmenu'}.'" />';
8279: } else {
8280: return
8281: }
8282: }
8283: if ($env{'form.inhibitmenu'}) {
8284: if (ref($arg)) {
8285: $$arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8286: } elsif ($arg eq '') {
8287: $arg .= 'inhibitmenu='.$env{'form.inhibitmenu'};
8288: } else {
8289: $arg .= '?inhibitmenu='.$env{'form.inhibitmenu'};
8290: }
8291: }
8292: if (!ref($arg)) {
8293: return $arg;
8294: }
8295: }
8296:
1.251 albertel 8297: ###############################################
1.182 matthew 8298:
8299: =pod
8300:
1.549 albertel 8301: =back
8302:
8303: =head1 User Information Routines
8304:
8305: =over 4
8306:
1.405 albertel 8307: =item * &get_users_function()
1.182 matthew 8308:
8309: Used by &bodytag to determine the current users primary role.
8310: Returns either 'student','coordinator','admin', or 'author'.
8311:
8312: =cut
8313:
8314: ###############################################
8315: sub get_users_function {
1.815 tempelho 8316: my $function = 'norole';
1.818 tempelho 8317: if ($env{'request.role'}=~/^(st)/) {
8318: $function='student';
8319: }
1.907 raeburn 8320: if ($env{'request.role'}=~/^(cc|co|in|ta|ep)/) {
1.182 matthew 8321: $function='coordinator';
8322: }
1.258 albertel 8323: if ($env{'request.role'}=~/^(su|dc|ad|li)/) {
1.182 matthew 8324: $function='admin';
8325: }
1.826 bisitz 8326: if (($env{'request.role'}=~/^(au|ca|aa)/) ||
1.1025 raeburn 8327: ($ENV{'REQUEST_URI'}=~ m{/^(/priv)})) {
1.182 matthew 8328: $function='author';
8329: }
8330: return $function;
1.54 www 8331: }
1.99 www 8332:
8333: ###############################################
8334:
1.233 raeburn 8335: =pod
8336:
1.821 raeburn 8337: =item * &show_course()
8338:
8339: Used by lonmenu.pm and lonroles.pm to determine whether to use the word
8340: 'Courses' or 'Roles' in inline navigation and on screen displaying user's roles.
8341:
8342: Inputs:
8343: None
8344:
8345: Outputs:
8346: Scalar: 1 if 'Course' to be used, 0 otherwise.
8347:
8348: =cut
8349:
8350: ###############################################
8351: sub show_course {
8352: my $course = !$env{'user.adv'};
8353: if (!$env{'user.adv'}) {
8354: foreach my $env (keys(%env)) {
8355: next if ($env !~ m/^user\.priv\./);
8356: if ($env !~ m/^user\.priv\.(?:st|cm)/) {
8357: $course = 0;
8358: last;
8359: }
8360: }
8361: }
8362: return $course;
8363: }
8364:
8365: ###############################################
8366:
8367: =pod
8368:
1.542 raeburn 8369: =item * &check_user_status()
1.274 raeburn 8370:
8371: Determines current status of supplied role for a
8372: specific user. Roles can be active, previous or future.
8373:
8374: Inputs:
8375: user's domain, user's username, course's domain,
1.375 raeburn 8376: course's number, optional section ID.
1.274 raeburn 8377:
8378: Outputs:
8379: role status: active, previous or future.
8380:
8381: =cut
8382:
8383: sub check_user_status {
1.412 raeburn 8384: my ($udom,$uname,$cdom,$crs,$role,$sec) = @_;
1.1073 raeburn 8385: my %userinfo = &Apache::lonnet::dump('roles',$udom,$uname);
1.274 raeburn 8386: my @uroles = keys %userinfo;
8387: my $srchstr;
8388: my $active_chk = 'none';
1.412 raeburn 8389: my $now = time;
1.274 raeburn 8390: if (@uroles > 0) {
1.908 raeburn 8391: if (($role eq 'cc') || ($role eq 'co') || ($sec eq '') || (!defined($sec))) {
1.274 raeburn 8392: $srchstr = '/'.$cdom.'/'.$crs.'_'.$role;
8393: } else {
1.412 raeburn 8394: $srchstr = '/'.$cdom.'/'.$crs.'/'.$sec.'_'.$role;
8395: }
8396: if (grep/^\Q$srchstr\E$/,@uroles) {
1.274 raeburn 8397: my $role_end = 0;
8398: my $role_start = 0;
8399: $active_chk = 'active';
1.412 raeburn 8400: if ($userinfo{$srchstr} =~ m/^\Q$role\E_(\d+)/) {
8401: $role_end = $1;
8402: if ($userinfo{$srchstr} =~ m/^\Q$role\E_\Q$role_end\E_(\d+)$/) {
8403: $role_start = $1;
1.274 raeburn 8404: }
8405: }
8406: if ($role_start > 0) {
1.412 raeburn 8407: if ($now < $role_start) {
1.274 raeburn 8408: $active_chk = 'future';
8409: }
8410: }
8411: if ($role_end > 0) {
1.412 raeburn 8412: if ($now > $role_end) {
1.274 raeburn 8413: $active_chk = 'previous';
8414: }
8415: }
8416: }
8417: }
8418: return $active_chk;
8419: }
8420:
8421: ###############################################
8422:
8423: =pod
8424:
1.405 albertel 8425: =item * &get_sections()
1.233 raeburn 8426:
8427: Determines all the sections for a course including
8428: sections with students and sections containing other roles.
1.419 raeburn 8429: Incoming parameters:
8430:
8431: 1. domain
8432: 2. course number
8433: 3. reference to array containing roles for which sections should
8434: be gathered (optional).
8435: 4. reference to array containing status types for which sections
8436: should be gathered (optional).
8437:
8438: If the third argument is undefined, sections are gathered for any role.
8439: If the fourth argument is undefined, sections are gathered for any status.
8440: Permissible values are 'active' or 'future' or 'previous'.
1.233 raeburn 8441:
1.374 raeburn 8442: Returns section hash (keys are section IDs, values are
8443: number of users in each section), subject to the
1.419 raeburn 8444: optional roles filter, optional status filter
1.233 raeburn 8445:
8446: =cut
8447:
8448: ###############################################
8449: sub get_sections {
1.419 raeburn 8450: my ($cdom,$cnum,$possible_roles,$possible_status) = @_;
1.366 albertel 8451: if (!defined($cdom) || !defined($cnum)) {
8452: my $cid = $env{'request.course.id'};
8453:
8454: return if (!defined($cid));
8455:
8456: $cdom = $env{'course.'.$cid.'.domain'};
8457: $cnum = $env{'course.'.$cid.'.num'};
8458: }
8459:
8460: my %sectioncount;
1.419 raeburn 8461: my $now = time;
1.240 albertel 8462:
1.1118 raeburn 8463: my $check_students = 1;
8464: my $only_students = 0;
8465: if (ref($possible_roles) eq 'ARRAY') {
8466: if (grep(/^st$/,@{$possible_roles})) {
8467: if (@{$possible_roles} == 1) {
8468: $only_students = 1;
8469: }
8470: } else {
8471: $check_students = 0;
8472: }
8473: }
8474:
8475: if ($check_students) {
1.276 albertel 8476: my ($classlist) = &Apache::loncoursedata::get_classlist($cdom,$cnum);
1.240 albertel 8477: my $sec_index = &Apache::loncoursedata::CL_SECTION();
8478: my $status_index = &Apache::loncoursedata::CL_STATUS();
1.419 raeburn 8479: my $start_index = &Apache::loncoursedata::CL_START();
8480: my $end_index = &Apache::loncoursedata::CL_END();
8481: my $status;
1.366 albertel 8482: while (my ($student,$data) = each(%$classlist)) {
1.419 raeburn 8483: my ($section,$stu_status,$start,$end) = ($data->[$sec_index],
8484: $data->[$status_index],
8485: $data->[$start_index],
8486: $data->[$end_index]);
8487: if ($stu_status eq 'Active') {
8488: $status = 'active';
8489: } elsif ($end < $now) {
8490: $status = 'previous';
8491: } elsif ($start > $now) {
8492: $status = 'future';
8493: }
8494: if ($section ne '-1' && $section !~ /^\s*$/) {
8495: if ((!defined($possible_status)) || (($status ne '') &&
8496: (grep/^\Q$status\E$/,@{$possible_status}))) {
8497: $sectioncount{$section}++;
8498: }
1.240 albertel 8499: }
8500: }
8501: }
1.1118 raeburn 8502: if ($only_students) {
8503: return %sectioncount;
8504: }
1.240 albertel 8505: my %courseroles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8506: foreach my $user (sort(keys(%courseroles))) {
8507: if ($user !~ /^(\w{2})/) { next; }
8508: my ($role) = ($user =~ /^(\w{2})/);
8509: if ($possible_roles && !(grep(/^$role$/,@$possible_roles))) { next; }
1.419 raeburn 8510: my ($section,$status);
1.240 albertel 8511: if ($role eq 'cr' &&
8512: $user =~ m-^$role/[^/]*/[^/]*/[^/]*:[^:]*:[^:]*:(\w+)-) {
8513: $section=$1;
8514: }
8515: if ($user =~ /^$role:[^:]*:[^:]*:(\w+)/) { $section=$1; }
8516: if (!defined($section) || $section eq '-1') { next; }
1.419 raeburn 8517: my ($end,$start) = ($courseroles{$user} =~ /^([^:]*):([^:]*)$/);
8518: if ($end == -1 && $start == -1) {
8519: next; #deleted role
8520: }
8521: if (!defined($possible_status)) {
8522: $sectioncount{$section}++;
8523: } else {
8524: if ((!$end || $end >= $now) && (!$start || $start <= $now)) {
8525: $status = 'active';
8526: } elsif ($end < $now) {
8527: $status = 'future';
8528: } elsif ($start > $now) {
8529: $status = 'previous';
8530: }
8531: if (($status ne '') && (grep/^\Q$status\E$/,@{$possible_status})) {
8532: $sectioncount{$section}++;
8533: }
8534: }
1.233 raeburn 8535: }
1.366 albertel 8536: return %sectioncount;
1.233 raeburn 8537: }
8538:
1.274 raeburn 8539: ###############################################
1.294 raeburn 8540:
8541: =pod
1.405 albertel 8542:
8543: =item * &get_course_users()
8544:
1.275 raeburn 8545: Retrieves usernames:domains for users in the specified course
8546: with specific role(s), and access status.
8547:
8548: Incoming parameters:
1.277 albertel 8549: 1. course domain
8550: 2. course number
8551: 3. access status: users must have - either active,
1.275 raeburn 8552: previous, future, or all.
1.277 albertel 8553: 4. reference to array of permissible roles
1.288 raeburn 8554: 5. reference to array of section restrictions (optional)
8555: 6. reference to results object (hash of hashes).
8556: 7. reference to optional userdata hash
1.609 raeburn 8557: 8. reference to optional statushash
1.630 raeburn 8558: 9. flag if privileged users (except those set to unhide in
8559: course settings) should be excluded
1.609 raeburn 8560: Keys of top level results hash are roles.
1.275 raeburn 8561: Keys of inner hashes are username:domain, with
8562: values set to access type.
1.288 raeburn 8563: Optional userdata hash returns an array with arguments in the
8564: same order as loncoursedata::get_classlist() for student data.
8565:
1.609 raeburn 8566: Optional statushash returns
8567:
1.288 raeburn 8568: Entries for end, start, section and status are blank because
8569: of the possibility of multiple values for non-student roles.
8570:
1.275 raeburn 8571: =cut
1.405 albertel 8572:
1.275 raeburn 8573: ###############################################
1.405 albertel 8574:
1.275 raeburn 8575: sub get_course_users {
1.630 raeburn 8576: my ($cdom,$cnum,$types,$roles,$sections,$users,$userdata,$statushash,$hidepriv) = @_;
1.288 raeburn 8577: my %idx = ();
1.419 raeburn 8578: my %seclists;
1.288 raeburn 8579:
8580: $idx{udom} = &Apache::loncoursedata::CL_SDOM();
8581: $idx{uname} = &Apache::loncoursedata::CL_SNAME();
8582: $idx{end} = &Apache::loncoursedata::CL_END();
8583: $idx{start} = &Apache::loncoursedata::CL_START();
8584: $idx{id} = &Apache::loncoursedata::CL_ID();
8585: $idx{section} = &Apache::loncoursedata::CL_SECTION();
8586: $idx{fullname} = &Apache::loncoursedata::CL_FULLNAME();
8587: $idx{status} = &Apache::loncoursedata::CL_STATUS();
8588:
1.290 albertel 8589: if (grep(/^st$/,@{$roles})) {
1.276 albertel 8590: my ($classlist,$keylist)=&Apache::loncoursedata::get_classlist($cdom,$cnum);
1.278 raeburn 8591: my $now = time;
1.277 albertel 8592: foreach my $student (keys(%{$classlist})) {
1.288 raeburn 8593: my $match = 0;
1.412 raeburn 8594: my $secmatch = 0;
1.419 raeburn 8595: my $section = $$classlist{$student}[$idx{section}];
1.609 raeburn 8596: my $status = $$classlist{$student}[$idx{status}];
1.419 raeburn 8597: if ($section eq '') {
8598: $section = 'none';
8599: }
1.291 albertel 8600: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8601: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8602: $secmatch = 1;
8603: } elsif ($$classlist{$student}[$idx{section}] eq '') {
1.420 albertel 8604: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8605: $secmatch = 1;
8606: }
8607: } else {
1.419 raeburn 8608: if (grep(/^\Q$section\E$/,@{$sections})) {
1.412 raeburn 8609: $secmatch = 1;
8610: }
1.290 albertel 8611: }
1.412 raeburn 8612: if (!$secmatch) {
8613: next;
8614: }
1.419 raeburn 8615: }
1.275 raeburn 8616: if (defined($$types{'active'})) {
1.288 raeburn 8617: if ($$classlist{$student}[$idx{status}] eq 'Active') {
1.275 raeburn 8618: push(@{$$users{st}{$student}},'active');
1.288 raeburn 8619: $match = 1;
1.275 raeburn 8620: }
8621: }
8622: if (defined($$types{'previous'})) {
1.609 raeburn 8623: if ($$classlist{$student}[$idx{status}] eq 'Expired') {
1.275 raeburn 8624: push(@{$$users{st}{$student}},'previous');
1.288 raeburn 8625: $match = 1;
1.275 raeburn 8626: }
8627: }
8628: if (defined($$types{'future'})) {
1.609 raeburn 8629: if ($$classlist{$student}[$idx{status}] eq 'Future') {
1.275 raeburn 8630: push(@{$$users{st}{$student}},'future');
1.288 raeburn 8631: $match = 1;
1.275 raeburn 8632: }
8633: }
1.609 raeburn 8634: if ($match) {
8635: push(@{$seclists{$student}},$section);
8636: if (ref($userdata) eq 'HASH') {
8637: $$userdata{$student} = $$classlist{$student};
8638: }
8639: if (ref($statushash) eq 'HASH') {
8640: $statushash->{$student}{'st'}{$section} = $status;
8641: }
1.288 raeburn 8642: }
1.275 raeburn 8643: }
8644: }
1.412 raeburn 8645: if ((@{$roles} > 1) || ((@{$roles} == 1) && ($$roles[0] ne "st"))) {
1.439 raeburn 8646: my %coursepersonnel = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
8647: my $now = time;
1.609 raeburn 8648: my %displaystatus = ( previous => 'Expired',
8649: active => 'Active',
8650: future => 'Future',
8651: );
1.1121 raeburn 8652: my (%nothide,@possdoms);
1.630 raeburn 8653: if ($hidepriv) {
8654: my %coursehash=&Apache::lonnet::coursedescription($cdom.'_'.$cnum);
8655: foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
8656: if ($user !~ /:/) {
8657: $nothide{join(':',split(/[\@]/,$user))}=1;
8658: } else {
8659: $nothide{$user} = 1;
8660: }
8661: }
1.1121 raeburn 8662: my @possdoms = ($cdom);
8663: if ($coursehash{'checkforpriv'}) {
8664: push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
8665: }
1.630 raeburn 8666: }
1.439 raeburn 8667: foreach my $person (sort(keys(%coursepersonnel))) {
1.288 raeburn 8668: my $match = 0;
1.412 raeburn 8669: my $secmatch = 0;
1.439 raeburn 8670: my $status;
1.412 raeburn 8671: my ($role,$user,$usec) = ($person =~ /^([^:]*):([^:]+:[^:]+):([^:]*)/);
1.275 raeburn 8672: $user =~ s/:$//;
1.439 raeburn 8673: my ($end,$start) = split(/:/,$coursepersonnel{$person});
8674: if ($end == -1 || $start == -1) {
8675: next;
8676: }
8677: if (($role) && ((grep(/^\Q$role\E$/,@{$roles})) ||
8678: (grep(/^cr$/,@{$roles}) && $role =~ /^cr\//))) {
1.412 raeburn 8679: my ($uname,$udom) = split(/:/,$user);
8680: if ((ref($sections) eq 'ARRAY') && (@{$sections} > 0)) {
1.420 albertel 8681: if (grep(/^all$/,@{$sections})) {
1.412 raeburn 8682: $secmatch = 1;
8683: } elsif ($usec eq '') {
1.420 albertel 8684: if (grep(/^none$/,@{$sections})) {
1.412 raeburn 8685: $secmatch = 1;
8686: }
8687: } else {
8688: if (grep(/^\Q$usec\E$/,@{$sections})) {
8689: $secmatch = 1;
8690: }
8691: }
8692: if (!$secmatch) {
8693: next;
8694: }
1.288 raeburn 8695: }
1.419 raeburn 8696: if ($usec eq '') {
8697: $usec = 'none';
8698: }
1.275 raeburn 8699: if ($uname ne '' && $udom ne '') {
1.630 raeburn 8700: if ($hidepriv) {
1.1121 raeburn 8701: if ((&Apache::lonnet::privileged($uname,$udom,\@possdoms)) &&
1.630 raeburn 8702: (!$nothide{$uname.':'.$udom})) {
8703: next;
8704: }
8705: }
1.503 raeburn 8706: if ($end > 0 && $end < $now) {
1.439 raeburn 8707: $status = 'previous';
8708: } elsif ($start > $now) {
8709: $status = 'future';
8710: } else {
8711: $status = 'active';
8712: }
1.277 albertel 8713: foreach my $type (keys(%{$types})) {
1.275 raeburn 8714: if ($status eq $type) {
1.420 albertel 8715: if (!grep(/^\Q$type\E$/,@{$$users{$role}{$user}})) {
1.419 raeburn 8716: push(@{$$users{$role}{$user}},$type);
8717: }
1.288 raeburn 8718: $match = 1;
8719: }
8720: }
1.419 raeburn 8721: if (($match) && (ref($userdata) eq 'HASH')) {
8722: if (!exists($$userdata{$uname.':'.$udom})) {
8723: &get_user_info($udom,$uname,\%idx,$userdata);
8724: }
1.420 albertel 8725: if (!grep(/^\Q$usec\E$/,@{$seclists{$uname.':'.$udom}})) {
1.419 raeburn 8726: push(@{$seclists{$uname.':'.$udom}},$usec);
8727: }
1.609 raeburn 8728: if (ref($statushash) eq 'HASH') {
8729: $statushash->{$uname.':'.$udom}{$role}{$usec} = $displaystatus{$status};
8730: }
1.275 raeburn 8731: }
8732: }
8733: }
8734: }
1.290 albertel 8735: if (grep(/^ow$/,@{$roles})) {
1.279 raeburn 8736: if ((defined($cdom)) && (defined($cnum))) {
8737: my %csettings = &Apache::lonnet::get('environment',['internal.courseowner'],$cdom,$cnum);
8738: if ( defined($csettings{'internal.courseowner'}) ) {
8739: my $owner = $csettings{'internal.courseowner'};
1.609 raeburn 8740: next if ($owner eq '');
8741: my ($ownername,$ownerdom);
8742: if ($owner =~ /^([^:]+):([^:]+)$/) {
8743: $ownername = $1;
8744: $ownerdom = $2;
8745: } else {
8746: $ownername = $owner;
8747: $ownerdom = $cdom;
8748: $owner = $ownername.':'.$ownerdom;
1.439 raeburn 8749: }
8750: @{$$users{'ow'}{$owner}} = 'any';
1.290 albertel 8751: if (defined($userdata) &&
1.609 raeburn 8752: !exists($$userdata{$owner})) {
8753: &get_user_info($ownerdom,$ownername,\%idx,$userdata);
8754: if (!grep(/^none$/,@{$seclists{$owner}})) {
8755: push(@{$seclists{$owner}},'none');
8756: }
8757: if (ref($statushash) eq 'HASH') {
8758: $statushash->{$owner}{'ow'}{'none'} = 'Any';
1.419 raeburn 8759: }
1.290 albertel 8760: }
1.279 raeburn 8761: }
8762: }
8763: }
1.419 raeburn 8764: foreach my $user (keys(%seclists)) {
8765: @{$seclists{$user}} = (sort {$a <=> $b} @{$seclists{$user}});
8766: $$userdata{$user}[$idx{section}] = join(',',@{$seclists{$user}});
8767: }
1.275 raeburn 8768: }
8769: return;
8770: }
8771:
1.288 raeburn 8772: sub get_user_info {
8773: my ($udom,$uname,$idx,$userdata) = @_;
1.289 albertel 8774: $$userdata{$uname.':'.$udom}[$$idx{fullname}] =
8775: &plainname($uname,$udom,'lastname');
1.291 albertel 8776: $$userdata{$uname.':'.$udom}[$$idx{uname}] = $uname;
1.297 raeburn 8777: $$userdata{$uname.':'.$udom}[$$idx{udom}] = $udom;
1.609 raeburn 8778: my %idhash = &Apache::lonnet::idrget($udom,($uname));
8779: $$userdata{$uname.':'.$udom}[$$idx{id}] = $idhash{$uname};
1.288 raeburn 8780: return;
8781: }
1.275 raeburn 8782:
1.472 raeburn 8783: ###############################################
8784:
8785: =pod
8786:
8787: =item * &get_user_quota()
8788:
1.1134 raeburn 8789: Retrieves quota assigned for storage of user files.
8790: Default is to report quota for portfolio files.
1.472 raeburn 8791:
8792: Incoming parameters:
8793: 1. user's username
8794: 2. user's domain
1.1134 raeburn 8795: 3. quota name - portfolio, author, or course
1.1136 raeburn 8796: (if no quota name provided, defaults to portfolio).
1.1165 raeburn 8797: 4. crstype - official, unofficial, textbook or community, if quota name is
1.1136 raeburn 8798: course
1.472 raeburn 8799:
8800: Returns:
1.1163 raeburn 8801: 1. Disk quota (in MB) assigned to student.
1.536 raeburn 8802: 2. (Optional) Type of setting: custom or default
8803: (individually assigned or default for user's
8804: institutional status).
8805: 3. (Optional) - User's institutional status (e.g., faculty, staff
8806: or student - types as defined in localenroll::inst_usertypes
8807: for user's domain, which determines default quota for user.
8808: 4. (Optional) - Default quota which would apply to the user.
1.472 raeburn 8809:
8810: If a value has been stored in the user's environment,
1.536 raeburn 8811: it will return that, otherwise it returns the maximal default
1.1134 raeburn 8812: defined for the user's institutional status(es) in the domain.
1.472 raeburn 8813:
8814: =cut
8815:
8816: ###############################################
8817:
8818:
8819: sub get_user_quota {
1.1136 raeburn 8820: my ($uname,$udom,$quotaname,$crstype) = @_;
1.536 raeburn 8821: my ($quota,$quotatype,$settingstatus,$defquota);
1.472 raeburn 8822: if (!defined($udom)) {
8823: $udom = $env{'user.domain'};
8824: }
8825: if (!defined($uname)) {
8826: $uname = $env{'user.name'};
8827: }
8828: if (($udom eq '' || $uname eq '') ||
8829: ($udom eq 'public') && ($uname eq 'public')) {
8830: $quota = 0;
1.536 raeburn 8831: $quotatype = 'default';
8832: $defquota = 0;
1.472 raeburn 8833: } else {
1.536 raeburn 8834: my $inststatus;
1.1134 raeburn 8835: if ($quotaname eq 'course') {
8836: if (($env{'course.'.$udom.'_'.$uname.'.num'} eq $uname) &&
8837: ($env{'course.'.$udom.'_'.$uname.'.domain'} eq $udom)) {
8838: $quota = $env{'course.'.$udom.'_'.$uname.'.internal.uploadquota'};
8839: } else {
8840: my %cenv = &Apache::lonnet::coursedescription("$udom/$uname");
8841: $quota = $cenv{'internal.uploadquota'};
8842: }
1.536 raeburn 8843: } else {
1.1134 raeburn 8844: if ($udom eq $env{'user.domain'} && $uname eq $env{'user.name'}) {
8845: if ($quotaname eq 'author') {
8846: $quota = $env{'environment.authorquota'};
8847: } else {
8848: $quota = $env{'environment.portfolioquota'};
8849: }
8850: $inststatus = $env{'environment.inststatus'};
8851: } else {
8852: my %userenv =
8853: &Apache::lonnet::get('environment',['portfolioquota',
8854: 'authorquota','inststatus'],$udom,$uname);
8855: my ($tmp) = keys(%userenv);
8856: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
8857: if ($quotaname eq 'author') {
8858: $quota = $userenv{'authorquota'};
8859: } else {
8860: $quota = $userenv{'portfolioquota'};
8861: }
8862: $inststatus = $userenv{'inststatus'};
8863: } else {
8864: undef(%userenv);
8865: }
8866: }
8867: }
8868: if ($quota eq '' || wantarray) {
8869: if ($quotaname eq 'course') {
8870: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
1.1165 raeburn 8871: if (($crstype eq 'official') || ($crstype eq 'unofficial') ||
8872: ($crstype eq 'community') || ($crstype eq 'textbook')) {
1.1136 raeburn 8873: $defquota = $domdefs{$crstype.'quota'};
8874: }
8875: if ($defquota eq '') {
8876: $defquota = 500;
8877: }
1.1134 raeburn 8878: } else {
8879: ($defquota,$settingstatus) = &default_quota($udom,$inststatus,$quotaname);
8880: }
8881: if ($quota eq '') {
8882: $quota = $defquota;
8883: $quotatype = 'default';
8884: } else {
8885: $quotatype = 'custom';
8886: }
1.472 raeburn 8887: }
8888: }
1.536 raeburn 8889: if (wantarray) {
8890: return ($quota,$quotatype,$settingstatus,$defquota);
8891: } else {
8892: return $quota;
8893: }
1.472 raeburn 8894: }
8895:
8896: ###############################################
8897:
8898: =pod
8899:
8900: =item * &default_quota()
8901:
1.536 raeburn 8902: Retrieves default quota assigned for storage of user portfolio files,
8903: given an (optional) user's institutional status.
1.472 raeburn 8904:
8905: Incoming parameters:
1.1142 raeburn 8906:
1.472 raeburn 8907: 1. domain
1.536 raeburn 8908: 2. (Optional) institutional status(es). This is a : separated list of
8909: status types (e.g., faculty, staff, student etc.)
8910: which apply to the user for whom the default is being retrieved.
8911: If the institutional status string in undefined, the domain
1.1134 raeburn 8912: default quota will be returned.
8913: 3. quota name - portfolio, author, or course
8914: (if no quota name provided, defaults to portfolio).
1.472 raeburn 8915:
8916: Returns:
1.1142 raeburn 8917:
1.1163 raeburn 8918: 1. Default disk quota (in MB) for user portfolios in the domain.
1.536 raeburn 8919: 2. (Optional) institutional type which determined the value of the
8920: default quota.
1.472 raeburn 8921:
8922: If a value has been stored in the domain's configuration db,
8923: it will return that, otherwise it returns 20 (for backwards
8924: compatibility with domains which have not set up a configuration
1.1163 raeburn 8925: db file; the original statically defined portfolio quota was 20 MB).
1.472 raeburn 8926:
1.536 raeburn 8927: If the user's status includes multiple types (e.g., staff and student),
8928: the largest default quota which applies to the user determines the
8929: default quota returned.
8930:
1.472 raeburn 8931: =cut
8932:
8933: ###############################################
8934:
8935:
8936: sub default_quota {
1.1134 raeburn 8937: my ($udom,$inststatus,$quotaname) = @_;
1.536 raeburn 8938: my ($defquota,$settingstatus);
8939: my %quotahash = &Apache::lonnet::get_dom('configuration',
1.622 raeburn 8940: ['quotas'],$udom);
1.1134 raeburn 8941: my $key = 'defaultquota';
8942: if ($quotaname eq 'author') {
8943: $key = 'authorquota';
8944: }
1.622 raeburn 8945: if (ref($quotahash{'quotas'}) eq 'HASH') {
1.536 raeburn 8946: if ($inststatus ne '') {
1.765 raeburn 8947: my @statuses = map { &unescape($_); } split(/:/,$inststatus);
1.536 raeburn 8948: foreach my $item (@statuses) {
1.1134 raeburn 8949: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8950: if ($quotahash{'quotas'}{$key}{$item} ne '') {
1.711 raeburn 8951: if ($defquota eq '') {
1.1134 raeburn 8952: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8953: $settingstatus = $item;
1.1134 raeburn 8954: } elsif ($quotahash{'quotas'}{$key}{$item} > $defquota) {
8955: $defquota = $quotahash{'quotas'}{$key}{$item};
1.711 raeburn 8956: $settingstatus = $item;
8957: }
8958: }
1.1134 raeburn 8959: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8960: if ($quotahash{'quotas'}{$item} ne '') {
8961: if ($defquota eq '') {
8962: $defquota = $quotahash{'quotas'}{$item};
8963: $settingstatus = $item;
8964: } elsif ($quotahash{'quotas'}{$item} > $defquota) {
8965: $defquota = $quotahash{'quotas'}{$item};
8966: $settingstatus = $item;
8967: }
1.536 raeburn 8968: }
8969: }
8970: }
8971: }
8972: if ($defquota eq '') {
1.1134 raeburn 8973: if (ref($quotahash{'quotas'}{$key}) eq 'HASH') {
8974: $defquota = $quotahash{'quotas'}{$key}{'default'};
8975: } elsif ($key eq 'defaultquota') {
1.711 raeburn 8976: $defquota = $quotahash{'quotas'}{'default'};
8977: }
1.536 raeburn 8978: $settingstatus = 'default';
1.1139 raeburn 8979: if ($defquota eq '') {
8980: if ($quotaname eq 'author') {
8981: $defquota = 500;
8982: }
8983: }
1.536 raeburn 8984: }
8985: } else {
8986: $settingstatus = 'default';
1.1134 raeburn 8987: if ($quotaname eq 'author') {
8988: $defquota = 500;
8989: } else {
8990: $defquota = 20;
8991: }
1.536 raeburn 8992: }
8993: if (wantarray) {
8994: return ($defquota,$settingstatus);
1.472 raeburn 8995: } else {
1.536 raeburn 8996: return $defquota;
1.472 raeburn 8997: }
8998: }
8999:
1.1135 raeburn 9000: ###############################################
9001:
9002: =pod
9003:
1.1136 raeburn 9004: =item * &excess_filesize_warning()
1.1135 raeburn 9005:
9006: Returns warning message if upload of file to authoring space, or copying
1.1136 raeburn 9007: of existing file within authoring space will cause quota for the authoring
1.1146 raeburn 9008: space to be exceeded.
1.1136 raeburn 9009:
9010: Same, if upload of a file directly to a course/community via Course Editor
1.1137 raeburn 9011: will cause quota for uploaded content for the course to be exceeded.
1.1135 raeburn 9012:
1.1165 raeburn 9013: Inputs: 7
1.1136 raeburn 9014: 1. username or coursenum
1.1135 raeburn 9015: 2. domain
1.1136 raeburn 9016: 3. context ('author' or 'course')
1.1135 raeburn 9017: 4. filename of file for which action is being requested
9018: 5. filesize (kB) of file
9019: 6. action being taken: copy or upload.
1.1165 raeburn 9020: 7. quotatype (in course context -- official, unofficial, community or textbook).
1.1135 raeburn 9021:
9022: Returns: 1 scalar: HTML to display containing warning if quota would be exceeded,
1.1142 raeburn 9023: otherwise return null.
9024:
9025: =back
1.1135 raeburn 9026:
9027: =cut
9028:
1.1136 raeburn 9029: sub excess_filesize_warning {
1.1165 raeburn 9030: my ($uname,$udom,$context,$filename,$filesize,$action,$quotatype) = @_;
1.1136 raeburn 9031: my $current_disk_usage = 0;
1.1165 raeburn 9032: my $disk_quota = &get_user_quota($uname,$udom,$context,$quotatype); #expressed in MB
1.1136 raeburn 9033: if ($context eq 'author') {
9034: my $authorspace = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname";
9035: $current_disk_usage = &Apache::lonnet::diskusage($udom,$uname,$authorspace);
9036: } else {
9037: foreach my $subdir ('docs','supplemental') {
9038: $current_disk_usage += &Apache::lonnet::diskusage($udom,$uname,"userfiles/$subdir",1);
9039: }
9040: }
1.1135 raeburn 9041: $disk_quota = int($disk_quota * 1000);
9042: if (($current_disk_usage + $filesize) > $disk_quota) {
1.1179 bisitz 9043: return '<p class="LC_warning">'.
1.1135 raeburn 9044: &mt("Unable to $action [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.",
1.1179 bisitz 9045: '<span class="LC_filename">'.$filename.'</span>',$filesize).'</p>'.
9046: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
1.1135 raeburn 9047: $disk_quota,$current_disk_usage).
9048: '</p>';
9049: }
9050: return;
9051: }
9052:
9053: ###############################################
9054:
9055:
1.1136 raeburn 9056:
9057:
1.384 raeburn 9058: sub get_secgrprole_info {
9059: my ($cdom,$cnum,$needroles,$type) = @_;
9060: my %sections_count = &get_sections($cdom,$cnum);
9061: my @sections = (sort {$a <=> $b} keys(%sections_count));
9062: my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum);
9063: my @groups = sort(keys(%curr_groups));
9064: my $allroles = [];
9065: my $rolehash;
9066: my $accesshash = {
9067: active => 'Currently has access',
9068: future => 'Will have future access',
9069: previous => 'Previously had access',
9070: };
9071: if ($needroles) {
9072: $rolehash = {'all' => 'all'};
1.385 albertel 9073: my %user_roles = &Apache::lonnet::dump('nohist_userroles',$cdom,$cnum);
9074: if (&Apache::lonnet::error(%user_roles)) {
9075: undef(%user_roles);
9076: }
9077: foreach my $item (keys(%user_roles)) {
1.384 raeburn 9078: my ($role)=split(/\:/,$item,2);
9079: if ($role eq 'cr') { next; }
9080: if ($role =~ /^cr/) {
9081: $$rolehash{$role} = (split('/',$role))[3];
9082: } else {
9083: $$rolehash{$role} = &Apache::lonnet::plaintext($role,$type);
9084: }
9085: }
9086: foreach my $key (sort(keys(%{$rolehash}))) {
9087: push(@{$allroles},$key);
9088: }
9089: push (@{$allroles},'st');
9090: $$rolehash{'st'} = &Apache::lonnet::plaintext('st',$type);
9091: }
9092: return (\@sections,\@groups,$allroles,$rolehash,$accesshash);
9093: }
9094:
1.555 raeburn 9095: sub user_picker {
1.994 raeburn 9096: my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
1.555 raeburn 9097: my $currdom = $dom;
9098: my %curr_selected = (
9099: srchin => 'dom',
1.580 raeburn 9100: srchby => 'lastname',
1.555 raeburn 9101: );
9102: my $srchterm;
1.625 raeburn 9103: if ((ref($srch) eq 'HASH') && ($env{'form.origform'} ne 'crtusername')) {
1.555 raeburn 9104: if ($srch->{'srchby'} ne '') {
9105: $curr_selected{'srchby'} = $srch->{'srchby'};
9106: }
9107: if ($srch->{'srchin'} ne '') {
9108: $curr_selected{'srchin'} = $srch->{'srchin'};
9109: }
9110: if ($srch->{'srchtype'} ne '') {
9111: $curr_selected{'srchtype'} = $srch->{'srchtype'};
9112: }
9113: if ($srch->{'srchdomain'} ne '') {
9114: $currdom = $srch->{'srchdomain'};
9115: }
9116: $srchterm = $srch->{'srchterm'};
9117: }
9118: my %lt=&Apache::lonlocal::texthash(
1.573 raeburn 9119: 'usr' => 'Search criteria',
1.563 raeburn 9120: 'doma' => 'Domain/institution to search',
1.558 albertel 9121: 'uname' => 'username',
9122: 'lastname' => 'last name',
1.555 raeburn 9123: 'lastfirst' => 'last name, first name',
1.558 albertel 9124: 'crs' => 'in this course',
1.576 raeburn 9125: 'dom' => 'in selected LON-CAPA domain',
1.558 albertel 9126: 'alc' => 'all LON-CAPA',
1.573 raeburn 9127: 'instd' => 'in institutional directory for selected domain',
1.558 albertel 9128: 'exact' => 'is',
9129: 'contains' => 'contains',
1.569 raeburn 9130: 'begins' => 'begins with',
1.571 raeburn 9131: 'youm' => "You must include some text to search for.",
9132: 'thte' => "The text you are searching for must contain at least two characters when using a 'begins' type search.",
9133: 'thet' => "The text you are searching for must contain at least three characters when using a 'contains' type search.",
9134: 'yomc' => "You must choose a domain when using an institutional directory search.",
9135: 'ymcd' => "You must choose a domain when using a domain search.",
9136: 'whus' => "When using searching by last,first you must include a comma as separator between last name and first name.",
9137: 'whse' => "When searching by last,first you must include at least one character in the first name.",
9138: 'thfo' => "The following need to be corrected before the search can be run:",
1.555 raeburn 9139: );
1.563 raeburn 9140: my $domform = &select_dom_form($currdom,'srchdomain',1,1);
9141: my $srchinsel = ' <select name="srchin">';
1.555 raeburn 9142:
9143: my @srchins = ('crs','dom','alc','instd');
9144:
9145: foreach my $option (@srchins) {
9146: # FIXME 'alc' option unavailable until
9147: # loncreateuser::print_user_query_page()
9148: # has been completed.
9149: next if ($option eq 'alc');
1.880 raeburn 9150: next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
1.555 raeburn 9151: next if ($option eq 'crs' && !$env{'request.course.id'});
1.563 raeburn 9152: if ($curr_selected{'srchin'} eq $option) {
9153: $srchinsel .= '
9154: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9155: } else {
9156: $srchinsel .= '
9157: <option value="'.$option.'">'.$lt{$option}.'</option>';
9158: }
1.555 raeburn 9159: }
1.563 raeburn 9160: $srchinsel .= "\n </select>\n";
1.555 raeburn 9161:
9162: my $srchbysel = ' <select name="srchby">';
1.580 raeburn 9163: foreach my $option ('lastname','lastfirst','uname') {
1.555 raeburn 9164: if ($curr_selected{'srchby'} eq $option) {
9165: $srchbysel .= '
9166: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9167: } else {
9168: $srchbysel .= '
9169: <option value="'.$option.'">'.$lt{$option}.'</option>';
9170: }
9171: }
9172: $srchbysel .= "\n </select>\n";
9173:
9174: my $srchtypesel = ' <select name="srchtype">';
1.580 raeburn 9175: foreach my $option ('begins','contains','exact') {
1.555 raeburn 9176: if ($curr_selected{'srchtype'} eq $option) {
9177: $srchtypesel .= '
9178: <option value="'.$option.'" selected="selected">'.$lt{$option}.'</option>';
9179: } else {
9180: $srchtypesel .= '
9181: <option value="'.$option.'">'.$lt{$option}.'</option>';
9182: }
9183: }
9184: $srchtypesel .= "\n </select>\n";
9185:
1.558 albertel 9186: my ($newuserscript,$new_user_create);
1.994 raeburn 9187: my $context_dom = $env{'request.role.domain'};
9188: if ($context eq 'requestcrs') {
9189: if ($env{'form.coursedom'} ne '') {
9190: $context_dom = $env{'form.coursedom'};
9191: }
9192: }
1.556 raeburn 9193: if ($forcenewuser) {
1.576 raeburn 9194: if (ref($srch) eq 'HASH') {
1.994 raeburn 9195: if ($srch->{'srchby'} eq 'uname' && $srch->{'srchtype'} eq 'exact' && $srch->{'srchin'} eq 'dom' && $srch->{'srchdomain'} eq $context_dom) {
1.627 raeburn 9196: if ($cancreate) {
9197: $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>';
9198: } else {
1.799 bisitz 9199: my $helplink = 'javascript:helpMenu('."'display'".')';
1.627 raeburn 9200: my %usertypetext = (
9201: official => 'institutional',
9202: unofficial => 'non-institutional',
9203: );
1.799 bisitz 9204: $new_user_create = '<p class="LC_warning">'
9205: .&mt("You are not authorized to create new $usertypetext{$usertype} users in this domain.")
9206: .' '
9207: .&mt('Please contact the [_1]helpdesk[_2] for assistance.'
9208: ,'<a href="'.$helplink.'">','</a>')
9209: .'</p><br />';
1.627 raeburn 9210: }
1.576 raeburn 9211: }
9212: }
9213:
1.556 raeburn 9214: $newuserscript = <<"ENDSCRIPT";
9215:
1.570 raeburn 9216: function setSearch(createnew,callingForm) {
1.556 raeburn 9217: if (createnew == 1) {
1.570 raeburn 9218: for (var i=0; i<callingForm.srchby.length; i++) {
9219: if (callingForm.srchby.options[i].value == 'uname') {
9220: callingForm.srchby.selectedIndex = i;
1.556 raeburn 9221: }
9222: }
1.570 raeburn 9223: for (var i=0; i<callingForm.srchin.length; i++) {
9224: if ( callingForm.srchin.options[i].value == 'dom') {
9225: callingForm.srchin.selectedIndex = i;
1.556 raeburn 9226: }
9227: }
1.570 raeburn 9228: for (var i=0; i<callingForm.srchtype.length; i++) {
9229: if (callingForm.srchtype.options[i].value == 'exact') {
9230: callingForm.srchtype.selectedIndex = i;
1.556 raeburn 9231: }
9232: }
1.570 raeburn 9233: for (var i=0; i<callingForm.srchdomain.length; i++) {
1.994 raeburn 9234: if (callingForm.srchdomain.options[i].value == '$context_dom') {
1.570 raeburn 9235: callingForm.srchdomain.selectedIndex = i;
1.556 raeburn 9236: }
9237: }
9238: }
9239: }
9240: ENDSCRIPT
1.558 albertel 9241:
1.556 raeburn 9242: }
9243:
1.555 raeburn 9244: my $output = <<"END_BLOCK";
1.556 raeburn 9245: <script type="text/javascript">
1.824 bisitz 9246: // <![CDATA[
1.570 raeburn 9247: function validateEntry(callingForm) {
1.558 albertel 9248:
1.556 raeburn 9249: var checkok = 1;
1.558 albertel 9250: var srchin;
1.570 raeburn 9251: for (var i=0; i<callingForm.srchin.length; i++) {
9252: if ( callingForm.srchin[i].checked ) {
9253: srchin = callingForm.srchin[i].value;
1.558 albertel 9254: }
9255: }
9256:
1.570 raeburn 9257: var srchtype = callingForm.srchtype.options[callingForm.srchtype.selectedIndex].value;
9258: var srchby = callingForm.srchby.options[callingForm.srchby.selectedIndex].value;
9259: var srchdomain = callingForm.srchdomain.options[callingForm.srchdomain.selectedIndex].value;
9260: var srchterm = callingForm.srchterm.value;
9261: var srchin = callingForm.srchin.options[callingForm.srchin.selectedIndex].value;
1.556 raeburn 9262: var msg = "";
9263:
9264: if (srchterm == "") {
9265: checkok = 0;
1.571 raeburn 9266: msg += "$lt{'youm'}\\n";
1.556 raeburn 9267: }
9268:
1.569 raeburn 9269: if (srchtype== 'begins') {
9270: if (srchterm.length < 2) {
9271: checkok = 0;
1.571 raeburn 9272: msg += "$lt{'thte'}\\n";
1.569 raeburn 9273: }
9274: }
9275:
1.556 raeburn 9276: if (srchtype== 'contains') {
9277: if (srchterm.length < 3) {
9278: checkok = 0;
1.571 raeburn 9279: msg += "$lt{'thet'}\\n";
1.556 raeburn 9280: }
9281: }
9282: if (srchin == 'instd') {
9283: if (srchdomain == '') {
9284: checkok = 0;
1.571 raeburn 9285: msg += "$lt{'yomc'}\\n";
1.556 raeburn 9286: }
9287: }
9288: if (srchin == 'dom') {
9289: if (srchdomain == '') {
9290: checkok = 0;
1.571 raeburn 9291: msg += "$lt{'ymcd'}\\n";
1.556 raeburn 9292: }
9293: }
9294: if (srchby == 'lastfirst') {
9295: if (srchterm.indexOf(",") == -1) {
9296: checkok = 0;
1.571 raeburn 9297: msg += "$lt{'whus'}\\n";
1.556 raeburn 9298: }
9299: if (srchterm.indexOf(",") == srchterm.length -1) {
9300: checkok = 0;
1.571 raeburn 9301: msg += "$lt{'whse'}\\n";
1.556 raeburn 9302: }
9303: }
9304: if (checkok == 0) {
1.571 raeburn 9305: alert("$lt{'thfo'}\\n"+msg);
1.556 raeburn 9306: return;
9307: }
9308: if (checkok == 1) {
1.570 raeburn 9309: callingForm.submit();
1.556 raeburn 9310: }
9311: }
9312:
9313: $newuserscript
9314:
1.824 bisitz 9315: // ]]>
1.556 raeburn 9316: </script>
1.558 albertel 9317:
9318: $new_user_create
9319:
1.555 raeburn 9320: END_BLOCK
1.558 albertel 9321:
1.876 raeburn 9322: $output .= &Apache::lonhtmlcommon::start_pick_box().
9323: &Apache::lonhtmlcommon::row_title($lt{'doma'}).
9324: $domform.
9325: &Apache::lonhtmlcommon::row_closure().
9326: &Apache::lonhtmlcommon::row_title($lt{'usr'}).
9327: $srchbysel.
9328: $srchtypesel.
9329: '<input type="text" size="15" name="srchterm" value="'.$srchterm.'" />'.
9330: $srchinsel.
9331: &Apache::lonhtmlcommon::row_closure(1).
9332: &Apache::lonhtmlcommon::end_pick_box().
9333: '<br />';
1.555 raeburn 9334: return $output;
9335: }
9336:
1.612 raeburn 9337: sub user_rule_check {
1.615 raeburn 9338: my ($usershash,$checks,$alerts,$rulematch,$inst_results,$curr_rules,$got_rules) = @_;
1.612 raeburn 9339: my $response;
9340: if (ref($usershash) eq 'HASH') {
9341: foreach my $user (keys(%{$usershash})) {
9342: my ($uname,$udom) = split(/:/,$user);
9343: next if ($udom eq '' || $uname eq '');
1.615 raeburn 9344: my ($id,$newuser);
1.612 raeburn 9345: if (ref($usershash->{$user}) eq 'HASH') {
1.615 raeburn 9346: $newuser = $usershash->{$user}->{'newuser'};
1.612 raeburn 9347: $id = $usershash->{$user}->{'id'};
9348: }
9349: my $inst_response;
9350: if (ref($checks) eq 'HASH') {
9351: if (defined($checks->{'username'})) {
1.615 raeburn 9352: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9353: &Apache::lonnet::get_instuser($udom,$uname);
9354: } elsif (defined($checks->{'id'})) {
1.615 raeburn 9355: ($inst_response,%{$inst_results->{$user}}) =
1.612 raeburn 9356: &Apache::lonnet::get_instuser($udom,undef,$id);
9357: }
1.615 raeburn 9358: } else {
9359: ($inst_response,%{$inst_results->{$user}}) =
9360: &Apache::lonnet::get_instuser($udom,$uname);
9361: return;
1.612 raeburn 9362: }
1.615 raeburn 9363: if (!$got_rules->{$udom}) {
1.612 raeburn 9364: my %domconfig = &Apache::lonnet::get_dom('configuration',
9365: ['usercreation'],$udom);
9366: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.615 raeburn 9367: foreach my $item ('username','id') {
1.612 raeburn 9368: if (ref($domconfig{'usercreation'}{$item.'_rule'}) eq 'ARRAY') {
9369: $$curr_rules{$udom}{$item} =
9370: $domconfig{'usercreation'}{$item.'_rule'};
1.585 raeburn 9371: }
9372: }
9373: }
1.615 raeburn 9374: $got_rules->{$udom} = 1;
1.585 raeburn 9375: }
1.612 raeburn 9376: foreach my $item (keys(%{$checks})) {
9377: if (ref($$curr_rules{$udom}) eq 'HASH') {
9378: if (ref($$curr_rules{$udom}{$item}) eq 'ARRAY') {
9379: if (@{$$curr_rules{$udom}{$item}} > 0) {
9380: my %rule_check = &Apache::lonnet::inst_rulecheck($udom,$uname,$id,$item,$$curr_rules{$udom}{$item});
9381: foreach my $rule (@{$$curr_rules{$udom}{$item}}) {
9382: if ($rule_check{$rule}) {
9383: $$rulematch{$user}{$item} = $rule;
9384: if ($inst_response eq 'ok') {
1.615 raeburn 9385: if (ref($inst_results) eq 'HASH') {
9386: if (ref($inst_results->{$user}) eq 'HASH') {
9387: if (keys(%{$inst_results->{$user}}) == 0) {
9388: $$alerts{$item}{$udom}{$uname} = 1;
9389: }
1.612 raeburn 9390: }
9391: }
1.615 raeburn 9392: }
9393: last;
1.585 raeburn 9394: }
9395: }
9396: }
9397: }
9398: }
9399: }
9400: }
9401: }
1.612 raeburn 9402: return;
9403: }
9404:
9405: sub user_rule_formats {
9406: my ($domain,$domdesc,$curr_rules,$check) = @_;
9407: my %text = (
9408: 'username' => 'Usernames',
9409: 'id' => 'IDs',
9410: );
9411: my $output;
9412: my ($rules,$ruleorder) = &Apache::lonnet::inst_userrules($domain,$check);
9413: if ((ref($rules) eq 'HASH') && (ref($ruleorder) eq 'ARRAY')) {
9414: if (@{$ruleorder} > 0) {
1.1102 raeburn 9415: $output = '<br />'.
9416: &mt($text{$check}.' with the following format(s) may [_1]only[_2] be used for verified users at [_3]:',
9417: '<span class="LC_cusr_emph">','</span>',$domdesc).
9418: ' <ul>';
1.612 raeburn 9419: foreach my $rule (@{$ruleorder}) {
9420: if (ref($curr_rules) eq 'ARRAY') {
9421: if (grep(/^\Q$rule\E$/,@{$curr_rules})) {
9422: if (ref($rules->{$rule}) eq 'HASH') {
9423: $output .= '<li>'.$rules->{$rule}{'name'}.': '.
9424: $rules->{$rule}{'desc'}.'</li>';
9425: }
9426: }
9427: }
9428: }
9429: $output .= '</ul>';
9430: }
9431: }
9432: return $output;
9433: }
9434:
9435: sub instrule_disallow_msg {
1.615 raeburn 9436: my ($checkitem,$domdesc,$count,$mode) = @_;
1.612 raeburn 9437: my $response;
9438: my %text = (
9439: item => 'username',
9440: items => 'usernames',
9441: match => 'matches',
9442: do => 'does',
9443: action => 'a username',
9444: one => 'one',
9445: );
9446: if ($count > 1) {
9447: $text{'item'} = 'usernames';
9448: $text{'match'} ='match';
9449: $text{'do'} = 'do';
9450: $text{'action'} = 'usernames',
9451: $text{'one'} = 'ones';
9452: }
9453: if ($checkitem eq 'id') {
9454: $text{'items'} = 'IDs';
9455: $text{'item'} = 'ID';
9456: $text{'action'} = 'an ID';
1.615 raeburn 9457: if ($count > 1) {
9458: $text{'item'} = 'IDs';
9459: $text{'action'} = 'IDs';
9460: }
1.612 raeburn 9461: }
1.674 bisitz 9462: $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 9463: if ($mode eq 'upload') {
9464: if ($checkitem eq 'username') {
9465: $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'}.");
9466: } elsif ($checkitem eq 'id') {
1.674 bisitz 9467: $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 9468: }
1.669 raeburn 9469: } elsif ($mode eq 'selfcreate') {
9470: if ($checkitem eq 'id') {
9471: $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.");
9472: }
1.615 raeburn 9473: } else {
9474: if ($checkitem eq 'username') {
9475: $response .= &mt("You must choose $text{'action'} with a different format -- $text{'one'} that will not conflict with 'official' institutional $text{'items'}.");
9476: } elsif ($checkitem eq 'id') {
9477: $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.");
9478: }
1.612 raeburn 9479: }
9480: return $response;
1.585 raeburn 9481: }
9482:
1.624 raeburn 9483: sub personal_data_fieldtitles {
9484: my %fieldtitles = &Apache::lonlocal::texthash (
9485: id => 'Student/Employee ID',
9486: permanentemail => 'E-mail address',
9487: lastname => 'Last Name',
9488: firstname => 'First Name',
9489: middlename => 'Middle Name',
9490: generation => 'Generation',
9491: gen => 'Generation',
1.765 raeburn 9492: inststatus => 'Affiliation',
1.624 raeburn 9493: );
9494: return %fieldtitles;
9495: }
9496:
1.642 raeburn 9497: sub sorted_inst_types {
9498: my ($dom) = @_;
1.1185 raeburn 9499: my ($usertypes,$order);
9500: my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
9501: if (ref($domdefaults{'inststatus'}) eq 'HASH') {
9502: $usertypes = $domdefaults{'inststatus'}{'inststatustypes'};
9503: $order = $domdefaults{'inststatus'}{'inststatusorder'};
9504: } else {
9505: ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom);
9506: }
1.642 raeburn 9507: my $othertitle = &mt('All users');
9508: if ($env{'request.course.id'}) {
1.668 raeburn 9509: $othertitle = &mt('Any users');
1.642 raeburn 9510: }
9511: my @types;
9512: if (ref($order) eq 'ARRAY') {
9513: @types = @{$order};
9514: }
9515: if (@types == 0) {
9516: if (ref($usertypes) eq 'HASH') {
9517: @types = sort(keys(%{$usertypes}));
9518: }
9519: }
9520: if (keys(%{$usertypes}) > 0) {
9521: $othertitle = &mt('Other users');
9522: }
9523: return ($othertitle,$usertypes,\@types);
9524: }
9525:
1.645 raeburn 9526: sub get_institutional_codes {
9527: my ($settings,$allcourses,$LC_code) = @_;
9528: # Get complete list of course sections to update
9529: my @currsections = ();
9530: my @currxlists = ();
9531: my $coursecode = $$settings{'internal.coursecode'};
9532:
9533: if ($$settings{'internal.sectionnums'} ne '') {
9534: @currsections = split(/,/,$$settings{'internal.sectionnums'});
9535: }
9536:
9537: if ($$settings{'internal.crosslistings'} ne '') {
9538: @currxlists = split(/,/,$$settings{'internal.crosslistings'});
9539: }
9540:
9541: if (@currxlists > 0) {
9542: foreach (@currxlists) {
9543: if (m/^([^:]+):(\w*)$/) {
9544: unless (grep/^$1$/,@{$allcourses}) {
9545: push @{$allcourses},$1;
9546: $$LC_code{$1} = $2;
9547: }
9548: }
9549: }
9550: }
9551:
9552: if (@currsections > 0) {
9553: foreach (@currsections) {
9554: if (m/^(\w+):(\w*)$/) {
9555: my $sec = $coursecode.$1;
9556: my $lc_sec = $2;
9557: unless (grep/^$sec$/,@{$allcourses}) {
9558: push @{$allcourses},$sec;
9559: $$LC_code{$sec} = $lc_sec;
9560: }
9561: }
9562: }
9563: }
9564: return;
9565: }
9566:
1.971 raeburn 9567: sub get_standard_codeitems {
9568: return ('Year','Semester','Department','Number','Section');
9569: }
9570:
1.112 bowersj2 9571: =pod
9572:
1.780 raeburn 9573: =head1 Slot Helpers
9574:
9575: =over 4
9576:
9577: =item * sorted_slots()
9578:
1.1040 raeburn 9579: Sorts an array of slot names in order of an optional sort key,
9580: default sort is by slot start time (earliest first).
1.780 raeburn 9581:
9582: Inputs:
9583:
9584: =over 4
9585:
9586: slotsarr - Reference to array of unsorted slot names.
9587:
9588: slots - Reference to hash of hash, where outer hash keys are slot names.
9589:
1.1040 raeburn 9590: sortkey - Name of key in inner hash to be sorted on (e.g., starttime).
9591:
1.549 albertel 9592: =back
9593:
1.780 raeburn 9594: Returns:
9595:
9596: =over 4
9597:
1.1040 raeburn 9598: sorted - An array of slot names sorted by a specified sort key
9599: (default sort key is start time of the slot).
1.780 raeburn 9600:
9601: =back
9602:
9603: =cut
9604:
9605:
9606: sub sorted_slots {
1.1040 raeburn 9607: my ($slotsarr,$slots,$sortkey) = @_;
9608: if ($sortkey eq '') {
9609: $sortkey = 'starttime';
9610: }
1.780 raeburn 9611: my @sorted;
9612: if ((ref($slotsarr) eq 'ARRAY') && (ref($slots) eq 'HASH')) {
9613: @sorted =
9614: sort {
9615: if (ref($slots->{$a}) && ref($slots->{$b})) {
1.1040 raeburn 9616: return $slots->{$a}{$sortkey} <=> $slots->{$b}{$sortkey}
1.780 raeburn 9617: }
9618: if (ref($slots->{$a})) { return -1;}
9619: if (ref($slots->{$b})) { return 1;}
9620: return 0;
9621: } @{$slotsarr};
9622: }
9623: return @sorted;
9624: }
9625:
1.1040 raeburn 9626: =pod
9627:
9628: =item * get_future_slots()
9629:
9630: Inputs:
9631:
9632: =over 4
9633:
9634: cnum - course number
9635:
9636: cdom - course domain
9637:
9638: now - current UNIX time
9639:
9640: symb - optional symb
9641:
9642: =back
9643:
9644: Returns:
9645:
9646: =over 4
9647:
9648: sorted_reservable - ref to array of student_schedulable slots currently
9649: reservable, ordered by end date of reservation period.
9650:
9651: reservable_now - ref to hash of student_schedulable slots currently
9652: reservable.
9653:
9654: Keys in inner hash are:
9655: (a) symb: either blank or symb to which slot use is restricted.
9656: (b) endreserve: end date of reservation period.
9657:
9658: sorted_future - ref to array of student_schedulable slots reservable in
9659: the future, ordered by start date of reservation period.
9660:
9661: future_reservable - ref to hash of student_schedulable slots reservable
9662: in the future.
9663:
9664: Keys in inner hash are:
9665: (a) symb: either blank or symb to which slot use is restricted.
9666: (b) startreserve: start date of reservation period.
9667:
9668: =back
9669:
9670: =cut
9671:
9672: sub get_future_slots {
9673: my ($cnum,$cdom,$now,$symb) = @_;
9674: my (%reservable_now,%future_reservable,@sorted_reservable,@sorted_future);
9675: my %slots = &Apache::lonnet::get_course_slots($cnum,$cdom);
9676: foreach my $slot (keys(%slots)) {
9677: next unless($slots{$slot}->{'type'} eq 'schedulable_student');
9678: if ($symb) {
9679: next if (($slots{$slot}->{'symb'} ne '') &&
9680: ($slots{$slot}->{'symb'} ne $symb));
9681: }
9682: if (($slots{$slot}->{'starttime'} > $now) &&
9683: ($slots{$slot}->{'endtime'} > $now)) {
9684: if (($slots{$slot}->{'allowedsections'}) || ($slots{$slot}->{'allowedusers'})) {
9685: my $userallowed = 0;
9686: if ($slots{$slot}->{'allowedsections'}) {
9687: my @allowed_sec = split(',',$slots{$slot}->{'allowedsections'});
9688: if (!defined($env{'request.role.sec'})
9689: && grep(/^No section assigned$/,@allowed_sec)) {
9690: $userallowed=1;
9691: } else {
9692: if (grep(/^\Q$env{'request.role.sec'}\E$/,@allowed_sec)) {
9693: $userallowed=1;
9694: }
9695: }
9696: unless ($userallowed) {
9697: if (defined($env{'request.course.groups'})) {
9698: my @groups = split(/:/,$env{'request.course.groups'});
9699: foreach my $group (@groups) {
9700: if (grep(/^\Q$group\E$/,@allowed_sec)) {
9701: $userallowed=1;
9702: last;
9703: }
9704: }
9705: }
9706: }
9707: }
9708: if ($slots{$slot}->{'allowedusers'}) {
9709: my @allowed_users = split(',',$slots{$slot}->{'allowedusers'});
9710: my $user = $env{'user.name'}.':'.$env{'user.domain'};
9711: if (grep(/^\Q$user\E$/,@allowed_users)) {
9712: $userallowed = 1;
9713: }
9714: }
9715: next unless($userallowed);
9716: }
9717: my $startreserve = $slots{$slot}->{'startreserve'};
9718: my $endreserve = $slots{$slot}->{'endreserve'};
9719: my $symb = $slots{$slot}->{'symb'};
9720: if (($startreserve < $now) &&
9721: (!$endreserve || $endreserve > $now)) {
9722: my $lastres = $endreserve;
9723: if (!$lastres) {
9724: $lastres = $slots{$slot}->{'starttime'};
9725: }
9726: $reservable_now{$slot} = {
9727: symb => $symb,
9728: endreserve => $lastres
9729: };
9730: } elsif (($startreserve > $now) &&
9731: (!$endreserve || $endreserve > $startreserve)) {
9732: $future_reservable{$slot} = {
9733: symb => $symb,
9734: startreserve => $startreserve
9735: };
9736: }
9737: }
9738: }
9739: my @unsorted_reservable = keys(%reservable_now);
9740: if (@unsorted_reservable > 0) {
9741: @sorted_reservable =
9742: &sorted_slots(\@unsorted_reservable,\%reservable_now,'endreserve');
9743: }
9744: my @unsorted_future = keys(%future_reservable);
9745: if (@unsorted_future > 0) {
9746: @sorted_future =
9747: &sorted_slots(\@unsorted_future,\%future_reservable,'startreserve');
9748: }
9749: return (\@sorted_reservable,\%reservable_now,\@sorted_future,\%future_reservable);
9750: }
1.780 raeburn 9751:
9752: =pod
9753:
1.1057 foxr 9754: =back
9755:
1.549 albertel 9756: =head1 HTTP Helpers
9757:
9758: =over 4
9759:
1.648 raeburn 9760: =item * &get_unprocessed_cgi($query,$possible_names)
1.112 bowersj2 9761:
1.258 albertel 9762: Modify the %env hash to contain unprocessed CGI form parameters held in
1.112 bowersj2 9763: $query. The parameters listed in $possible_names (an array reference),
1.258 albertel 9764: will be set in $env{'form.name'} if they do not already exist.
1.112 bowersj2 9765:
9766: Typically called with $ENV{'QUERY_STRING'} as the first parameter.
9767: $possible_names is an ref to an array of form element names. As an example:
9768: get_unprocessed_cgi($ENV{'QUERY_STRING'},['uname','udom']);
1.258 albertel 9769: will result in $env{'form.uname'} and $env{'form.udom'} being set.
1.112 bowersj2 9770:
9771: =cut
1.1 albertel 9772:
1.6 albertel 9773: sub get_unprocessed_cgi {
1.25 albertel 9774: my ($query,$possible_names)= @_;
1.26 matthew 9775: # $Apache::lonxml::debug=1;
1.356 albertel 9776: foreach my $pair (split(/&/,$query)) {
9777: my ($name, $value) = split(/=/,$pair);
1.369 www 9778: $name = &unescape($name);
1.25 albertel 9779: if (!defined($possible_names) || (grep {$_ eq $name} @$possible_names)) {
9780: $value =~ tr/+/ /;
9781: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.258 albertel 9782: unless (defined($env{'form.'.$name})) { &add_to_env('form.'.$name,$value) };
1.25 albertel 9783: }
1.16 harris41 9784: }
1.6 albertel 9785: }
9786:
1.112 bowersj2 9787: =pod
9788:
1.648 raeburn 9789: =item * &cacheheader()
1.112 bowersj2 9790:
9791: returns cache-controlling header code
9792:
9793: =cut
9794:
1.7 albertel 9795: sub cacheheader {
1.258 albertel 9796: unless ($env{'request.method'} eq 'GET') { return ''; }
1.216 albertel 9797: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime);
9798: my $output .='<meta HTTP-EQUIV="Expires" CONTENT="'.$date.'" />
1.7 albertel 9799: <meta HTTP-EQUIV="Cache-control" CONTENT="no-cache" />
9800: <meta HTTP-EQUIV="Pragma" CONTENT="no-cache" />';
1.216 albertel 9801: return $output;
1.7 albertel 9802: }
9803:
1.112 bowersj2 9804: =pod
9805:
1.648 raeburn 9806: =item * &no_cache($r)
1.112 bowersj2 9807:
9808: specifies header code to not have cache
9809:
9810: =cut
9811:
1.9 albertel 9812: sub no_cache {
1.216 albertel 9813: my ($r) = @_;
9814: if ($ENV{'REQUEST_METHOD'} ne 'GET' &&
1.258 albertel 9815: $env{'request.method'} ne 'GET') { return ''; }
1.216 albertel 9816: my $date=strftime("%a, %d %b %Y %H:%M:%S GMT",gmtime(time));
9817: $r->no_cache(1);
9818: $r->header_out("Expires" => $date);
9819: $r->header_out("Pragma" => "no-cache");
1.123 www 9820: }
9821:
9822: sub content_type {
1.181 albertel 9823: my ($r,$type,$charset) = @_;
1.299 foxr 9824: if ($r) {
9825: # Note that printout.pl calls this with undef for $r.
9826: &no_cache($r);
9827: }
1.258 albertel 9828: if ($env{'browser.mathml'} && $type eq 'text/html') { $type='text/xml'; }
1.181 albertel 9829: unless ($charset) {
9830: $charset=&Apache::lonlocal::current_encoding;
9831: }
9832: if ($charset) { $type.='; charset='.$charset; }
9833: if ($r) {
9834: $r->content_type($type);
9835: } else {
9836: print("Content-type: $type\n\n");
9837: }
1.9 albertel 9838: }
1.25 albertel 9839:
1.112 bowersj2 9840: =pod
9841:
1.648 raeburn 9842: =item * &add_to_env($name,$value)
1.112 bowersj2 9843:
1.258 albertel 9844: adds $name to the %env hash with value
1.112 bowersj2 9845: $value, if $name already exists, the entry is converted to an array
9846: reference and $value is added to the array.
9847:
9848: =cut
9849:
1.25 albertel 9850: sub add_to_env {
9851: my ($name,$value)=@_;
1.258 albertel 9852: if (defined($env{$name})) {
9853: if (ref($env{$name})) {
1.25 albertel 9854: #already have multiple values
1.258 albertel 9855: push(@{ $env{$name} },$value);
1.25 albertel 9856: } else {
9857: #first time seeing multiple values, convert hash entry to an arrayref
1.258 albertel 9858: my $first=$env{$name};
9859: undef($env{$name});
9860: push(@{ $env{$name} },$first,$value);
1.25 albertel 9861: }
9862: } else {
1.258 albertel 9863: $env{$name}=$value;
1.25 albertel 9864: }
1.31 albertel 9865: }
1.149 albertel 9866:
9867: =pod
9868:
1.648 raeburn 9869: =item * &get_env_multiple($name)
1.149 albertel 9870:
1.258 albertel 9871: gets $name from the %env hash, it seemlessly handles the cases where multiple
1.149 albertel 9872: values may be defined and end up as an array ref.
9873:
9874: returns an array of values
9875:
9876: =cut
9877:
9878: sub get_env_multiple {
9879: my ($name) = @_;
9880: my @values;
1.258 albertel 9881: if (defined($env{$name})) {
1.149 albertel 9882: # exists is it an array
1.258 albertel 9883: if (ref($env{$name})) {
9884: @values=@{ $env{$name} };
1.149 albertel 9885: } else {
1.258 albertel 9886: $values[0]=$env{$name};
1.149 albertel 9887: }
9888: }
9889: return(@values);
9890: }
9891:
1.660 raeburn 9892: sub ask_for_embedded_content {
9893: my ($actionurl,$state,$allfiles,$codebase,$args)=@_;
1.1071 raeburn 9894: my (%subdependencies,%dependencies,%mapping,%existing,%newfiles,%pathchanges,
1.1085 raeburn 9895: %currsubfile,%unused,$rem);
1.1071 raeburn 9896: my $counter = 0;
9897: my $numnew = 0;
1.987 raeburn 9898: my $numremref = 0;
9899: my $numinvalid = 0;
9900: my $numpathchg = 0;
9901: my $numexisting = 0;
1.1071 raeburn 9902: my $numunused = 0;
9903: my ($output,$upload_output,$toplevel,$url,$udom,$uname,$getpropath,$cdom,$cnum,
1.1156 raeburn 9904: $fileloc,$filename,$delete_output,$modify_output,$title,$symb,$path,$navmap);
1.1071 raeburn 9905: my $heading = &mt('Upload embedded files');
9906: my $buttontext = &mt('Upload');
9907:
1.1085 raeburn 9908: if ($env{'request.course.id'}) {
1.1123 raeburn 9909: if ($actionurl eq '/adm/dependencies') {
9910: $navmap = Apache::lonnavmaps::navmap->new();
9911: }
9912: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
9913: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.1085 raeburn 9914: }
1.1123 raeburn 9915: if (($actionurl eq '/adm/portfolio') ||
9916: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.984 raeburn 9917: my $current_path='/';
9918: if ($env{'form.currentpath'}) {
9919: $current_path = $env{'form.currentpath'};
9920: }
9921: if ($actionurl eq '/adm/coursegrp_portfolio') {
1.1123 raeburn 9922: $udom = $cdom;
9923: $uname = $cnum;
1.984 raeburn 9924: $url = '/userfiles/groups/'.$env{'form.group'}.'/portfolio';
9925: } else {
9926: $udom = $env{'user.domain'};
9927: $uname = $env{'user.name'};
9928: $url = '/userfiles/portfolio';
9929: }
1.987 raeburn 9930: $toplevel = $url.'/';
1.984 raeburn 9931: $url .= $current_path;
9932: $getpropath = 1;
1.987 raeburn 9933: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
9934: ($actionurl eq '/adm/imsimport')) {
1.1022 www 9935: my ($udom,$uname,$rest) = ($args->{'current_path'} =~ m{/priv/($match_domain)/($match_username)/?(.*)$});
1.1026 raeburn 9936: $url = $Apache::lonnet::perlvar{'lonDocRoot'}."/priv/$udom/$uname/";
1.987 raeburn 9937: $toplevel = $url;
1.984 raeburn 9938: if ($rest ne '') {
1.987 raeburn 9939: $url .= $rest;
9940: }
9941: } elsif ($actionurl eq '/adm/coursedocs') {
9942: if (ref($args) eq 'HASH') {
1.1071 raeburn 9943: $url = $args->{'docs_url'};
9944: $toplevel = $url;
1.1084 raeburn 9945: if ($args->{'context'} eq 'paste') {
9946: ($cdom,$cnum) = ($url =~ m{^\Q/uploaded/\E($match_domain)/($match_courseid)/});
9947: ($path) =
9948: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9949: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9950: $fileloc =~ s{^/}{};
9951: }
1.1071 raeburn 9952: }
1.1084 raeburn 9953: } elsif ($actionurl eq '/adm/dependencies') {
1.1071 raeburn 9954: if ($env{'request.course.id'} ne '') {
9955: if (ref($args) eq 'HASH') {
9956: $url = $args->{'docs_url'};
9957: $title = $args->{'docs_title'};
1.1126 raeburn 9958: $toplevel = $url;
9959: unless ($toplevel =~ m{^/}) {
9960: $toplevel = "/$url";
9961: }
1.1085 raeburn 9962: ($rem) = ($toplevel =~ m{^(.+/)[^/]+$});
1.1126 raeburn 9963: if ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E)}) {
9964: $path = $1;
9965: } else {
9966: ($path) =
9967: ($toplevel =~ m{^(\Q/uploaded/$cdom/$cnum/\E(?:docs|supplemental)/(?:default|\d+)/\d+)/});
9968: }
1.1195 raeburn 9969: if ($toplevel=~/^\/*(uploaded|editupload)/) {
9970: $fileloc = $toplevel;
9971: $fileloc=~ s/^\s*(\S+)\s*$/$1/;
9972: my ($udom,$uname,$fname) =
9973: ($fileloc=~ m{^/+(?:uploaded|editupload)/+($match_domain)/+($match_name)/+(.*)$});
9974: $fileloc = propath($udom,$uname).'/userfiles/'.$fname;
9975: } else {
9976: $fileloc = &Apache::lonnet::filelocation('',$toplevel);
9977: }
1.1071 raeburn 9978: $fileloc =~ s{^/}{};
9979: ($filename) = ($fileloc =~ m{.+/([^/]+)$});
9980: $heading = &mt('Status of dependencies in [_1]',"$title ($filename)");
9981: }
1.987 raeburn 9982: }
1.1123 raeburn 9983: } elsif ($actionurl eq "/public/$cdom/$cnum/syllabus") {
9984: $udom = $cdom;
9985: $uname = $cnum;
9986: $url = "/uploaded/$cdom/$cnum/portfolio/syllabus";
9987: $toplevel = $url;
9988: $path = $url;
9989: $fileloc = &Apache::lonnet::filelocation('',$toplevel).'/';
9990: $fileloc =~ s{^/}{};
1.987 raeburn 9991: }
1.1126 raeburn 9992: foreach my $file (keys(%{$allfiles})) {
9993: my $embed_file;
9994: if (($path eq "/uploaded/$cdom/$cnum/portfolio/syllabus") && ($file =~ m{^\Q$path/\E(.+)$})) {
9995: $embed_file = $1;
9996: } else {
9997: $embed_file = $file;
9998: }
1.1158 raeburn 9999: my ($absolutepath,$cleaned_file);
10000: if ($embed_file =~ m{^\w+://}) {
10001: $cleaned_file = $embed_file;
1.1147 raeburn 10002: $newfiles{$cleaned_file} = 1;
10003: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10004: } else {
1.1158 raeburn 10005: $cleaned_file = &clean_path($embed_file);
1.987 raeburn 10006: if ($embed_file =~ m{^/}) {
10007: $absolutepath = $embed_file;
10008: }
1.1147 raeburn 10009: if ($cleaned_file =~ m{/}) {
10010: my ($path,$fname) = ($cleaned_file =~ m{^(.+)/([^/]*)$});
1.987 raeburn 10011: $path = &check_for_traversal($path,$url,$toplevel);
10012: my $item = $fname;
10013: if ($path ne '') {
10014: $item = $path.'/'.$fname;
10015: $subdependencies{$path}{$fname} = 1;
10016: } else {
10017: $dependencies{$item} = 1;
10018: }
10019: if ($absolutepath) {
10020: $mapping{$item} = $absolutepath;
10021: } else {
10022: $mapping{$item} = $embed_file;
10023: }
10024: } else {
10025: $dependencies{$embed_file} = 1;
10026: if ($absolutepath) {
1.1147 raeburn 10027: $mapping{$cleaned_file} = $absolutepath;
1.987 raeburn 10028: } else {
1.1147 raeburn 10029: $mapping{$cleaned_file} = $embed_file;
1.987 raeburn 10030: }
10031: }
1.984 raeburn 10032: }
10033: }
1.1071 raeburn 10034: my $dirptr = 16384;
1.984 raeburn 10035: foreach my $path (keys(%subdependencies)) {
1.1071 raeburn 10036: $currsubfile{$path} = {};
1.1123 raeburn 10037: if (($actionurl eq '/adm/portfolio') ||
10038: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10039: my ($sublistref,$listerror) =
10040: &Apache::lonnet::dirlist($url.$path,$udom,$uname,$getpropath);
10041: if (ref($sublistref) eq 'ARRAY') {
10042: foreach my $line (@{$sublistref}) {
10043: my ($file_name,$rest) = split(/\&/,$line,2);
1.1071 raeburn 10044: $currsubfile{$path}{$file_name} = 1;
1.1021 raeburn 10045: }
1.984 raeburn 10046: }
1.987 raeburn 10047: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10048: if (opendir(my $dir,$url.'/'.$path)) {
10049: my @subdir_list = grep(!/^\./,readdir($dir));
1.1071 raeburn 10050: map {$currsubfile{$path}{$_} = 1;} @subdir_list;
10051: }
1.1084 raeburn 10052: } elsif (($actionurl eq '/adm/dependencies') ||
10053: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10054: ($args->{'context'} eq 'paste')) ||
10055: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10056: if ($env{'request.course.id'} ne '') {
1.1123 raeburn 10057: my $dir;
10058: if ($actionurl eq "/public/$cdom/$cnum/syllabus") {
10059: $dir = $fileloc;
10060: } else {
10061: ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10062: }
1.1071 raeburn 10063: if ($dir ne '') {
10064: my ($sublistref,$listerror) =
10065: &Apache::lonnet::dirlist($dir.$path,$cdom,$cnum,$getpropath,undef,'/');
10066: if (ref($sublistref) eq 'ARRAY') {
10067: foreach my $line (@{$sublistref}) {
10068: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,$size,
10069: undef,$mtime)=split(/\&/,$line,12);
10070: unless (($testdir&$dirptr) ||
10071: ($file_name =~ /^\.\.?$/)) {
10072: $currsubfile{$path}{$file_name} = [$size,$mtime];
10073: }
10074: }
10075: }
10076: }
1.984 raeburn 10077: }
10078: }
10079: foreach my $file (keys(%{$subdependencies{$path}})) {
1.1071 raeburn 10080: if (exists($currsubfile{$path}{$file})) {
1.987 raeburn 10081: my $item = $path.'/'.$file;
10082: unless ($mapping{$item} eq $item) {
10083: $pathchanges{$item} = 1;
10084: }
10085: $existing{$item} = 1;
10086: $numexisting ++;
10087: } else {
10088: $newfiles{$path.'/'.$file} = 1;
1.984 raeburn 10089: }
10090: }
1.1071 raeburn 10091: if ($actionurl eq '/adm/dependencies') {
10092: foreach my $path (keys(%currsubfile)) {
10093: if (ref($currsubfile{$path}) eq 'HASH') {
10094: foreach my $file (keys(%{$currsubfile{$path}})) {
10095: unless ($subdependencies{$path}{$file}) {
1.1085 raeburn 10096: next if (($rem ne '') &&
10097: (($env{"httpref.$rem"."$path/$file"} ne '') ||
10098: (ref($navmap) &&
10099: (($navmap->getResourceByUrl($rem."$path/$file") ne '') ||
10100: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10101: ($navmap->getResourceByUrl($rem."$path/$1")))))));
1.1071 raeburn 10102: $unused{$path.'/'.$file} = 1;
10103: }
10104: }
10105: }
10106: }
10107: }
1.984 raeburn 10108: }
1.987 raeburn 10109: my %currfile;
1.1123 raeburn 10110: if (($actionurl eq '/adm/portfolio') ||
10111: ($actionurl eq '/adm/coursegrp_portfolio')) {
1.1021 raeburn 10112: my ($dirlistref,$listerror) =
10113: &Apache::lonnet::dirlist($url,$udom,$uname,$getpropath);
10114: if (ref($dirlistref) eq 'ARRAY') {
10115: foreach my $line (@{$dirlistref}) {
10116: my ($file_name,$rest) = split(/\&/,$line,2);
10117: $currfile{$file_name} = 1;
10118: }
1.984 raeburn 10119: }
1.987 raeburn 10120: } elsif (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
1.984 raeburn 10121: if (opendir(my $dir,$url)) {
1.987 raeburn 10122: my @dir_list = grep(!/^\./,readdir($dir));
1.984 raeburn 10123: map {$currfile{$_} = 1;} @dir_list;
10124: }
1.1084 raeburn 10125: } elsif (($actionurl eq '/adm/dependencies') ||
10126: (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
1.1123 raeburn 10127: ($args->{'context'} eq 'paste')) ||
10128: ($actionurl eq "/public/$cdom/$cnum/syllabus")) {
1.1071 raeburn 10129: if ($env{'request.course.id'} ne '') {
10130: my ($dir) = ($fileloc =~ m{^(.+/)[^/]+$});
10131: if ($dir ne '') {
10132: my ($dirlistref,$listerror) =
10133: &Apache::lonnet::dirlist($dir,$cdom,$cnum,$getpropath,undef,'/');
10134: if (ref($dirlistref) eq 'ARRAY') {
10135: foreach my $line (@{$dirlistref}) {
10136: my ($file_name,$dom,undef,$testdir,undef,undef,undef,undef,
10137: $size,undef,$mtime)=split(/\&/,$line,12);
10138: unless (($testdir&$dirptr) ||
10139: ($file_name =~ /^\.\.?$/)) {
10140: $currfile{$file_name} = [$size,$mtime];
10141: }
10142: }
10143: }
10144: }
10145: }
1.984 raeburn 10146: }
10147: foreach my $file (keys(%dependencies)) {
1.1071 raeburn 10148: if (exists($currfile{$file})) {
1.987 raeburn 10149: unless ($mapping{$file} eq $file) {
10150: $pathchanges{$file} = 1;
10151: }
10152: $existing{$file} = 1;
10153: $numexisting ++;
10154: } else {
1.984 raeburn 10155: $newfiles{$file} = 1;
10156: }
10157: }
1.1071 raeburn 10158: foreach my $file (keys(%currfile)) {
10159: unless (($file eq $filename) ||
10160: ($file eq $filename.'.bak') ||
10161: ($dependencies{$file})) {
1.1085 raeburn 10162: if ($actionurl eq '/adm/dependencies') {
1.1126 raeburn 10163: unless ($toplevel =~ m{^\Q/uploaded/$cdom/$cnum/portfolio/syllabus\E}) {
10164: next if (($rem ne '') &&
10165: (($env{"httpref.$rem".$file} ne '') ||
10166: (ref($navmap) &&
10167: (($navmap->getResourceByUrl($rem.$file) ne '') ||
10168: (($file =~ /^(.*\.s?html?)\.bak$/i) &&
10169: ($navmap->getResourceByUrl($rem.$1)))))));
10170: }
1.1085 raeburn 10171: }
1.1071 raeburn 10172: $unused{$file} = 1;
10173: }
10174: }
1.1084 raeburn 10175: if (($actionurl eq '/adm/coursedocs') && (ref($args) eq 'HASH') &&
10176: ($args->{'context'} eq 'paste')) {
10177: $counter = scalar(keys(%existing));
10178: $numpathchg = scalar(keys(%pathchanges));
1.1123 raeburn 10179: return ($output,$counter,$numpathchg,\%existing);
10180: } elsif (($actionurl eq "/public/$cdom/$cnum/syllabus") &&
10181: (ref($args) eq 'HASH') && ($args->{'context'} eq 'rewrites')) {
10182: $counter = scalar(keys(%existing));
10183: $numpathchg = scalar(keys(%pathchanges));
10184: return ($output,$counter,$numpathchg,\%existing,\%mapping);
1.1084 raeburn 10185: }
1.984 raeburn 10186: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%newfiles)) {
1.1071 raeburn 10187: if ($actionurl eq '/adm/dependencies') {
10188: next if ($embed_file =~ m{^\w+://});
10189: }
1.660 raeburn 10190: $upload_output .= &start_data_table_row().
1.1123 raeburn 10191: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
1.1071 raeburn 10192: '<span class="LC_filename">'.$embed_file.'</span>';
1.987 raeburn 10193: unless ($mapping{$embed_file} eq $embed_file) {
1.1123 raeburn 10194: $upload_output .= '<br /><span class="LC_info" style="font-size:smaller;">'.
10195: &mt('changed from: [_1]',$mapping{$embed_file}).'</span>';
1.987 raeburn 10196: }
1.1123 raeburn 10197: $upload_output .= '</td>';
1.1071 raeburn 10198: if ($args->{'ignore_remote_references'} && $embed_file =~ m{^\w+://}) {
1.1123 raeburn 10199: $upload_output.='<td align="right">'.
10200: '<span class="LC_info LC_fontsize_medium">'.
10201: &mt("URL points to web address").'</span>';
1.987 raeburn 10202: $numremref++;
1.660 raeburn 10203: } elsif ($args->{'error_on_invalid_names'}
10204: && $embed_file ne &Apache::lonnet::clean_filename($embed_file,{'keep_path' => 1,})) {
1.1123 raeburn 10205: $upload_output.='<td align="right"><span class="LC_warning">'.
10206: &mt('Invalid characters').'</span>';
1.987 raeburn 10207: $numinvalid++;
1.660 raeburn 10208: } else {
1.1123 raeburn 10209: $upload_output .= '<td>'.
10210: &embedded_file_element('upload_embedded',$counter,
1.987 raeburn 10211: $embed_file,\%mapping,
1.1071 raeburn 10212: $allfiles,$codebase,'upload');
10213: $counter ++;
10214: $numnew ++;
1.987 raeburn 10215: }
10216: $upload_output .= '</td>'.&Apache::loncommon::end_data_table_row()."\n";
10217: }
10218: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%existing)) {
1.1071 raeburn 10219: if ($actionurl eq '/adm/dependencies') {
10220: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$embed_file);
10221: $modify_output .= &start_data_table_row().
10222: '<td><a href="'.$path.'/'.$embed_file.'" style="text-decoration:none;">'.
10223: '<img src="'.&icon($embed_file).'" border="0" />'.
10224: ' <span class="LC_filename">'.$embed_file.'</span></a></td>'.
10225: '<td>'.$size.'</td>'.
10226: '<td>'.$mtime.'</td>'.
10227: '<td><label><input type="checkbox" name="mod_upload_dep" '.
10228: 'onclick="toggleBrowse('."'$counter'".')" id="mod_upload_dep_'.
10229: $counter.'" value="'.$counter.'" />'.&mt('Yes').'</label>'.
10230: '<div id="moduploaddep_'.$counter.'" style="display:none;">'.
10231: &embedded_file_element('upload_embedded',$counter,
10232: $embed_file,\%mapping,
10233: $allfiles,$codebase,'modify').
10234: '</div></td>'.
10235: &end_data_table_row()."\n";
10236: $counter ++;
10237: } else {
10238: $upload_output .= &start_data_table_row().
1.1123 raeburn 10239: '<td valign="top"><img src="'.&icon($embed_file).'" /> '.
10240: '<span class="LC_filename">'.$embed_file.'</span></td>'.
10241: '<td align="right"><span class="LC_info LC_fontsize_medium">'.&mt('Already exists').'</span></td>'.
1.1071 raeburn 10242: &Apache::loncommon::end_data_table_row()."\n";
10243: }
10244: }
10245: my $delidx = $counter;
10246: foreach my $oldfile (sort {lc($a) cmp lc($b)} keys(%unused)) {
10247: my ($size,$mtime) = &get_dependency_details(\%currfile,\%currsubfile,$oldfile);
10248: $delete_output .= &start_data_table_row().
10249: '<td><img src="'.&icon($oldfile).'" />'.
10250: ' <span class="LC_filename">'.$oldfile.'</span></td>'.
10251: '<td>'.$size.'</td>'.
10252: '<td>'.$mtime.'</td>'.
10253: '<td><label><input type="checkbox" name="del_upload_dep" '.
10254: ' value="'.$delidx.'" />'.&mt('Yes').'</label>'.
10255: &embedded_file_element('upload_embedded',$delidx,
10256: $oldfile,\%mapping,$allfiles,
10257: $codebase,'delete').'</td>'.
10258: &end_data_table_row()."\n";
10259: $numunused ++;
10260: $delidx ++;
1.987 raeburn 10261: }
10262: if ($upload_output) {
10263: $upload_output = &start_data_table().
10264: $upload_output.
10265: &end_data_table()."\n";
10266: }
1.1071 raeburn 10267: if ($modify_output) {
10268: $modify_output = &start_data_table().
10269: &start_data_table_header_row().
10270: '<th>'.&mt('File').'</th>'.
10271: '<th>'.&mt('Size (KB)').'</th>'.
10272: '<th>'.&mt('Modified').'</th>'.
10273: '<th>'.&mt('Upload replacement?').'</th>'.
10274: &end_data_table_header_row().
10275: $modify_output.
10276: &end_data_table()."\n";
10277: }
10278: if ($delete_output) {
10279: $delete_output = &start_data_table().
10280: &start_data_table_header_row().
10281: '<th>'.&mt('File').'</th>'.
10282: '<th>'.&mt('Size (KB)').'</th>'.
10283: '<th>'.&mt('Modified').'</th>'.
10284: '<th>'.&mt('Delete?').'</th>'.
10285: &end_data_table_header_row().
10286: $delete_output.
10287: &end_data_table()."\n";
10288: }
1.987 raeburn 10289: my $applies = 0;
10290: if ($numremref) {
10291: $applies ++;
10292: }
10293: if ($numinvalid) {
10294: $applies ++;
10295: }
10296: if ($numexisting) {
10297: $applies ++;
10298: }
1.1071 raeburn 10299: if ($counter || $numunused) {
1.987 raeburn 10300: $output = '<form name="upload_embedded" action="'.$actionurl.'"'.
10301: ' method="post" enctype="multipart/form-data">'."\n".
1.1071 raeburn 10302: $state.'<h3>'.$heading.'</h3>';
10303: if ($actionurl eq '/adm/dependencies') {
10304: if ($numnew) {
10305: $output .= '<h4>'.&mt('Missing dependencies').'</h4>'.
10306: '<p>'.&mt('The following files need to be uploaded.').'</p>'."\n".
10307: $upload_output.'<br />'."\n";
10308: }
10309: if ($numexisting) {
10310: $output .= '<h4>'.&mt('Uploaded dependencies (in use)').'</h4>'.
10311: '<p>'.&mt('Upload a new file to replace the one currently in use.').'</p>'."\n".
10312: $modify_output.'<br />'."\n";
10313: $buttontext = &mt('Save changes');
10314: }
10315: if ($numunused) {
10316: $output .= '<h4>'.&mt('Unused files').'</h4>'.
10317: '<p>'.&mt('The following uploaded files are no longer used.').'</p>'."\n".
10318: $delete_output.'<br />'."\n";
10319: $buttontext = &mt('Save changes');
10320: }
10321: } else {
10322: $output .= $upload_output.'<br />'."\n";
10323: }
10324: $output .= '<input type ="hidden" name="number_embedded_items" value="'.
10325: $counter.'" />'."\n";
10326: if ($actionurl eq '/adm/dependencies') {
10327: $output .= '<input type ="hidden" name="number_newemb_items" value="'.
10328: $numnew.'" />'."\n";
10329: } elsif ($actionurl eq '') {
1.987 raeburn 10330: $output .= '<input type="hidden" name="phase" value="three" />';
10331: }
10332: } elsif ($applies) {
10333: $output = '<b>'.&mt('Referenced files').'</b>:<br />';
10334: if ($applies > 1) {
10335: $output .=
1.1123 raeburn 10336: &mt('No dependencies need to be uploaded, as one of the following applies to each reference:').'<ul>';
1.987 raeburn 10337: if ($numremref) {
10338: $output .= '<li>'.&mt('reference is to a URL which points to another server').'</li>'."\n";
10339: }
10340: if ($numinvalid) {
10341: $output .= '<li>'.&mt('reference is to file with a name containing invalid characters').'</li>'."\n";
10342: }
10343: if ($numexisting) {
10344: $output .= '<li>'.&mt('reference is to an existing file at the specified location').'</li>'."\n";
10345: }
10346: $output .= '</ul><br />';
10347: } elsif ($numremref) {
10348: $output .= '<p>'.&mt('None to upload, as all references are to URLs pointing to another server.').'</p>';
10349: } elsif ($numinvalid) {
10350: $output .= '<p>'.&mt('None to upload, as all references are to files with names containing invalid characters.').'</p>';
10351: } elsif ($numexisting) {
10352: $output .= '<p>'.&mt('None to upload, as all references are to existing files.').'</p>';
10353: }
10354: $output .= $upload_output.'<br />';
10355: }
10356: my ($pathchange_output,$chgcount);
1.1071 raeburn 10357: $chgcount = $counter;
1.987 raeburn 10358: if (keys(%pathchanges) > 0) {
10359: foreach my $embed_file (sort {lc($a) cmp lc($b)} keys(%pathchanges)) {
1.1071 raeburn 10360: if ($counter) {
1.987 raeburn 10361: $output .= &embedded_file_element('pathchange',$chgcount,
10362: $embed_file,\%mapping,
1.1071 raeburn 10363: $allfiles,$codebase,'change');
1.987 raeburn 10364: } else {
10365: $pathchange_output .=
10366: &start_data_table_row().
10367: '<td><input type ="checkbox" name="namechange" value="'.
10368: $chgcount.'" checked="checked" /></td>'.
10369: '<td>'.$mapping{$embed_file}.'</td>'.
10370: '<td>'.$embed_file.
10371: &embedded_file_element('pathchange',$numpathchg,$embed_file,
1.1071 raeburn 10372: \%mapping,$allfiles,$codebase,'change').
1.987 raeburn 10373: '</td>'.&end_data_table_row();
1.660 raeburn 10374: }
1.987 raeburn 10375: $numpathchg ++;
10376: $chgcount ++;
1.660 raeburn 10377: }
10378: }
1.1127 raeburn 10379: if (($counter) || ($numunused)) {
1.987 raeburn 10380: if ($numpathchg) {
10381: $output .= '<input type ="hidden" name="number_pathchange_items" value="'.
10382: $numpathchg.'" />'."\n";
10383: }
10384: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank') ||
10385: ($actionurl eq '/adm/imsimport')) {
10386: $output .= '<input type="hidden" name="phase" value="three" />'."\n";
10387: } elsif ($actionurl eq '/adm/portfolio' || $actionurl eq '/adm/coursegrp_portfolio') {
10388: $output .= '<input type="hidden" name="action" value="upload_embedded" />';
1.1071 raeburn 10389: } elsif ($actionurl eq '/adm/dependencies') {
10390: $output .= '<input type="hidden" name="action" value="process_changes" />';
1.987 raeburn 10391: }
1.1123 raeburn 10392: $output .= '<input type ="submit" value="'.$buttontext.'" />'."\n".'</form>'."\n";
1.987 raeburn 10393: } elsif ($numpathchg) {
10394: my %pathchange = ();
10395: $output .= &modify_html_form('pathchange',$actionurl,$state,\%pathchange,$pathchange_output);
10396: if (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10397: $output .= '<p>'.&mt('or').'</p>';
1.1123 raeburn 10398: }
1.987 raeburn 10399: }
1.1071 raeburn 10400: return ($output,$counter,$numpathchg);
1.987 raeburn 10401: }
10402:
1.1147 raeburn 10403: =pod
10404:
10405: =item * clean_path($name)
10406:
10407: Performs clean-up of directories, subdirectories and filename in an
10408: embedded object, referenced in an HTML file which is being uploaded
10409: to a course or portfolio, where
10410: "Upload embedded images/multimedia files if HTML file" checkbox was
10411: checked.
10412:
10413: Clean-up is similar to replacements in lonnet::clean_filename()
10414: except each / between sub-directory and next level is preserved.
10415:
10416: =cut
10417:
10418: sub clean_path {
10419: my ($embed_file) = @_;
10420: $embed_file =~s{^/+}{};
10421: my @contents;
10422: if ($embed_file =~ m{/}) {
10423: @contents = split(/\//,$embed_file);
10424: } else {
10425: @contents = ($embed_file);
10426: }
10427: my $lastidx = scalar(@contents)-1;
10428: for (my $i=0; $i<=$lastidx; $i++) {
10429: $contents[$i]=~s{\\}{/}g;
10430: $contents[$i]=~s/\s+/\_/g;
10431: $contents[$i]=~s{[^/\w\.\-]}{}g;
10432: if ($i == $lastidx) {
10433: $contents[$i]=~s/\.(\d+)(?=\.)/_$1/g;
10434: }
10435: }
10436: if ($lastidx > 0) {
10437: return join('/',@contents);
10438: } else {
10439: return $contents[0];
10440: }
10441: }
10442:
1.987 raeburn 10443: sub embedded_file_element {
1.1071 raeburn 10444: my ($context,$num,$embed_file,$mapping,$allfiles,$codebase,$type) = @_;
1.987 raeburn 10445: return unless ((ref($mapping) eq 'HASH') && (ref($allfiles) eq 'HASH') &&
10446: (ref($codebase) eq 'HASH'));
10447: my $output;
1.1071 raeburn 10448: if (($context eq 'upload_embedded') && ($type ne 'delete')) {
1.987 raeburn 10449: $output = '<input name="embedded_item_'.$num.'" type="file" value="" />'."\n";
10450: }
10451: $output .= '<input name="embedded_orig_'.$num.'" type="hidden" value="'.
10452: &escape($embed_file).'" />';
10453: unless (($context eq 'upload_embedded') &&
10454: ($mapping->{$embed_file} eq $embed_file)) {
10455: $output .='
10456: <input name="embedded_ref_'.$num.'" type="hidden" value="'.&escape($mapping->{$embed_file}).'" />';
10457: }
10458: my $attrib;
10459: if (ref($allfiles->{$mapping->{$embed_file}}) eq 'ARRAY') {
10460: $attrib = &escape(join(':',@{$allfiles->{$mapping->{$embed_file}}}));
10461: }
10462: $output .=
10463: "\n\t\t".
10464: '<input name="embedded_attrib_'.$num.'" type="hidden" value="'.
10465: $attrib.'" />';
10466: if (exists($codebase->{$mapping->{$embed_file}})) {
10467: $output .=
10468: "\n\t\t".
10469: '<input name="codebase_'.$num.'" type="hidden" value="'.
10470: &escape($codebase->{$mapping->{$embed_file}}).'" />';
1.984 raeburn 10471: }
1.987 raeburn 10472: return $output;
1.660 raeburn 10473: }
10474:
1.1071 raeburn 10475: sub get_dependency_details {
10476: my ($currfile,$currsubfile,$embed_file) = @_;
10477: my ($size,$mtime,$showsize,$showmtime);
10478: if ((ref($currfile) eq 'HASH') && (ref($currsubfile))) {
10479: if ($embed_file =~ m{/}) {
10480: my ($path,$fname) = split(/\//,$embed_file);
10481: if (ref($currsubfile->{$path}{$fname}) eq 'ARRAY') {
10482: ($size,$mtime) = @{$currsubfile->{$path}{$fname}};
10483: }
10484: } else {
10485: if (ref($currfile->{$embed_file}) eq 'ARRAY') {
10486: ($size,$mtime) = @{$currfile->{$embed_file}};
10487: }
10488: }
10489: $showsize = $size/1024.0;
10490: $showsize = sprintf("%.1f",$showsize);
10491: if ($mtime > 0) {
10492: $showmtime = &Apache::lonlocal::locallocaltime($mtime);
10493: }
10494: }
10495: return ($showsize,$showmtime);
10496: }
10497:
10498: sub ask_embedded_js {
10499: return <<"END";
10500: <script type="text/javascript"">
10501: // <![CDATA[
10502: function toggleBrowse(counter) {
10503: var chkboxid = document.getElementById('mod_upload_dep_'+counter);
10504: var fileid = document.getElementById('embedded_item_'+counter);
10505: var uploaddivid = document.getElementById('moduploaddep_'+counter);
10506: if (chkboxid.checked == true) {
10507: uploaddivid.style.display='block';
10508: } else {
10509: uploaddivid.style.display='none';
10510: fileid.value = '';
10511: }
10512: }
10513: // ]]>
10514: </script>
10515:
10516: END
10517: }
10518:
1.661 raeburn 10519: sub upload_embedded {
10520: my ($context,$dirpath,$uname,$udom,$dir_root,$url_root,$group,$disk_quota,
1.987 raeburn 10521: $current_disk_usage,$hiddenstate,$actionurl) = @_;
10522: my (%pathchange,$output,$modifyform,$footer,$returnflag);
1.661 raeburn 10523: for (my $i=0; $i<$env{'form.number_embedded_items'}; $i++) {
10524: next if (!exists($env{'form.embedded_item_'.$i.'.filename'}));
10525: my $orig_uploaded_filename =
10526: $env{'form.embedded_item_'.$i.'.filename'};
1.987 raeburn 10527: foreach my $type ('orig','ref','attrib','codebase') {
10528: if ($env{'form.embedded_'.$type.'_'.$i} ne '') {
10529: $env{'form.embedded_'.$type.'_'.$i} =
10530: &unescape($env{'form.embedded_'.$type.'_'.$i});
10531: }
10532: }
1.661 raeburn 10533: my ($path,$fname) =
10534: ($env{'form.embedded_orig_'.$i} =~ m{(.*/)([^/]*)});
10535: # no path, whole string is fname
10536: if (!$fname) { $fname = $env{'form.embedded_orig_'.$i} };
10537: $fname = &Apache::lonnet::clean_filename($fname);
10538: # See if there is anything left
10539: next if ($fname eq '');
10540:
10541: # Check if file already exists as a file or directory.
10542: my ($state,$msg);
10543: if ($context eq 'portfolio') {
10544: my $port_path = $dirpath;
10545: if ($group ne '') {
10546: $port_path = "groups/$group/$port_path";
10547: }
1.987 raeburn 10548: ($state,$msg) = &check_for_upload($env{'form.currentpath'}.$path,
10549: $fname,$group,'embedded_item_'.$i,
1.661 raeburn 10550: $dir_root,$port_path,$disk_quota,
10551: $current_disk_usage,$uname,$udom);
10552: if ($state eq 'will_exceed_quota'
1.984 raeburn 10553: || $state eq 'file_locked') {
1.661 raeburn 10554: $output .= $msg;
10555: next;
10556: }
10557: } elsif (($context eq 'author') || ($context eq 'testbank')) {
10558: ($state,$msg) = &check_for_existing($path,$fname,'embedded_item_'.$i);
10559: if ($state eq 'exists') {
10560: $output .= $msg;
10561: next;
10562: }
10563: }
10564: # Check if extension is valid
10565: if (($fname =~ /\.(\w+)$/) &&
10566: (&Apache::loncommon::fileembstyle($1) eq 'hdn')) {
1.1155 bisitz 10567: $output .= &mt('Invalid file extension ([_1]) - reserved for internal use.',$1)
10568: .' '.&mt('Rename the file with a different extension and re-upload.').'<br />';
1.661 raeburn 10569: next;
10570: } elsif (($fname =~ /\.(\w+)$/) &&
10571: (!defined(&Apache::loncommon::fileembstyle($1)))) {
1.987 raeburn 10572: $output .= &mt('Unrecognized file extension ([_1]) - rename the file with a proper extension and re-upload.',$1).'<br />';
1.661 raeburn 10573: next;
10574: } elsif ($fname=~/\.(\d+)\.(\w+)$/) {
1.1120 bisitz 10575: $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 10576: next;
10577: }
10578: $env{'form.embedded_item_'.$i.'.filename'}=$fname;
1.1123 raeburn 10579: my $subdir = $path;
10580: $subdir =~ s{/+$}{};
1.661 raeburn 10581: if ($context eq 'portfolio') {
1.984 raeburn 10582: my $result;
10583: if ($state eq 'existingfile') {
10584: $result=
10585: &Apache::lonnet::userfileupload('embedded_item_'.$i,'existingfile',
1.1123 raeburn 10586: $dirpath.$env{'form.currentpath'}.$subdir);
1.661 raeburn 10587: } else {
1.984 raeburn 10588: $result=
10589: &Apache::lonnet::userfileupload('embedded_item_'.$i,'',
1.987 raeburn 10590: $dirpath.
1.1123 raeburn 10591: $env{'form.currentpath'}.$subdir);
1.984 raeburn 10592: if ($result !~ m|^/uploaded/|) {
10593: $output .= '<span class="LC_error">'
10594: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10595: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10596: .'</span><br />';
10597: next;
10598: } else {
1.987 raeburn 10599: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10600: $path.$fname.'</span>').'<br />';
1.984 raeburn 10601: }
1.661 raeburn 10602: }
1.1123 raeburn 10603: } elsif (($context eq 'coursedoc') || ($context eq 'syllabus')) {
1.1126 raeburn 10604: my $extendedsubdir = $dirpath.'/'.$subdir;
10605: $extendedsubdir =~ s{/+$}{};
1.987 raeburn 10606: my $result =
1.1126 raeburn 10607: &Apache::lonnet::userfileupload('embedded_item_'.$i,$context,$extendedsubdir);
1.987 raeburn 10608: if ($result !~ m|^/uploaded/|) {
10609: $output .= '<span class="LC_error">'
10610: .&mt('An error occurred ([_1]) while trying to upload [_2] for embedded element [_3].'
10611: ,$result,$orig_uploaded_filename,$env{'form.embedded_orig_'.$i})
10612: .'</span><br />';
10613: next;
10614: } else {
10615: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10616: $path.$fname.'</span>').'<br />';
1.1125 raeburn 10617: if ($context eq 'syllabus') {
10618: &Apache::lonnet::make_public_indefinitely($result);
10619: }
1.987 raeburn 10620: }
1.661 raeburn 10621: } else {
10622: # Save the file
10623: my $target = $env{'form.embedded_item_'.$i};
10624: my $fullpath = $dir_root.$dirpath.'/'.$path;
10625: my $dest = $fullpath.$fname;
10626: my $url = $url_root.$dirpath.'/'.$path.$fname;
1.1027 raeburn 10627: my @parts=split(/\//,"$dirpath/$path");
1.661 raeburn 10628: my $count;
10629: my $filepath = $dir_root;
1.1027 raeburn 10630: foreach my $subdir (@parts) {
10631: $filepath .= "/$subdir";
10632: if (!-e $filepath) {
1.661 raeburn 10633: mkdir($filepath,0770);
10634: }
10635: }
10636: my $fh;
10637: if (!open($fh,'>'.$dest)) {
10638: &Apache::lonnet::logthis('Failed to create '.$dest);
10639: $output .= '<span class="LC_error">'.
1.1071 raeburn 10640: &mt('An error occurred while trying to upload [_1] for embedded element [_2].',
10641: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10642: '</span><br />';
10643: } else {
10644: if (!print $fh $env{'form.embedded_item_'.$i}) {
10645: &Apache::lonnet::logthis('Failed to write to '.$dest);
10646: $output .= '<span class="LC_error">'.
1.1071 raeburn 10647: &mt('An error occurred while writing the file [_1] for embedded element [_2].',
10648: $orig_uploaded_filename,$env{'form.embedded_orig_'.$i}).
1.661 raeburn 10649: '</span><br />';
10650: } else {
1.987 raeburn 10651: $output .= &mt('Uploaded [_1]','<span class="LC_filename">'.
10652: $url.'</span>').'<br />';
10653: unless ($context eq 'testbank') {
10654: $footer .= &mt('View embedded file: [_1]',
10655: '<a href="'.$url.'">'.$fname.'</a>').'<br />';
10656: }
10657: }
10658: close($fh);
10659: }
10660: }
10661: if ($env{'form.embedded_ref_'.$i}) {
10662: $pathchange{$i} = 1;
10663: }
10664: }
10665: if ($output) {
10666: $output = '<p>'.$output.'</p>';
10667: }
10668: $output .= &modify_html_form('upload_embedded',$actionurl,$hiddenstate,\%pathchange);
10669: $returnflag = 'ok';
1.1071 raeburn 10670: my $numpathchgs = scalar(keys(%pathchange));
10671: if ($numpathchgs > 0) {
1.987 raeburn 10672: if ($context eq 'portfolio') {
10673: $output .= '<p>'.&mt('or').'</p>';
10674: } elsif ($context eq 'testbank') {
1.1071 raeburn 10675: $output .= '<p>'.&mt('Or [_1]continue[_2] the testbank import without modifying the reference(s).',
10676: '<a href="javascript:document.testbankForm.submit();">','</a>').'</p>';
1.987 raeburn 10677: $returnflag = 'modify_orightml';
10678: }
10679: }
1.1071 raeburn 10680: return ($output.$footer,$returnflag,$numpathchgs);
1.987 raeburn 10681: }
10682:
10683: sub modify_html_form {
10684: my ($context,$actionurl,$hiddenstate,$pathchange,$pathchgtable) = @_;
10685: my $end = 0;
10686: my $modifyform;
10687: if ($context eq 'upload_embedded') {
10688: return unless (ref($pathchange) eq 'HASH');
10689: if ($env{'form.number_embedded_items'}) {
10690: $end += $env{'form.number_embedded_items'};
10691: }
10692: if ($env{'form.number_pathchange_items'}) {
10693: $end += $env{'form.number_pathchange_items'};
10694: }
10695: if ($end) {
10696: for (my $i=0; $i<$end; $i++) {
10697: if ($i < $env{'form.number_embedded_items'}) {
10698: next unless($pathchange->{$i});
10699: }
10700: $modifyform .=
10701: &start_data_table_row().
10702: '<td><input type ="checkbox" name="namechange" value="'.$i.'" '.
10703: 'checked="checked" /></td>'.
10704: '<td>'.$env{'form.embedded_ref_'.$i}.
10705: '<input type="hidden" name="embedded_ref_'.$i.'" value="'.
10706: &escape($env{'form.embedded_ref_'.$i}).'" />'.
10707: '<input type="hidden" name="embedded_codebase_'.$i.'" value="'.
10708: &escape($env{'form.embedded_codebase_'.$i}).'" />'.
10709: '<input type="hidden" name="embedded_attrib_'.$i.'" value="'.
10710: &escape($env{'form.embedded_attrib_'.$i}).'" /></td>'.
10711: '<td>'.$env{'form.embedded_orig_'.$i}.
10712: '<input type="hidden" name="embedded_orig_'.$i.'" value="'.
10713: &escape($env{'form.embedded_orig_'.$i}).'" /></td>'.
10714: &end_data_table_row();
1.1071 raeburn 10715: }
1.987 raeburn 10716: }
10717: } else {
10718: $modifyform = $pathchgtable;
10719: if (($actionurl eq '/adm/upload') || ($actionurl eq '/adm/testbank')) {
10720: $hiddenstate .= '<input type="hidden" name="phase" value="four" />';
10721: } elsif (($actionurl eq '/adm/portfolio') || ($actionurl eq '/adm/coursegrp_portfolio')) {
10722: $hiddenstate .= '<input type="hidden" name="action" value="modify_orightml" />';
10723: }
10724: }
10725: if ($modifyform) {
1.1071 raeburn 10726: if ($actionurl eq '/adm/dependencies') {
10727: $hiddenstate .= '<input type="hidden" name="action" value="modifyhrefs" />';
10728: }
1.987 raeburn 10729: return '<h3>'.&mt('Changes in content of HTML file required').'</h3>'."\n".
10730: '<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".
10731: '<li>'.&mt('For consistency between the reference(s) and the location of the corresponding stored file within LON-CAPA.').'</li>'."\n".
10732: '<li>'.&mt('To change absolute paths to relative paths, or replace directory traversal via "../" within the original reference.').'</li>'."\n".
10733: '</ol></p>'."\n".'<p>'.
10734: &mt('LON-CAPA can make the required changes to your HTML file.').'</p>'."\n".
10735: '<form method="post" name="refchanger" action="'.$actionurl.'">'.
10736: &start_data_table()."\n".
10737: &start_data_table_header_row().
10738: '<th>'.&mt('Change?').'</th>'.
10739: '<th>'.&mt('Current reference').'</th>'.
10740: '<th>'.&mt('Required reference').'</th>'.
10741: &end_data_table_header_row()."\n".
10742: $modifyform.
10743: &end_data_table().'<br />'."\n".$hiddenstate.
10744: '<input type="submit" name="pathchanges" value="'.&mt('Modify HTML file').'" />'.
10745: '</form>'."\n";
10746: }
10747: return;
10748: }
10749:
10750: sub modify_html_refs {
1.1123 raeburn 10751: my ($context,$dirpath,$uname,$udom,$dir_root,$url) = @_;
1.987 raeburn 10752: my $container;
10753: if ($context eq 'portfolio') {
10754: $container = $env{'form.container'};
10755: } elsif ($context eq 'coursedoc') {
10756: $container = $env{'form.primaryurl'};
1.1071 raeburn 10757: } elsif ($context eq 'manage_dependencies') {
10758: (undef,undef,$container) = &Apache::lonnet::decode_symb($env{'form.symb'});
10759: $container = "/$container";
1.1123 raeburn 10760: } elsif ($context eq 'syllabus') {
10761: $container = $url;
1.987 raeburn 10762: } else {
1.1027 raeburn 10763: $container = $Apache::lonnet::perlvar{'lonDocRoot'}.$env{'form.filename'};
1.987 raeburn 10764: }
10765: my (%allfiles,%codebase,$output,$content);
10766: my @changes = &get_env_multiple('form.namechange');
1.1126 raeburn 10767: unless ((@changes > 0) || ($context eq 'syllabus')) {
1.1071 raeburn 10768: if (wantarray) {
10769: return ('',0,0);
10770: } else {
10771: return;
10772: }
10773: }
10774: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 10775: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.1071 raeburn 10776: unless ($container =~ m{^/uploaded/\Q$udom\E/\Q$uname\E/}) {
10777: if (wantarray) {
10778: return ('',0,0);
10779: } else {
10780: return;
10781: }
10782: }
1.987 raeburn 10783: $content = &Apache::lonnet::getfile($container);
1.1071 raeburn 10784: if ($content eq '-1') {
10785: if (wantarray) {
10786: return ('',0,0);
10787: } else {
10788: return;
10789: }
10790: }
1.987 raeburn 10791: } else {
1.1071 raeburn 10792: unless ($container =~ /^\Q$dir_root\E/) {
10793: if (wantarray) {
10794: return ('',0,0);
10795: } else {
10796: return;
10797: }
10798: }
1.987 raeburn 10799: if (open(my $fh,"<$container")) {
10800: $content = join('', <$fh>);
10801: close($fh);
10802: } else {
1.1071 raeburn 10803: if (wantarray) {
10804: return ('',0,0);
10805: } else {
10806: return;
10807: }
1.987 raeburn 10808: }
10809: }
10810: my ($count,$codebasecount) = (0,0);
10811: my $mm = new File::MMagic;
10812: my $mime_type = $mm->checktype_contents($content);
10813: if ($mime_type eq 'text/html') {
10814: my $parse_result =
10815: &Apache::lonnet::extract_embedded_items($container,\%allfiles,
10816: \%codebase,\$content);
10817: if ($parse_result eq 'ok') {
10818: foreach my $i (@changes) {
10819: my $orig = &unescape($env{'form.embedded_orig_'.$i});
10820: my $ref = &unescape($env{'form.embedded_ref_'.$i});
10821: if ($allfiles{$ref}) {
10822: my $newname = $orig;
10823: my ($attrib_regexp,$codebase);
1.1006 raeburn 10824: $attrib_regexp = &unescape($env{'form.embedded_attrib_'.$i});
1.987 raeburn 10825: if ($attrib_regexp =~ /:/) {
10826: $attrib_regexp =~ s/\:/|/g;
10827: }
10828: if ($content =~ m{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10829: my $numchg = ($content =~ s{($attrib_regexp\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10830: $count += $numchg;
1.1123 raeburn 10831: $allfiles{$newname} = $allfiles{$ref};
1.1148 raeburn 10832: delete($allfiles{$ref});
1.987 raeburn 10833: }
10834: if ($env{'form.embedded_codebase_'.$i} ne '') {
1.1006 raeburn 10835: $codebase = &unescape($env{'form.embedded_codebase_'.$i});
1.987 raeburn 10836: my $numchg = ($content =~ s/(codebase\s*=\s*["']?)\Q$codebase\E(["']?)/$1.$2/i); #' stupid emacs
10837: $codebasecount ++;
10838: }
10839: }
10840: }
1.1123 raeburn 10841: my $skiprewrites;
1.987 raeburn 10842: if ($count || $codebasecount) {
10843: my $saveresult;
1.1071 raeburn 10844: if (($context eq 'portfolio') || ($context eq 'coursedoc') ||
1.1123 raeburn 10845: ($context eq 'manage_dependencies') || ($context eq 'syllabus')) {
1.987 raeburn 10846: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10847: if ($url eq $container) {
10848: my ($fname) = ($container =~ m{/([^/]+)$});
10849: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10850: $count,'<span class="LC_filename">'.
1.1071 raeburn 10851: $fname.'</span>').'</p>';
1.987 raeburn 10852: } else {
10853: $output = '<p class="LC_error">'.
10854: &mt('Error: update failed for: [_1].',
10855: '<span class="LC_filename">'.
10856: $container.'</span>').'</p>';
10857: }
1.1123 raeburn 10858: if ($context eq 'syllabus') {
10859: unless ($saveresult eq 'ok') {
10860: $skiprewrites = 1;
10861: }
10862: }
1.987 raeburn 10863: } else {
10864: if (open(my $fh,">$container")) {
10865: print $fh $content;
10866: close($fh);
10867: $output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
10868: $count,'<span class="LC_filename">'.
10869: $container.'</span>').'</p>';
1.661 raeburn 10870: } else {
1.987 raeburn 10871: $output = '<p class="LC_error">'.
10872: &mt('Error: could not update [_1].',
10873: '<span class="LC_filename">'.
10874: $container.'</span>').'</p>';
1.661 raeburn 10875: }
10876: }
10877: }
1.1123 raeburn 10878: if (($context eq 'syllabus') && (!$skiprewrites)) {
10879: my ($actionurl,$state);
10880: $actionurl = "/public/$udom/$uname/syllabus";
10881: my ($ignore,$num,$numpathchanges,$existing,$mapping) =
10882: &ask_for_embedded_content($actionurl,$state,\%allfiles,
10883: \%codebase,
10884: {'context' => 'rewrites',
10885: 'ignore_remote_references' => 1,});
10886: if (ref($mapping) eq 'HASH') {
10887: my $rewrites = 0;
10888: foreach my $key (keys(%{$mapping})) {
10889: next if ($key =~ m{^https?://});
10890: my $ref = $mapping->{$key};
10891: my $newname = "/uploaded/$udom/$uname/portfolio/syllabus/$key";
10892: my $attrib;
10893: if (ref($allfiles{$mapping->{$key}}) eq 'ARRAY') {
10894: $attrib = join('|',@{$allfiles{$mapping->{$key}}});
10895: }
10896: if ($content =~ m{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}) {
10897: my $numchg = ($content =~ s{($attrib\s*=\s*['"]?)\Q$ref\E(['"]?)}{$1$newname$2}gi);
10898: $rewrites += $numchg;
10899: }
10900: }
10901: if ($rewrites) {
10902: my $saveresult;
10903: my $url = &Apache::lonnet::store_edited_file($container,$content,$udom,$uname,\$saveresult);
10904: if ($url eq $container) {
10905: my ($fname) = ($container =~ m{/([^/]+)$});
10906: $output .= '<p>'.&mt('Rewrote [quant,_1,link] as [quant,_1,absolute link] in [_2].',
10907: $count,'<span class="LC_filename">'.
10908: $fname.'</span>').'</p>';
10909: } else {
10910: $output .= '<p class="LC_error">'.
10911: &mt('Error: could not update links in [_1].',
10912: '<span class="LC_filename">'.
10913: $container.'</span>').'</p>';
10914:
10915: }
10916: }
10917: }
10918: }
1.987 raeburn 10919: } else {
10920: &logthis('Failed to parse '.$container.
10921: ' to modify references: '.$parse_result);
1.661 raeburn 10922: }
10923: }
1.1071 raeburn 10924: if (wantarray) {
10925: return ($output,$count,$codebasecount);
10926: } else {
10927: return $output;
10928: }
1.661 raeburn 10929: }
10930:
10931: sub check_for_existing {
10932: my ($path,$fname,$element) = @_;
10933: my ($state,$msg);
10934: if (-d $path.'/'.$fname) {
10935: $state = 'exists';
10936: $msg = &mt('Unable to upload [_1]. A directory by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10937: } elsif (-e $path.'/'.$fname) {
10938: $state = 'exists';
10939: $msg = &mt('Unable to upload [_1]. A file by that name was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$path);
10940: }
10941: if ($state eq 'exists') {
10942: $msg = '<span class="LC_error">'.$msg.'</span><br />';
10943: }
10944: return ($state,$msg);
10945: }
10946:
10947: sub check_for_upload {
10948: my ($path,$fname,$group,$element,$portfolio_root,$port_path,
10949: $disk_quota,$current_disk_usage,$uname,$udom) = @_;
1.985 raeburn 10950: my $filesize = length($env{'form.'.$element});
10951: if (!$filesize) {
10952: my $msg = '<span class="LC_error">'.
10953: &mt('Unable to upload [_1]. (size = [_2] bytes)',
10954: '<span class="LC_filename">'.$fname.'</span>',
10955: $filesize).'<br />'.
1.1007 raeburn 10956: &mt('Either the file you attempted to upload was empty, or your web browser was unable to read its contents.').'<br />'.
1.985 raeburn 10957: '</span>';
10958: return ('zero_bytes',$msg);
10959: }
10960: $filesize = $filesize/1000; #express in k (1024?)
1.661 raeburn 10961: my $getpropath = 1;
1.1021 raeburn 10962: my ($dirlistref,$listerror) =
10963: &Apache::lonnet::dirlist($portfolio_root.$path,$udom,$uname,$getpropath);
1.661 raeburn 10964: my $found_file = 0;
10965: my $locked_file = 0;
1.991 raeburn 10966: my @lockers;
10967: my $navmap;
10968: if ($env{'request.course.id'}) {
10969: $navmap = Apache::lonnavmaps::navmap->new();
10970: }
1.1021 raeburn 10971: if (ref($dirlistref) eq 'ARRAY') {
10972: foreach my $line (@{$dirlistref}) {
10973: my ($file_name,$rest)=split(/\&/,$line,2);
10974: if ($file_name eq $fname){
10975: $file_name = $path.$file_name;
10976: if ($group ne '') {
10977: $file_name = $group.$file_name;
10978: }
10979: $found_file = 1;
10980: if (&Apache::lonnet::is_locked($file_name,$udom,$uname,\@lockers) eq 'true') {
10981: foreach my $lock (@lockers) {
10982: if (ref($lock) eq 'ARRAY') {
10983: my ($symb,$crsid) = @{$lock};
10984: if ($crsid eq $env{'request.course.id'}) {
10985: if (ref($navmap)) {
10986: my $res = $navmap->getBySymb($symb);
10987: foreach my $part (@{$res->parts()}) {
10988: my ($slot_status,$slot_time,$slot_name)=$res->check_for_slot($part);
10989: unless (($slot_status == $res->RESERVED) ||
10990: ($slot_status == $res->RESERVED_LOCATION)) {
10991: $locked_file = 1;
10992: }
1.991 raeburn 10993: }
1.1021 raeburn 10994: } else {
10995: $locked_file = 1;
1.991 raeburn 10996: }
10997: } else {
10998: $locked_file = 1;
10999: }
11000: }
1.1021 raeburn 11001: }
11002: } else {
11003: my @info = split(/\&/,$rest);
11004: my $currsize = $info[6]/1000;
11005: if ($currsize < $filesize) {
11006: my $extra = $filesize - $currsize;
11007: if (($current_disk_usage + $extra) > $disk_quota) {
1.1179 bisitz 11008: my $msg = '<p class="LC_warning">'.
1.1021 raeburn 11009: &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.1179 bisitz 11010: '<span class="LC_filename">'.$fname.'</span>',$filesize,$currsize).'</p>'.
11011: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',
11012: $disk_quota,$current_disk_usage).'</p>';
1.1021 raeburn 11013: return ('will_exceed_quota',$msg);
11014: }
1.984 raeburn 11015: }
11016: }
1.661 raeburn 11017: }
11018: }
11019: }
11020: if (($current_disk_usage + $filesize) > $disk_quota){
1.1179 bisitz 11021: my $msg = '<p class="LC_warning">'.
11022: &mt('Unable to upload [_1]. (size = [_2] kilobytes). Disk quota will be exceeded.','<span class="LC_filename">'.$fname.'</span>',$filesize).'</p>'.
1.1184 raeburn 11023: '<p>'.&mt('Disk quota is [_1] kilobytes. Your current disk usage is [_2] kilobytes.',$disk_quota,$current_disk_usage).'</p>';
1.661 raeburn 11024: return ('will_exceed_quota',$msg);
11025: } elsif ($found_file) {
11026: if ($locked_file) {
1.1179 bisitz 11027: my $msg = '<p class="LC_warning">';
1.661 raeburn 11028: $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.1179 bisitz 11029: $msg .= '</p>';
1.661 raeburn 11030: $msg .= &mt('You will be able to rename or delete existing [_1] after a grade has been assigned.','<span class="LC_filename">'.$fname.'</span>');
11031: return ('file_locked',$msg);
11032: } else {
1.1179 bisitz 11033: my $msg = '<p class="LC_error">';
1.984 raeburn 11034: $msg .= &mt(' A file by that name: [_1] was found in [_2].','<span class="LC_filename">'.$fname.'</span>',$port_path.$env{'form.currentpath'});
1.1179 bisitz 11035: $msg .= '</p>';
1.984 raeburn 11036: return ('existingfile',$msg);
1.661 raeburn 11037: }
11038: }
11039: }
11040:
1.987 raeburn 11041: sub check_for_traversal {
11042: my ($path,$url,$toplevel) = @_;
11043: my @parts=split(/\//,$path);
11044: my $cleanpath;
11045: my $fullpath = $url;
11046: for (my $i=0;$i<@parts;$i++) {
11047: next if ($parts[$i] eq '.');
11048: if ($parts[$i] eq '..') {
11049: $fullpath =~ s{([^/]+/)$}{};
11050: } else {
11051: $fullpath .= $parts[$i].'/';
11052: }
11053: }
11054: if ($fullpath =~ /^\Q$url\E(.*)$/) {
11055: $cleanpath = $1;
11056: } elsif ($fullpath =~ /^\Q$toplevel\E(.*)$/) {
11057: my $curr_toprel = $1;
11058: my @parts = split(/\//,$curr_toprel);
11059: my ($url_toprel) = ($url =~ /^\Q$toplevel\E(.*)$/);
11060: my @urlparts = split(/\//,$url_toprel);
11061: my $doubledots;
11062: my $startdiff = -1;
11063: for (my $i=0; $i<@urlparts; $i++) {
11064: if ($startdiff == -1) {
11065: unless ($urlparts[$i] eq $parts[$i]) {
11066: $startdiff = $i;
11067: $doubledots .= '../';
11068: }
11069: } else {
11070: $doubledots .= '../';
11071: }
11072: }
11073: if ($startdiff > -1) {
11074: $cleanpath = $doubledots;
11075: for (my $i=$startdiff; $i<@parts; $i++) {
11076: $cleanpath .= $parts[$i].'/';
11077: }
11078: }
11079: }
11080: $cleanpath =~ s{(/)$}{};
11081: return $cleanpath;
11082: }
1.31 albertel 11083:
1.1053 raeburn 11084: sub is_archive_file {
11085: my ($mimetype) = @_;
11086: if (($mimetype eq 'application/octet-stream') ||
11087: ($mimetype eq 'application/x-stuffit') ||
11088: ($mimetype =~ m{^application/(x\-)?(compressed|tar|zip|tgz|gz|gtar|gzip|gunzip|bz|bz2|bzip2)})) {
11089: return 1;
11090: }
11091: return;
11092: }
11093:
11094: sub decompress_form {
1.1065 raeburn 11095: my ($mimetype,$archiveurl,$action,$noextract,$hiddenelements,$dirlist) = @_;
1.1053 raeburn 11096: my %lt = &Apache::lonlocal::texthash (
11097: this => 'This file is an archive file.',
1.1067 raeburn 11098: camt => 'This file is a Camtasia archive file.',
1.1065 raeburn 11099: itsc => 'Its contents are as follows:',
1.1053 raeburn 11100: youm => 'You may wish to extract its contents.',
11101: extr => 'Extract contents',
1.1067 raeburn 11102: auto => 'LON-CAPA can process the files automatically, or you can decide how each should be handled.',
11103: proa => 'Process automatically?',
1.1053 raeburn 11104: yes => 'Yes',
11105: no => 'No',
1.1067 raeburn 11106: fold => 'Title for folder containing movie',
11107: movi => 'Title for page containing embedded movie',
1.1053 raeburn 11108: );
1.1065 raeburn 11109: my $fileloc = &Apache::lonnet::filelocation(undef,$archiveurl);
1.1067 raeburn 11110: my ($is_camtasia,$topdir,%toplevel,@paths);
1.1065 raeburn 11111: my $info = &list_archive_contents($fileloc,\@paths);
11112: if (@paths) {
11113: foreach my $path (@paths) {
11114: $path =~ s{^/}{};
1.1067 raeburn 11115: if ($path =~ m{^([^/]+)/$}) {
11116: $topdir = $1;
11117: }
1.1065 raeburn 11118: if ($path =~ m{^([^/]+)/}) {
11119: $toplevel{$1} = $path;
11120: } else {
11121: $toplevel{$path} = $path;
11122: }
11123: }
11124: }
1.1067 raeburn 11125: if ($mimetype =~ m{^application/(x\-)?(compressed|zip)}) {
1.1164 raeburn 11126: my @camtasia6 = ("$topdir/","$topdir/index.html",
1.1067 raeburn 11127: "$topdir/media/",
11128: "$topdir/media/$topdir.mp4",
11129: "$topdir/media/FirstFrame.png",
11130: "$topdir/media/player.swf",
11131: "$topdir/media/swfobject.js",
11132: "$topdir/media/expressInstall.swf");
1.1197 raeburn 11133: my @camtasia8_1 = ("$topdir/","$topdir/$topdir.html",
1.1164 raeburn 11134: "$topdir/$topdir.mp4",
11135: "$topdir/$topdir\_config.xml",
11136: "$topdir/$topdir\_controller.swf",
11137: "$topdir/$topdir\_embed.css",
11138: "$topdir/$topdir\_First_Frame.png",
11139: "$topdir/$topdir\_player.html",
11140: "$topdir/$topdir\_Thumbnails.png",
11141: "$topdir/playerProductInstall.swf",
11142: "$topdir/scripts/",
11143: "$topdir/scripts/config_xml.js",
11144: "$topdir/scripts/handlebars.js",
11145: "$topdir/scripts/jquery-1.7.1.min.js",
11146: "$topdir/scripts/jquery-ui-1.8.15.custom.min.js",
11147: "$topdir/scripts/modernizr.js",
11148: "$topdir/scripts/player-min.js",
11149: "$topdir/scripts/swfobject.js",
11150: "$topdir/skins/",
11151: "$topdir/skins/configuration_express.xml",
11152: "$topdir/skins/express_show/",
11153: "$topdir/skins/express_show/player-min.css",
11154: "$topdir/skins/express_show/spritesheet.png");
1.1197 raeburn 11155: my @camtasia8_4 = ("$topdir/","$topdir/$topdir.html",
11156: "$topdir/$topdir.mp4",
11157: "$topdir/$topdir\_config.xml",
11158: "$topdir/$topdir\_controller.swf",
11159: "$topdir/$topdir\_embed.css",
11160: "$topdir/$topdir\_First_Frame.png",
11161: "$topdir/$topdir\_player.html",
11162: "$topdir/$topdir\_Thumbnails.png",
11163: "$topdir/playerProductInstall.swf",
11164: "$topdir/scripts/",
11165: "$topdir/scripts/config_xml.js",
11166: "$topdir/scripts/techsmith-smart-player.min.js",
11167: "$topdir/skins/",
11168: "$topdir/skins/configuration_express.xml",
11169: "$topdir/skins/express_show/",
11170: "$topdir/skins/express_show/spritesheet.min.css",
11171: "$topdir/skins/express_show/spritesheet.png",
11172: "$topdir/skins/express_show/techsmith-smart-player.min.css");
1.1164 raeburn 11173: my @diffs = &compare_arrays(\@paths,\@camtasia6);
1.1067 raeburn 11174: if (@diffs == 0) {
1.1164 raeburn 11175: $is_camtasia = 6;
11176: } else {
1.1197 raeburn 11177: @diffs = &compare_arrays(\@paths,\@camtasia8_1);
1.1164 raeburn 11178: if (@diffs == 0) {
11179: $is_camtasia = 8;
1.1197 raeburn 11180: } else {
11181: @diffs = &compare_arrays(\@paths,\@camtasia8_4);
11182: if (@diffs == 0) {
11183: $is_camtasia = 8;
11184: }
1.1164 raeburn 11185: }
1.1067 raeburn 11186: }
11187: }
11188: my $output;
11189: if ($is_camtasia) {
11190: $output = <<"ENDCAM";
11191: <script type="text/javascript" language="Javascript">
11192: // <![CDATA[
11193:
11194: function camtasiaToggle() {
11195: for (var i=0; i<document.uploaded_decompress.autoextract_camtasia.length; i++) {
11196: if (document.uploaded_decompress.autoextract_camtasia[i].checked) {
1.1164 raeburn 11197: if (document.uploaded_decompress.autoextract_camtasia[i].value == $is_camtasia) {
1.1067 raeburn 11198:
11199: document.getElementById('camtasia_titles').style.display='block';
11200: } else {
11201: document.getElementById('camtasia_titles').style.display='none';
11202: }
11203: }
11204: }
11205: return;
11206: }
11207:
11208: // ]]>
11209: </script>
11210: <p>$lt{'camt'}</p>
11211: ENDCAM
1.1065 raeburn 11212: } else {
1.1067 raeburn 11213: $output = '<p>'.$lt{'this'};
11214: if ($info eq '') {
11215: $output .= ' '.$lt{'youm'}.'</p>'."\n";
11216: } else {
11217: $output .= ' '.$lt{'itsc'}.'</p>'."\n".
11218: '<div><pre>'.$info.'</pre></div>';
11219: }
1.1065 raeburn 11220: }
1.1067 raeburn 11221: $output .= '<form name="uploaded_decompress" action="'.$action.'" method="post">'."\n";
1.1065 raeburn 11222: my $duplicates;
11223: my $num = 0;
11224: if (ref($dirlist) eq 'ARRAY') {
11225: foreach my $item (@{$dirlist}) {
11226: if (ref($item) eq 'ARRAY') {
11227: if (exists($toplevel{$item->[0]})) {
11228: $duplicates .=
11229: &start_data_table_row().
11230: '<td><label><input type="radio" name="archive_overwrite_'.$num.'" '.
11231: 'value="0" checked="checked" />'.&mt('No').'</label>'.
11232: ' <label><input type="radio" name="archive_overwrite_'.$num.'" '.
11233: 'value="1" />'.&mt('Yes').'</label>'.
11234: '<input type="hidden" name="archive_overwrite_name_'.$num.'" value="'.$item->[0].'" /></td>'."\n".
11235: '<td>'.$item->[0].'</td>';
11236: if ($item->[2]) {
11237: $duplicates .= '<td>'.&mt('Directory').'</td>';
11238: } else {
11239: $duplicates .= '<td>'.&mt('File').'</td>';
11240: }
11241: $duplicates .= '<td>'.$item->[3].'</td>'.
11242: '<td>'.
11243: &Apache::lonlocal::locallocaltime($item->[4]).
11244: '</td>'.
11245: &end_data_table_row();
11246: $num ++;
11247: }
11248: }
11249: }
11250: }
11251: my $itemcount;
11252: if (@paths > 0) {
11253: $itemcount = scalar(@paths);
11254: } else {
11255: $itemcount = 1;
11256: }
1.1067 raeburn 11257: if ($is_camtasia) {
11258: $output .= $lt{'auto'}.'<br />'.
11259: '<span class="LC_nobreak">'.$lt{'proa'}.'<label>'.
1.1164 raeburn 11260: '<input type="radio" name="autoextract_camtasia" value="'.$is_camtasia.'" onclick="javascript:camtasiaToggle();" checked="checked" />'.
1.1067 raeburn 11261: $lt{'yes'}.'</label> <label>'.
11262: '<input type="radio" name="autoextract_camtasia" value="0" onclick="javascript:camtasiaToggle();" />'.
11263: $lt{'no'}.'</label></span><br />'.
11264: '<div id="camtasia_titles" style="display:block">'.
11265: &Apache::lonhtmlcommon::start_pick_box().
11266: &Apache::lonhtmlcommon::row_title($lt{'fold'}).
11267: '<input type="textbox" name="camtasia_foldername" value="'.$env{'form.comment'}.'" />'."\n".
11268: &Apache::lonhtmlcommon::row_closure().
11269: &Apache::lonhtmlcommon::row_title($lt{'movi'}).
11270: '<input type="textbox" name="camtasia_moviename" value="" />'."\n".
11271: &Apache::lonhtmlcommon::row_closure(1).
11272: &Apache::lonhtmlcommon::end_pick_box().
11273: '</div>';
11274: }
1.1065 raeburn 11275: $output .=
11276: '<input type="hidden" name="archive_overwrite_total" value="'.$num.'" />'.
1.1067 raeburn 11277: '<input type="hidden" name="archive_itemcount" value="'.$itemcount.'" />'.
11278: "\n";
1.1065 raeburn 11279: if ($duplicates ne '') {
11280: $output .= '<p><span class="LC_warning">'.
11281: &mt('Warning: decompression of the archive will overwrite the following items which already exist:').'</span><br />'.
11282: &start_data_table().
11283: &start_data_table_header_row().
11284: '<th>'.&mt('Overwrite?').'</th>'.
11285: '<th>'.&mt('Name').'</th>'.
11286: '<th>'.&mt('Type').'</th>'.
11287: '<th>'.&mt('Size').'</th>'.
11288: '<th>'.&mt('Last modified').'</th>'.
11289: &end_data_table_header_row().
11290: $duplicates.
11291: &end_data_table().
11292: '</p>';
11293: }
1.1067 raeburn 11294: $output .= '<input type="hidden" name="archiveurl" value="'.$archiveurl.'" />'."\n";
1.1053 raeburn 11295: if (ref($hiddenelements) eq 'HASH') {
11296: foreach my $hidden (sort(keys(%{$hiddenelements}))) {
11297: $output .= '<input type="hidden" name="'.$hidden.'" value="'.$hiddenelements->{$hidden}.'" />'."\n";
11298: }
11299: }
11300: $output .= <<"END";
1.1067 raeburn 11301: <br />
1.1053 raeburn 11302: <input type="submit" name="decompress" value="$lt{'extr'}" />
11303: </form>
11304: $noextract
11305: END
11306: return $output;
11307: }
11308:
1.1065 raeburn 11309: sub decompression_utility {
11310: my ($program) = @_;
11311: my @utilities = ('tar','gunzip','bunzip2','unzip');
11312: my $location;
11313: if (grep(/^\Q$program\E$/,@utilities)) {
11314: foreach my $dir ('/bin/','/usr/bin/','/usr/local/bin/','/sbin/',
11315: '/usr/sbin/') {
11316: if (-x $dir.$program) {
11317: $location = $dir.$program;
11318: last;
11319: }
11320: }
11321: }
11322: return $location;
11323: }
11324:
11325: sub list_archive_contents {
11326: my ($file,$pathsref) = @_;
11327: my (@cmd,$output);
11328: my $needsregexp;
11329: if ($file =~ /\.zip$/) {
11330: @cmd = (&decompression_utility('unzip'),"-l");
11331: $needsregexp = 1;
11332: } elsif (($file =~ m/\.tar\.gz$/) ||
11333: ($file =~ /\.tgz$/)) {
11334: @cmd = (&decompression_utility('tar'),"-ztf");
11335: } elsif ($file =~ /\.tar\.bz2$/) {
11336: @cmd = (&decompression_utility('tar'),"-jtf");
11337: } elsif ($file =~ m|\.tar$|) {
11338: @cmd = (&decompression_utility('tar'),"-tf");
11339: }
11340: if (@cmd) {
11341: undef($!);
11342: undef($@);
11343: if (open(my $fh,"-|", @cmd, $file)) {
11344: while (my $line = <$fh>) {
11345: $output .= $line;
11346: chomp($line);
11347: my $item;
11348: if ($needsregexp) {
11349: ($item) = ($line =~ /^\s*\d+\s+[\d\-]+\s+[\d:]+\s*(.+)$/);
11350: } else {
11351: $item = $line;
11352: }
11353: if ($item ne '') {
11354: unless (grep(/^\Q$item\E$/,@{$pathsref})) {
11355: push(@{$pathsref},$item);
11356: }
11357: }
11358: }
11359: close($fh);
11360: }
11361: }
11362: return $output;
11363: }
11364:
1.1053 raeburn 11365: sub decompress_uploaded_file {
11366: my ($file,$dir) = @_;
11367: &Apache::lonnet::appenv({'cgi.file' => $file});
11368: &Apache::lonnet::appenv({'cgi.dir' => $dir});
11369: my $result = &Apache::lonnet::ssi_body('/cgi-bin/decompress.pl');
11370: my ($handle) = ($env{'user.environment'} =~m{/([^/]+)\.id$});
11371: my $lonidsdir = $Apache::lonnet::perlvar{'lonIDsDir'};
11372: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle,1);
11373: my $decompressed = $env{'cgi.decompressed'};
11374: &Apache::lonnet::delenv('cgi.file');
11375: &Apache::lonnet::delenv('cgi.dir');
11376: &Apache::lonnet::delenv('cgi.decompressed');
11377: return ($decompressed,$result);
11378: }
11379:
1.1055 raeburn 11380: sub process_decompression {
11381: my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
11382: my ($dir,$error,$warning,$output);
1.1180 raeburn 11383: if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
1.1120 bisitz 11384: $error = &mt('Filename not a supported archive file type.').
11385: '<br />'.&mt('Filename should end with one of: [_1].',
1.1055 raeburn 11386: '.zip, .tar, .bz2, .gz, .tar.gz, .tar.bz2, .tgz');
11387: } else {
11388: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11389: if ($docuhome eq 'no_host') {
11390: $error = &mt('Could not determine home server for course.');
11391: } else {
11392: my @ids=&Apache::lonnet::current_machine_ids();
11393: my $currdir = "$dir_root/$destination";
11394: if (grep(/^\Q$docuhome\E$/,@ids)) {
11395: $dir = &LONCAPA::propath($docudom,$docuname).
11396: "$dir_root/$destination";
11397: } else {
11398: $dir = $Apache::lonnet::perlvar{'lonDocRoot'}.
11399: "$dir_root/$docudom/$docuname/$destination";
11400: unless (&Apache::lonnet::repcopy_userfile("$dir/$file") eq 'ok') {
11401: $error = &mt('Archive file not found.');
11402: }
11403: }
1.1065 raeburn 11404: my (@to_overwrite,@to_skip);
11405: if ($env{'form.archive_overwrite_total'} > 0) {
11406: my $total = $env{'form.archive_overwrite_total'};
11407: for (my $i=0; $i<$total; $i++) {
11408: if ($env{'form.archive_overwrite_'.$i} == 1) {
11409: push(@to_overwrite,$env{'form.archive_overwrite_name_'.$i});
11410: } elsif ($env{'form.archive_overwrite_'.$i} == 0) {
11411: push(@to_skip,$env{'form.archive_overwrite_name_'.$i});
11412: }
11413: }
11414: }
11415: my $numskip = scalar(@to_skip);
11416: if (($numskip > 0) &&
11417: ($numskip == $env{'form.archive_itemcount'})) {
11418: $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
11419: } elsif ($dir eq '') {
1.1055 raeburn 11420: $error = &mt('Directory containing archive file unavailable.');
11421: } elsif (!$error) {
1.1065 raeburn 11422: my ($decompressed,$display);
11423: if ($numskip > 0) {
11424: my $tempdir = time.'_'.$$.int(rand(10000));
11425: mkdir("$dir/$tempdir",0755);
11426: system("mv $dir/$file $dir/$tempdir/$file");
11427: ($decompressed,$display) =
11428: &decompress_uploaded_file($file,"$dir/$tempdir");
11429: foreach my $item (@to_skip) {
11430: if (($item ne '') && ($item !~ /\.\./)) {
11431: if (-f "$dir/$tempdir/$item") {
11432: unlink("$dir/$tempdir/$item");
11433: } elsif (-d "$dir/$tempdir/$item") {
11434: system("rm -rf $dir/$tempdir/$item");
11435: }
11436: }
11437: }
11438: system("mv $dir/$tempdir/* $dir");
11439: rmdir("$dir/$tempdir");
11440: } else {
11441: ($decompressed,$display) =
11442: &decompress_uploaded_file($file,$dir);
11443: }
1.1055 raeburn 11444: if ($decompressed eq 'ok') {
1.1065 raeburn 11445: $output = '<p class="LC_info">'.
11446: &mt('Files extracted successfully from archive.').
11447: '</p>'."\n";
1.1055 raeburn 11448: my ($warning,$result,@contents);
11449: my ($newdirlistref,$newlisterror) =
11450: &Apache::lonnet::dirlist($currdir,$docudom,
11451: $docuname,1);
11452: my (%is_dir,%changes,@newitems);
11453: my $dirptr = 16384;
1.1065 raeburn 11454: if (ref($newdirlistref) eq 'ARRAY') {
1.1055 raeburn 11455: foreach my $dir_line (@{$newdirlistref}) {
11456: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
1.1065 raeburn 11457: unless (($item =~ /^\.+$/) || ($item eq $file) ||
11458: ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
1.1055 raeburn 11459: push(@newitems,$item);
11460: if ($dirptr&$testdir) {
11461: $is_dir{$item} = 1;
11462: }
11463: $changes{$item} = 1;
11464: }
11465: }
11466: }
11467: if (keys(%changes) > 0) {
11468: foreach my $item (sort(@newitems)) {
11469: if ($changes{$item}) {
11470: push(@contents,$item);
11471: }
11472: }
11473: }
11474: if (@contents > 0) {
1.1067 raeburn 11475: my $wantform;
11476: unless ($env{'form.autoextract_camtasia'}) {
11477: $wantform = 1;
11478: }
1.1056 raeburn 11479: my (%children,%parent,%dirorder,%titles);
1.1055 raeburn 11480: my ($count,$datatable) = &get_extracted($docudom,$docuname,
11481: $currdir,\%is_dir,
11482: \%children,\%parent,
1.1056 raeburn 11483: \@contents,\%dirorder,
11484: \%titles,$wantform);
1.1055 raeburn 11485: if ($datatable ne '') {
11486: $output .= &archive_options_form('decompressed',$datatable,
11487: $count,$hiddenelem);
1.1065 raeburn 11488: my $startcount = 6;
1.1055 raeburn 11489: $output .= &archive_javascript($startcount,$count,
1.1056 raeburn 11490: \%titles,\%children);
1.1055 raeburn 11491: }
1.1067 raeburn 11492: if ($env{'form.autoextract_camtasia'}) {
1.1164 raeburn 11493: my $version = $env{'form.autoextract_camtasia'};
1.1067 raeburn 11494: my %displayed;
11495: my $total = 1;
11496: $env{'form.archive_directory'} = [];
11497: foreach my $i (sort { $a <=> $b } keys(%dirorder)) {
11498: my $path = join('/',map { $titles{$_}; } @{$dirorder{$i}});
11499: $path =~ s{/$}{};
11500: my $item;
11501: if ($path ne '') {
11502: $item = "$path/$titles{$i}";
11503: } else {
11504: $item = $titles{$i};
11505: }
11506: $env{'form.archive_content_'.$i} = "$dir_root/$destination/$item";
11507: if ($item eq $contents[0]) {
11508: push(@{$env{'form.archive_directory'}},$i);
11509: $env{'form.archive_'.$i} = 'display';
11510: $env{'form.archive_title_'.$i} = $env{'form.camtasia_foldername'};
11511: $displayed{'folder'} = $i;
1.1164 raeburn 11512: } elsif ((($item eq "$contents[0]/index.html") && ($version == 6)) ||
11513: (($item eq "$contents[0]/$contents[0]".'.html') && ($version == 8))) {
1.1067 raeburn 11514: $env{'form.archive_'.$i} = 'display';
11515: $env{'form.archive_title_'.$i} = $env{'form.camtasia_moviename'};
11516: $displayed{'web'} = $i;
11517: } else {
1.1164 raeburn 11518: if ((($item eq "$contents[0]/media") && ($version == 6)) ||
11519: ((($item eq "$contents[0]/scripts") || ($item eq "$contents[0]/skins") ||
11520: ($item eq "$contents[0]/skins/express_show")) && ($version == 8))) {
1.1067 raeburn 11521: push(@{$env{'form.archive_directory'}},$i);
11522: }
11523: $env{'form.archive_'.$i} = 'dependency';
11524: }
11525: $total ++;
11526: }
11527: for (my $i=1; $i<$total; $i++) {
11528: next if ($i == $displayed{'web'});
11529: next if ($i == $displayed{'folder'});
11530: $env{'form.archive_dependent_on_'.$i} = $displayed{'web'};
11531: }
11532: $env{'form.phase'} = 'decompress_cleanup';
11533: $env{'form.archivedelete'} = 1;
11534: $env{'form.archive_count'} = $total-1;
11535: $output .=
11536: &process_extracted_files('coursedocs',$docudom,
11537: $docuname,$destination,
11538: $dir_root,$hiddenelem);
11539: }
1.1055 raeburn 11540: } else {
11541: $warning = &mt('No new items extracted from archive file.');
11542: }
11543: } else {
11544: $output = $display;
11545: $error = &mt('An error occurred during extraction from the archive file.');
11546: }
11547: }
11548: }
11549: }
11550: if ($error) {
11551: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
11552: $error.'</p>'."\n";
11553: }
11554: if ($warning) {
11555: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
11556: }
11557: return $output;
11558: }
11559:
11560: sub get_extracted {
1.1056 raeburn 11561: my ($docudom,$docuname,$currdir,$is_dir,$children,$parent,$contents,$dirorder,
11562: $titles,$wantform) = @_;
1.1055 raeburn 11563: my $count = 0;
11564: my $depth = 0;
11565: my $datatable;
1.1056 raeburn 11566: my @hierarchy;
1.1055 raeburn 11567: return unless ((ref($is_dir) eq 'HASH') && (ref($children) eq 'HASH') &&
1.1056 raeburn 11568: (ref($parent) eq 'HASH') && (ref($contents) eq 'ARRAY') &&
11569: (ref($dirorder) eq 'HASH') && (ref($titles) eq 'HASH'));
1.1055 raeburn 11570: foreach my $item (@{$contents}) {
11571: $count ++;
1.1056 raeburn 11572: @{$dirorder->{$count}} = @hierarchy;
11573: $titles->{$count} = $item;
1.1055 raeburn 11574: &archive_hierarchy($depth,$count,$parent,$children);
11575: if ($wantform) {
11576: $datatable .= &archive_row($is_dir->{$item},$item,
11577: $currdir,$depth,$count);
11578: }
11579: if ($is_dir->{$item}) {
11580: $depth ++;
1.1056 raeburn 11581: push(@hierarchy,$count);
11582: $parent->{$depth} = $count;
1.1055 raeburn 11583: $datatable .=
11584: &recurse_extracted_archive("$currdir/$item",$docudom,$docuname,
1.1056 raeburn 11585: \$depth,\$count,\@hierarchy,$dirorder,
11586: $children,$parent,$titles,$wantform);
1.1055 raeburn 11587: $depth --;
1.1056 raeburn 11588: pop(@hierarchy);
1.1055 raeburn 11589: }
11590: }
11591: return ($count,$datatable);
11592: }
11593:
11594: sub recurse_extracted_archive {
1.1056 raeburn 11595: my ($currdir,$docudom,$docuname,$depth,$count,$hierarchy,$dirorder,
11596: $children,$parent,$titles,$wantform) = @_;
1.1055 raeburn 11597: my $result='';
1.1056 raeburn 11598: unless ((ref($depth)) && (ref($count)) && (ref($hierarchy) eq 'ARRAY') &&
11599: (ref($children) eq 'HASH') && (ref($parent) eq 'HASH') &&
11600: (ref($dirorder) eq 'HASH')) {
1.1055 raeburn 11601: return $result;
11602: }
11603: my $dirptr = 16384;
11604: my ($newdirlistref,$newlisterror) =
11605: &Apache::lonnet::dirlist($currdir,$docudom,$docuname,1);
11606: if (ref($newdirlistref) eq 'ARRAY') {
11607: foreach my $dir_line (@{$newdirlistref}) {
11608: my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
11609: unless ($item =~ /^\.+$/) {
11610: $$count ++;
1.1056 raeburn 11611: @{$dirorder->{$$count}} = @{$hierarchy};
11612: $titles->{$$count} = $item;
1.1055 raeburn 11613: &archive_hierarchy($$depth,$$count,$parent,$children);
1.1056 raeburn 11614:
1.1055 raeburn 11615: my $is_dir;
11616: if ($dirptr&$testdir) {
11617: $is_dir = 1;
11618: }
11619: if ($wantform) {
11620: $result .= &archive_row($is_dir,$item,$currdir,$$depth,$$count);
11621: }
11622: if ($is_dir) {
11623: $$depth ++;
1.1056 raeburn 11624: push(@{$hierarchy},$$count);
11625: $parent->{$$depth} = $$count;
1.1055 raeburn 11626: $result .=
11627: &recurse_extracted_archive("$currdir/$item",$docudom,
11628: $docuname,$depth,$count,
1.1056 raeburn 11629: $hierarchy,$dirorder,$children,
11630: $parent,$titles,$wantform);
1.1055 raeburn 11631: $$depth --;
1.1056 raeburn 11632: pop(@{$hierarchy});
1.1055 raeburn 11633: }
11634: }
11635: }
11636: }
11637: return $result;
11638: }
11639:
11640: sub archive_hierarchy {
11641: my ($depth,$count,$parent,$children) =@_;
11642: if ((ref($parent) eq 'HASH') && (ref($children) eq 'HASH')) {
11643: if (exists($parent->{$depth})) {
11644: $children->{$parent->{$depth}} .= $count.':';
11645: }
11646: }
11647: return;
11648: }
11649:
11650: sub archive_row {
11651: my ($is_dir,$item,$currdir,$depth,$count) = @_;
11652: my ($name) = ($item =~ m{([^/]+)$});
11653: my %choices = &Apache::lonlocal::texthash (
1.1059 raeburn 11654: 'display' => 'Add as file',
1.1055 raeburn 11655: 'dependency' => 'Include as dependency',
11656: 'discard' => 'Discard',
11657: );
11658: if ($is_dir) {
1.1059 raeburn 11659: $choices{'display'} = &mt('Add as folder');
1.1055 raeburn 11660: }
1.1056 raeburn 11661: my $output = &start_data_table_row().'<td align="right">'.$count.'</td>'."\n";
11662: my $offset = 0;
1.1055 raeburn 11663: foreach my $action ('display','dependency','discard') {
1.1056 raeburn 11664: $offset ++;
1.1065 raeburn 11665: if ($action ne 'display') {
11666: $offset ++;
11667: }
1.1055 raeburn 11668: $output .= '<td><span class="LC_nobreak">'.
11669: '<label><input type="radio" name="archive_'.$count.
11670: '" id="archive_'.$action.'_'.$count.'" value="'.$action.'"';
11671: my $text = $choices{$action};
11672: if ($is_dir) {
11673: $output .= ' onclick="javascript:propagateCheck(this.form,'."'$count'".');"';
11674: if ($action eq 'display') {
1.1059 raeburn 11675: $text = &mt('Add as folder');
1.1055 raeburn 11676: }
1.1056 raeburn 11677: } else {
11678: $output .= ' onclick="javascript:dependencyCheck(this.form,'."$count,$offset".');"';
11679:
11680: }
11681: $output .= ' /> '.$choices{$action}.'</label></span>';
11682: if ($action eq 'dependency') {
11683: $output .= '<div id="arc_depon_'.$count.'" style="display:none;">'."\n".
11684: &mt('Used by:').' <select name="archive_dependent_on_'.$count.'" '.
11685: 'onchange="propagateSelect(this.form,'."$count,$offset".')">'."\n".
11686: '<option value=""></option>'."\n".
11687: '</select>'."\n".
11688: '</div>';
1.1059 raeburn 11689: } elsif ($action eq 'display') {
11690: $output .= '<div id="arc_title_'.$count.'" style="display:none;">'."\n".
11691: &mt('Title:').' <input type="text" name="archive_title_'.$count.'" id="archive_title_'.$count.'" />'."\n".
11692: '</div>';
1.1055 raeburn 11693: }
1.1056 raeburn 11694: $output .= '</td>';
1.1055 raeburn 11695: }
11696: $output .= '<td><input type="hidden" name="archive_content_'.$count.'" value="'.
11697: &HTML::Entities::encode("$currdir/$item",'"<>&').'" />'.(' ' x 2);
11698: for (my $i=0; $i<$depth; $i++) {
11699: $output .= ('<img src="/adm/lonIcons/whitespace1.gif" class="LC_docs_spacer" alt="" />' x2)."\n";
11700: }
11701: if ($is_dir) {
11702: $output .= '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" /> '."\n".
11703: '<input type="hidden" name="archive_directory" value="'.$count.'" />'."\n";
11704: } else {
11705: $output .= '<input type="hidden" name="archive_file" value="'.$count.'" />'."\n";
11706: }
11707: $output .= ' '.$name.'</td>'."\n".
11708: &end_data_table_row();
11709: return $output;
11710: }
11711:
11712: sub archive_options_form {
1.1065 raeburn 11713: my ($form,$display,$count,$hiddenelem) = @_;
11714: my %lt = &Apache::lonlocal::texthash(
11715: perm => 'Permanently remove archive file?',
11716: hows => 'How should each extracted item be incorporated in the course?',
11717: cont => 'Content actions for all',
11718: addf => 'Add as folder/file',
11719: incd => 'Include as dependency for a displayed file',
11720: disc => 'Discard',
11721: no => 'No',
11722: yes => 'Yes',
11723: save => 'Save',
11724: );
11725: my $output = <<"END";
11726: <form name="$form" method="post" action="">
11727: <p><span class="LC_nobreak">$lt{'perm'}
11728: <label>
11729: <input type="radio" name="archivedelete" value="0" checked="checked" />$lt{'no'}
11730: </label>
11731:
11732: <label>
11733: <input type="radio" name="archivedelete" value="1" />$lt{'yes'}</label>
11734: </span>
11735: </p>
11736: <input type="hidden" name="phase" value="decompress_cleanup" />
11737: <br />$lt{'hows'}
11738: <div class="LC_columnSection">
11739: <fieldset>
11740: <legend>$lt{'cont'}</legend>
11741: <input type="button" value="$lt{'addf'}" onclick="javascript:checkAll(document.$form,'display');" />
11742: <input type="button" value="$lt{'incd'}" onclick="javascript:checkAll(document.$form,'dependency');" />
11743: <input type="button" value="$lt{'disc'}" onclick="javascript:checkAll(document.$form,'discard');" />
11744: </fieldset>
11745: </div>
11746: END
11747: return $output.
1.1055 raeburn 11748: &start_data_table()."\n".
1.1065 raeburn 11749: $display."\n".
1.1055 raeburn 11750: &end_data_table()."\n".
11751: '<input type="hidden" name="archive_count" value="'.$count.'" />'.
11752: $hiddenelem.
1.1065 raeburn 11753: '<br /><input type="submit" name="archive_submit" value="'.$lt{'save'}.'" />'.
1.1055 raeburn 11754: '</form>';
11755: }
11756:
11757: sub archive_javascript {
1.1056 raeburn 11758: my ($startcount,$numitems,$titles,$children) = @_;
11759: return unless ((ref($titles) eq 'HASH') && (ref($children) eq 'HASH'));
1.1059 raeburn 11760: my $maintitle = $env{'form.comment'};
1.1055 raeburn 11761: my $scripttag = <<START;
11762: <script type="text/javascript">
11763: // <![CDATA[
11764:
11765: function checkAll(form,prefix) {
11766: var idstr = new RegExp("^archive_"+prefix+"_\\\\d+\$");
11767: for (var i=0; i < form.elements.length; i++) {
11768: var id = form.elements[i].id;
11769: if ((id != '') && (id != undefined)) {
11770: if (idstr.test(id)) {
11771: if (form.elements[i].type == 'radio') {
11772: form.elements[i].checked = true;
1.1056 raeburn 11773: var nostart = i-$startcount;
1.1059 raeburn 11774: var offset = nostart%7;
11775: var count = (nostart-offset)/7;
1.1056 raeburn 11776: dependencyCheck(form,count,offset);
1.1055 raeburn 11777: }
11778: }
11779: }
11780: }
11781: }
11782:
11783: function propagateCheck(form,count) {
11784: if (count > 0) {
1.1059 raeburn 11785: var startelement = $startcount + ((count-1) * 7);
11786: for (var j=1; j<6; j++) {
11787: if ((j != 2) && (j != 4)) {
1.1056 raeburn 11788: var item = startelement + j;
11789: if (form.elements[item].type == 'radio') {
11790: if (form.elements[item].checked) {
11791: containerCheck(form,count,j);
11792: break;
11793: }
1.1055 raeburn 11794: }
11795: }
11796: }
11797: }
11798: }
11799:
11800: numitems = $numitems
1.1056 raeburn 11801: var titles = new Array(numitems);
11802: var parents = new Array(numitems);
1.1055 raeburn 11803: for (var i=0; i<numitems; i++) {
1.1056 raeburn 11804: parents[i] = new Array;
1.1055 raeburn 11805: }
1.1059 raeburn 11806: var maintitle = '$maintitle';
1.1055 raeburn 11807:
11808: START
11809:
1.1056 raeburn 11810: foreach my $container (sort { $a <=> $b } (keys(%{$children}))) {
11811: my @contents = split(/:/,$children->{$container});
1.1055 raeburn 11812: for (my $i=0; $i<@contents; $i ++) {
11813: $scripttag .= 'parents['.$container.']['.$i.'] = '.$contents[$i]."\n";
11814: }
11815: }
11816:
1.1056 raeburn 11817: foreach my $key (sort { $a <=> $b } (keys(%{$titles}))) {
11818: $scripttag .= "titles[$key] = '".$titles->{$key}."';\n";
11819: }
11820:
1.1055 raeburn 11821: $scripttag .= <<END;
11822:
11823: function containerCheck(form,count,offset) {
11824: if (count > 0) {
1.1056 raeburn 11825: dependencyCheck(form,count,offset);
1.1059 raeburn 11826: var item = (offset+$startcount)+7*(count-1);
1.1055 raeburn 11827: form.elements[item].checked = true;
11828: if(Object.prototype.toString.call(parents[count]) === '[object Array]') {
11829: if (parents[count].length > 0) {
11830: for (var j=0; j<parents[count].length; j++) {
1.1056 raeburn 11831: containerCheck(form,parents[count][j],offset);
11832: }
11833: }
11834: }
11835: }
11836: }
11837:
11838: function dependencyCheck(form,count,offset) {
11839: if (count > 0) {
1.1059 raeburn 11840: var chosen = (offset+$startcount)+7*(count-1);
11841: var depitem = $startcount + ((count-1) * 7) + 4;
1.1056 raeburn 11842: var currtype = form.elements[depitem].type;
11843: if (form.elements[chosen].value == 'dependency') {
11844: document.getElementById('arc_depon_'+count).style.display='block';
11845: form.elements[depitem].options.length = 0;
11846: form.elements[depitem].options[0] = new Option('Select','',true,true);
1.1085 raeburn 11847: for (var i=1; i<=numitems; i++) {
11848: if (i == count) {
11849: continue;
11850: }
1.1059 raeburn 11851: var startelement = $startcount + (i-1) * 7;
11852: for (var j=1; j<6; j++) {
11853: if ((j != 2) && (j!= 4)) {
1.1056 raeburn 11854: var item = startelement + j;
11855: if (form.elements[item].type == 'radio') {
11856: if (form.elements[item].checked) {
11857: if (form.elements[item].value == 'display') {
11858: var n = form.elements[depitem].options.length;
11859: form.elements[depitem].options[n] = new Option(titles[i],i,false,false);
11860: }
11861: }
11862: }
11863: }
11864: }
11865: }
11866: } else {
11867: document.getElementById('arc_depon_'+count).style.display='none';
11868: form.elements[depitem].options.length = 0;
11869: form.elements[depitem].options[0] = new Option('Select','',true,true);
11870: }
1.1059 raeburn 11871: titleCheck(form,count,offset);
1.1056 raeburn 11872: }
11873: }
11874:
11875: function propagateSelect(form,count,offset) {
11876: if (count > 0) {
1.1065 raeburn 11877: var item = (1+offset+$startcount)+7*(count-1);
1.1056 raeburn 11878: var picked = form.elements[item].options[form.elements[item].selectedIndex].value;
11879: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11880: if (parents[count].length > 0) {
11881: for (var j=0; j<parents[count].length; j++) {
11882: containerSelect(form,parents[count][j],offset,picked);
1.1055 raeburn 11883: }
11884: }
11885: }
11886: }
11887: }
1.1056 raeburn 11888:
11889: function containerSelect(form,count,offset,picked) {
11890: if (count > 0) {
1.1065 raeburn 11891: var item = (offset+$startcount)+7*(count-1);
1.1056 raeburn 11892: if (form.elements[item].type == 'radio') {
11893: if (form.elements[item].value == 'dependency') {
11894: if (form.elements[item+1].type == 'select-one') {
11895: for (var i=0; i<form.elements[item+1].options.length; i++) {
11896: if (form.elements[item+1].options[i].value == picked) {
11897: form.elements[item+1].selectedIndex = i;
11898: break;
11899: }
11900: }
11901: }
11902: if (Object.prototype.toString.call(parents[count]) === '[object Array]') {
11903: if (parents[count].length > 0) {
11904: for (var j=0; j<parents[count].length; j++) {
11905: containerSelect(form,parents[count][j],offset,picked);
11906: }
11907: }
11908: }
11909: }
11910: }
11911: }
11912: }
11913:
1.1059 raeburn 11914: function titleCheck(form,count,offset) {
11915: if (count > 0) {
11916: var chosen = (offset+$startcount)+7*(count-1);
11917: var depitem = $startcount + ((count-1) * 7) + 2;
11918: var currtype = form.elements[depitem].type;
11919: if (form.elements[chosen].value == 'display') {
11920: document.getElementById('arc_title_'+count).style.display='block';
11921: if ((count==1) && ((parents[count].length > 0) || (numitems == 1))) {
11922: document.getElementById('archive_title_'+count).value=maintitle;
11923: }
11924: } else {
11925: document.getElementById('arc_title_'+count).style.display='none';
11926: if (currtype == 'text') {
11927: document.getElementById('archive_title_'+count).value='';
11928: }
11929: }
11930: }
11931: return;
11932: }
11933:
1.1055 raeburn 11934: // ]]>
11935: </script>
11936: END
11937: return $scripttag;
11938: }
11939:
11940: sub process_extracted_files {
1.1067 raeburn 11941: my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
1.1055 raeburn 11942: my $numitems = $env{'form.archive_count'};
11943: return unless ($numitems);
11944: my @ids=&Apache::lonnet::current_machine_ids();
11945: my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
1.1067 raeburn 11946: %folders,%containers,%mapinner,%prompttofetch);
1.1055 raeburn 11947: my $docuhome = &Apache::lonnet::homeserver($docuname,$docudom);
11948: if (grep(/^\Q$docuhome\E$/,@ids)) {
11949: $prefix = &LONCAPA::propath($docudom,$docuname);
11950: $pathtocheck = "$dir_root/$destination";
11951: $dir = $dir_root;
11952: $ishome = 1;
11953: } else {
11954: $prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
11955: $pathtocheck = "$dir_root/$docudom/$docuname/$destination";
11956: $dir = "$dir_root/$docudom/$docuname";
11957: }
11958: my $currdir = "$dir_root/$destination";
11959: (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
11960: if ($env{'form.folderpath'}) {
11961: my @items = split('&',$env{'form.folderpath'});
11962: $folders{'0'} = $items[-2];
1.1099 raeburn 11963: if ($env{'form.folderpath'} =~ /\:1$/) {
11964: $containers{'0'}='page';
11965: } else {
11966: $containers{'0'}='sequence';
11967: }
1.1055 raeburn 11968: }
11969: my @archdirs = &get_env_multiple('form.archive_directory');
11970: if ($numitems) {
11971: for (my $i=1; $i<=$numitems; $i++) {
11972: my $path = $env{'form.archive_content_'.$i};
11973: if ($path =~ m{^\Q$pathtocheck\E/([^/]+)$}) {
11974: my $item = $1;
11975: $toplevelitems{$item} = $i;
11976: if (grep(/^\Q$i\E$/,@archdirs)) {
11977: $is_dir{$item} = 1;
11978: }
11979: }
11980: }
11981: }
1.1067 raeburn 11982: my ($output,%children,%parent,%titles,%dirorder,$result);
1.1055 raeburn 11983: if (keys(%toplevelitems) > 0) {
11984: my @contents = sort(keys(%toplevelitems));
1.1056 raeburn 11985: (my $count,undef) = &get_extracted($docudom,$docuname,$currdir,\%is_dir,\%children,
11986: \%parent,\@contents,\%dirorder,\%titles);
1.1055 raeburn 11987: }
1.1066 raeburn 11988: my (%referrer,%orphaned,%todelete,%todeletedir,%newdest,%newseqid);
1.1055 raeburn 11989: if ($numitems) {
11990: for (my $i=1; $i<=$numitems; $i++) {
1.1086 raeburn 11991: next if ($env{'form.archive_'.$i} eq 'dependency');
1.1055 raeburn 11992: my $path = $env{'form.archive_content_'.$i};
11993: if ($path =~ /^\Q$pathtocheck\E/) {
11994: if ($env{'form.archive_'.$i} eq 'discard') {
11995: if ($prefix ne '' && $path ne '') {
11996: if (-e $prefix.$path) {
1.1066 raeburn 11997: if ((@archdirs > 0) &&
11998: (grep(/^\Q$i\E$/,@archdirs))) {
11999: $todeletedir{$prefix.$path} = 1;
12000: } else {
12001: $todelete{$prefix.$path} = 1;
12002: }
1.1055 raeburn 12003: }
12004: }
12005: } elsif ($env{'form.archive_'.$i} eq 'display') {
1.1059 raeburn 12006: my ($docstitle,$title,$url,$outer);
1.1055 raeburn 12007: ($title) = ($path =~ m{/([^/]+)$});
1.1059 raeburn 12008: $docstitle = $env{'form.archive_title_'.$i};
12009: if ($docstitle eq '') {
12010: $docstitle = $title;
12011: }
1.1055 raeburn 12012: $outer = 0;
1.1056 raeburn 12013: if (ref($dirorder{$i}) eq 'ARRAY') {
12014: if (@{$dirorder{$i}} > 0) {
12015: foreach my $item (reverse(@{$dirorder{$i}})) {
1.1055 raeburn 12016: if ($env{'form.archive_'.$item} eq 'display') {
12017: $outer = $item;
12018: last;
12019: }
12020: }
12021: }
12022: }
12023: my ($errtext,$fatal) =
12024: &LONCAPA::map::mapread('/uploaded/'.$docudom.'/'.$docuname.
12025: '/'.$folders{$outer}.'.'.
12026: $containers{$outer});
12027: next if ($fatal);
12028: if ((@archdirs > 0) && (grep(/^\Q$i\E$/,@archdirs))) {
12029: if ($context eq 'coursedocs') {
1.1056 raeburn 12030: $mapinner{$i} = time;
1.1055 raeburn 12031: $folders{$i} = 'default_'.$mapinner{$i};
12032: $containers{$i} = 'sequence';
12033: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12034: $folders{$i}.'.'.$containers{$i};
12035: my $newidx = &LONCAPA::map::getresidx();
12036: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12037: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12038: push(@LONCAPA::map::order,$newidx);
12039: my ($outtext,$errtext) =
12040: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12041: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12042: '.'.$containers{$outer},1,1);
1.1056 raeburn 12043: $newseqid{$i} = $newidx;
1.1067 raeburn 12044: unless ($errtext) {
12045: $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";
12046: }
1.1055 raeburn 12047: }
12048: } else {
12049: if ($context eq 'coursedocs') {
12050: my $newidx=&LONCAPA::map::getresidx();
12051: my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
12052: $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
12053: $title;
12054: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
12055: mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
12056: }
12057: if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12058: mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
12059: }
12060: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
12061: system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
1.1056 raeburn 12062: $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
1.1067 raeburn 12063: unless ($ishome) {
12064: my $fetch = "$newdest{$i}/$title";
12065: $fetch =~ s/^\Q$prefix$dir\E//;
12066: $prompttofetch{$fetch} = 1;
12067: }
1.1055 raeburn 12068: }
12069: $LONCAPA::map::resources[$newidx]=
1.1059 raeburn 12070: $docstitle.':'.$url.':false:normal:res';
1.1055 raeburn 12071: push(@LONCAPA::map::order, $newidx);
12072: my ($outtext,$errtext)=
12073: &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
12074: $docuname.'/'.$folders{$outer}.
1.1087 raeburn 12075: '.'.$containers{$outer},1,1);
1.1067 raeburn 12076: unless ($errtext) {
12077: if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
12078: $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
12079: }
12080: }
1.1055 raeburn 12081: }
12082: }
1.1086 raeburn 12083: }
12084: } else {
12085: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12086: }
12087: }
12088: for (my $i=1; $i<=$numitems; $i++) {
12089: next unless ($env{'form.archive_'.$i} eq 'dependency');
12090: my $path = $env{'form.archive_content_'.$i};
12091: if ($path =~ /^\Q$pathtocheck\E/) {
12092: my ($title) = ($path =~ m{/([^/]+)$});
12093: $referrer{$i} = $env{'form.archive_dependent_on_'.$i};
12094: if ($env{'form.archive_'.$referrer{$i}} eq 'display') {
12095: if (ref($dirorder{$i}) eq 'ARRAY') {
12096: my ($itemidx,$fullpath,$relpath);
12097: if (ref($dirorder{$referrer{$i}}) eq 'ARRAY') {
12098: my $container = $dirorder{$referrer{$i}}->[-1];
1.1056 raeburn 12099: for (my $j=0; $j<@{$dirorder{$i}}; $j++) {
1.1086 raeburn 12100: if ($dirorder{$i}->[$j] eq $container) {
12101: $itemidx = $j;
1.1056 raeburn 12102: }
12103: }
1.1086 raeburn 12104: }
12105: if ($itemidx eq '') {
12106: $itemidx = 0;
12107: }
12108: if (grep(/^\Q$referrer{$i}\E$/,@archdirs)) {
12109: if ($mapinner{$referrer{$i}}) {
12110: $fullpath = "$prefix$dir/$docstype/$mapinner{$referrer{$i}}";
12111: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12112: if (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12113: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12114: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12115: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12116: if (!-e $fullpath) {
12117: mkdir($fullpath,0755);
1.1056 raeburn 12118: }
12119: }
1.1086 raeburn 12120: } else {
12121: last;
1.1056 raeburn 12122: }
1.1086 raeburn 12123: }
12124: }
12125: } elsif ($newdest{$referrer{$i}}) {
12126: $fullpath = $newdest{$referrer{$i}};
12127: for (my $j=$itemidx; $j<@{$dirorder{$i}}; $j++) {
12128: if ($env{'form.archive_'.$dirorder{$i}->[$j]} eq 'discard') {
12129: $orphaned{$i} = $env{'form.archive_'.$dirorder{$i}->[$j]};
12130: last;
12131: } elsif (grep(/^\Q$dirorder{$i}->[$j]\E$/,@archdirs)) {
12132: unless (defined($newseqid{$dirorder{$i}->[$j]})) {
12133: $fullpath .= '/'.$titles{$dirorder{$i}->[$j]};
12134: $relpath .= '/'.$titles{$dirorder{$i}->[$j]};
12135: if (!-e $fullpath) {
12136: mkdir($fullpath,0755);
1.1056 raeburn 12137: }
12138: }
1.1086 raeburn 12139: } else {
12140: last;
1.1056 raeburn 12141: }
1.1055 raeburn 12142: }
12143: }
1.1086 raeburn 12144: if ($fullpath ne '') {
12145: if (-e "$prefix$path") {
12146: system("mv $prefix$path $fullpath/$title");
12147: }
12148: if (-e "$fullpath/$title") {
12149: my $showpath;
12150: if ($relpath ne '') {
12151: $showpath = "$relpath/$title";
12152: } else {
12153: $showpath = "/$title";
12154: }
12155: $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";
12156: }
12157: unless ($ishome) {
12158: my $fetch = "$fullpath/$title";
12159: $fetch =~ s/^\Q$prefix$dir\E//;
12160: $prompttofetch{$fetch} = 1;
12161: }
12162: }
1.1055 raeburn 12163: }
1.1086 raeburn 12164: } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
12165: $warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
12166: $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';
1.1055 raeburn 12167: }
12168: } else {
12169: $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';
12170: }
12171: }
12172: if (keys(%todelete)) {
12173: foreach my $key (keys(%todelete)) {
12174: unlink($key);
1.1066 raeburn 12175: }
12176: }
12177: if (keys(%todeletedir)) {
12178: foreach my $key (keys(%todeletedir)) {
12179: rmdir($key);
12180: }
12181: }
12182: foreach my $dir (sort(keys(%is_dir))) {
12183: if (($pathtocheck ne '') && ($dir ne '')) {
12184: &cleanup_empty_dirs($prefix."$pathtocheck/$dir");
1.1055 raeburn 12185: }
12186: }
1.1067 raeburn 12187: if ($result ne '') {
12188: $output .= '<ul>'."\n".
12189: $result."\n".
12190: '</ul>';
12191: }
12192: unless ($ishome) {
12193: my $replicationfail;
12194: foreach my $item (keys(%prompttofetch)) {
12195: my $fetchresult= &Apache::lonnet::reply('fetchuserfile:'.$item,$docuhome);
12196: unless ($fetchresult eq 'ok') {
12197: $replicationfail .= '<li>'.$item.'</li>'."\n";
12198: }
12199: }
12200: if ($replicationfail) {
12201: $output .= '<p class="LC_error">'.
12202: &mt('Course home server failed to retrieve:').'<ul>'.
12203: $replicationfail.
12204: '</ul></p>';
12205: }
12206: }
1.1055 raeburn 12207: } else {
12208: $warning = &mt('No items found in archive.');
12209: }
12210: if ($error) {
12211: $output .= '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
12212: $error.'</p>'."\n";
12213: }
12214: if ($warning) {
12215: $output .= '<p class="LC_warning">'.$warning.'</p>'."\n";
12216: }
12217: return $output;
12218: }
12219:
1.1066 raeburn 12220: sub cleanup_empty_dirs {
12221: my ($path) = @_;
12222: if (($path ne '') && (-d $path)) {
12223: if (opendir(my $dirh,$path)) {
12224: my @dircontents = grep(!/^\./,readdir($dirh));
12225: my $numitems = 0;
12226: foreach my $item (@dircontents) {
12227: if (-d "$path/$item") {
1.1111 raeburn 12228: &cleanup_empty_dirs("$path/$item");
1.1066 raeburn 12229: if (-e "$path/$item") {
12230: $numitems ++;
12231: }
12232: } else {
12233: $numitems ++;
12234: }
12235: }
12236: if ($numitems == 0) {
12237: rmdir($path);
12238: }
12239: closedir($dirh);
12240: }
12241: }
12242: return;
12243: }
12244:
1.41 ng 12245: =pod
1.45 matthew 12246:
1.1162 raeburn 12247: =item * &get_folder_hierarchy()
1.1068 raeburn 12248:
12249: Provides hierarchy of names of folders/sub-folders containing the current
12250: item,
12251:
12252: Inputs: 3
12253: - $navmap - navmaps object
12254:
12255: - $map - url for map (either the trigger itself, or map containing
12256: the resource, which is the trigger).
12257:
12258: - $showitem - 1 => show title for map itself; 0 => do not show.
12259:
12260: Outputs: 1 @pathitems - array of folder/subfolder names.
12261:
12262: =cut
12263:
12264: sub get_folder_hierarchy {
12265: my ($navmap,$map,$showitem) = @_;
12266: my @pathitems;
12267: if (ref($navmap)) {
12268: my $mapres = $navmap->getResourceByUrl($map);
12269: if (ref($mapres)) {
12270: my $pcslist = $mapres->map_hierarchy();
12271: if ($pcslist ne '') {
12272: my @pcs = split(/,/,$pcslist);
12273: foreach my $pc (@pcs) {
12274: if ($pc == 1) {
1.1129 raeburn 12275: push(@pathitems,&mt('Main Content'));
1.1068 raeburn 12276: } else {
12277: my $res = $navmap->getByMapPc($pc);
12278: if (ref($res)) {
12279: my $title = $res->compTitle();
12280: $title =~ s/\W+/_/g;
12281: if ($title ne '') {
12282: push(@pathitems,$title);
12283: }
12284: }
12285: }
12286: }
12287: }
1.1071 raeburn 12288: if ($showitem) {
12289: if ($mapres->{ID} eq '0.0') {
1.1129 raeburn 12290: push(@pathitems,&mt('Main Content'));
1.1071 raeburn 12291: } else {
12292: my $maptitle = $mapres->compTitle();
12293: $maptitle =~ s/\W+/_/g;
12294: if ($maptitle ne '') {
12295: push(@pathitems,$maptitle);
12296: }
1.1068 raeburn 12297: }
12298: }
12299: }
12300: }
12301: return @pathitems;
12302: }
12303:
12304: =pod
12305:
1.1015 raeburn 12306: =item * &get_turnedin_filepath()
12307:
12308: Determines path in a user's portfolio file for storage of files uploaded
12309: to a specific essayresponse or dropbox item.
12310:
12311: Inputs: 3 required + 1 optional.
12312: $symb is symb for resource, $uname and $udom are for current user (required).
12313: $caller is optional (can be "submission", if routine is called when storing
12314: an upoaded file when "Submit Answer" button was pressed).
12315:
12316: Returns array containing $path and $multiresp.
12317: $path is path in portfolio. $multiresp is 1 if this resource contains more
12318: than one file upload item. Callers of routine should append partid as a
12319: subdirectory to $path in cases where $multiresp is 1.
12320:
12321: Called by: homework/essayresponse.pm and homework/structuretags.pm
12322:
12323: =cut
12324:
12325: sub get_turnedin_filepath {
12326: my ($symb,$uname,$udom,$caller) = @_;
12327: my ($map,$resid,$resurl)=&Apache::lonnet::decode_symb($symb);
12328: my $turnindir;
12329: my %userhash = &Apache::lonnet::userenvironment($udom,$uname,'turnindir');
12330: $turnindir = $userhash{'turnindir'};
12331: my ($path,$multiresp);
12332: if ($turnindir eq '') {
12333: if ($caller eq 'submission') {
12334: $turnindir = &mt('turned in');
12335: $turnindir =~ s/\W+/_/g;
12336: my %newhash = (
12337: 'turnindir' => $turnindir,
12338: );
12339: &Apache::lonnet::put('environment',\%newhash,$udom,$uname);
12340: }
12341: }
12342: if ($turnindir ne '') {
12343: $path = '/'.$turnindir.'/';
12344: my ($multipart,$turnin,@pathitems);
12345: my $navmap = Apache::lonnavmaps::navmap->new();
12346: if (defined($navmap)) {
12347: my $mapres = $navmap->getResourceByUrl($map);
12348: if (ref($mapres)) {
12349: my $pcslist = $mapres->map_hierarchy();
12350: if ($pcslist ne '') {
12351: foreach my $pc (split(/,/,$pcslist)) {
12352: my $res = $navmap->getByMapPc($pc);
12353: if (ref($res)) {
12354: my $title = $res->compTitle();
12355: $title =~ s/\W+/_/g;
12356: if ($title ne '') {
1.1149 raeburn 12357: if (($pc > 1) && (length($title) > 12)) {
12358: $title = substr($title,0,12);
12359: }
1.1015 raeburn 12360: push(@pathitems,$title);
12361: }
12362: }
12363: }
12364: }
12365: my $maptitle = $mapres->compTitle();
12366: $maptitle =~ s/\W+/_/g;
12367: if ($maptitle ne '') {
1.1149 raeburn 12368: if (length($maptitle) > 12) {
12369: $maptitle = substr($maptitle,0,12);
12370: }
1.1015 raeburn 12371: push(@pathitems,$maptitle);
12372: }
12373: unless ($env{'request.state'} eq 'construct') {
12374: my $res = $navmap->getBySymb($symb);
12375: if (ref($res)) {
12376: my $partlist = $res->parts();
12377: my $totaluploads = 0;
12378: if (ref($partlist) eq 'ARRAY') {
12379: foreach my $part (@{$partlist}) {
12380: my @types = $res->responseType($part);
12381: my @ids = $res->responseIds($part);
12382: for (my $i=0; $i < scalar(@ids); $i++) {
12383: if ($types[$i] eq 'essay') {
12384: my $partid = $part.'_'.$ids[$i];
12385: if (&Apache::lonnet::EXT("resource.$partid.uploadedfiletypes") ne '') {
12386: $totaluploads ++;
12387: }
12388: }
12389: }
12390: }
12391: if ($totaluploads > 1) {
12392: $multiresp = 1;
12393: }
12394: }
12395: }
12396: }
12397: } else {
12398: return;
12399: }
12400: } else {
12401: return;
12402: }
12403: my $restitle=&Apache::lonnet::gettitle($symb);
12404: $restitle =~ s/\W+/_/g;
12405: if ($restitle eq '') {
12406: $restitle = ($resurl =~ m{/[^/]+$});
12407: if ($restitle eq '') {
12408: $restitle = time;
12409: }
12410: }
1.1149 raeburn 12411: if (length($restitle) > 12) {
12412: $restitle = substr($restitle,0,12);
12413: }
1.1015 raeburn 12414: push(@pathitems,$restitle);
12415: $path .= join('/',@pathitems);
12416: }
12417: return ($path,$multiresp);
12418: }
12419:
12420: =pod
12421:
1.464 albertel 12422: =back
1.41 ng 12423:
1.112 bowersj2 12424: =head1 CSV Upload/Handling functions
1.38 albertel 12425:
1.41 ng 12426: =over 4
12427:
1.648 raeburn 12428: =item * &upfile_store($r)
1.41 ng 12429:
12430: Store uploaded file, $r should be the HTTP Request object,
1.258 albertel 12431: needs $env{'form.upfile'}
1.41 ng 12432: returns $datatoken to be put into hidden field
12433:
12434: =cut
1.31 albertel 12435:
12436: sub upfile_store {
12437: my $r=shift;
1.258 albertel 12438: $env{'form.upfile'}=~s/\r/\n/gs;
12439: $env{'form.upfile'}=~s/\f/\n/gs;
12440: $env{'form.upfile'}=~s/\n+/\n/gs;
12441: $env{'form.upfile'}=~s/\n+$//gs;
1.31 albertel 12442:
1.258 albertel 12443: my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
12444: '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
1.31 albertel 12445: {
1.158 raeburn 12446: my $datafile = $r->dir_config('lonDaemons').
12447: '/tmp/'.$datatoken.'.tmp';
12448: if ( open(my $fh,">$datafile") ) {
1.258 albertel 12449: print $fh $env{'form.upfile'};
1.158 raeburn 12450: close($fh);
12451: }
1.31 albertel 12452: }
12453: return $datatoken;
12454: }
12455:
1.56 matthew 12456: =pod
12457:
1.648 raeburn 12458: =item * &load_tmp_file($r)
1.41 ng 12459:
12460: Load uploaded file from tmp, $r should be the HTTP Request object,
1.258 albertel 12461: needs $env{'form.datatoken'},
12462: sets $env{'form.upfile'} to the contents of the file
1.41 ng 12463:
12464: =cut
1.31 albertel 12465:
12466: sub load_tmp_file {
12467: my $r=shift;
12468: my @studentdata=();
12469: {
1.158 raeburn 12470: my $studentfile = $r->dir_config('lonDaemons').
1.258 albertel 12471: '/tmp/'.$env{'form.datatoken'}.'.tmp';
1.158 raeburn 12472: if ( open(my $fh,"<$studentfile") ) {
12473: @studentdata=<$fh>;
12474: close($fh);
12475: }
1.31 albertel 12476: }
1.258 albertel 12477: $env{'form.upfile'}=join('',@studentdata);
1.31 albertel 12478: }
12479:
1.56 matthew 12480: =pod
12481:
1.648 raeburn 12482: =item * &upfile_record_sep()
1.41 ng 12483:
12484: Separate uploaded file into records
12485: returns array of records,
1.258 albertel 12486: needs $env{'form.upfile'} and $env{'form.upfiletype'}
1.41 ng 12487:
12488: =cut
1.31 albertel 12489:
12490: sub upfile_record_sep {
1.258 albertel 12491: if ($env{'form.upfiletype'} eq 'xml') {
1.31 albertel 12492: } else {
1.248 albertel 12493: my @records;
1.258 albertel 12494: foreach my $line (split(/\n/,$env{'form.upfile'})) {
1.248 albertel 12495: if ($line=~/^\s*$/) { next; }
12496: push(@records,$line);
12497: }
12498: return @records;
1.31 albertel 12499: }
12500: }
12501:
1.56 matthew 12502: =pod
12503:
1.648 raeburn 12504: =item * &record_sep($record)
1.41 ng 12505:
1.258 albertel 12506: Separate a record into fields $record should be an item from the upfile_record_sep(), needs $env{'form.upfiletype'}
1.41 ng 12507:
12508: =cut
12509:
1.263 www 12510: sub takeleft {
12511: my $index=shift;
12512: return substr('0000'.$index,-4,4);
12513: }
12514:
1.31 albertel 12515: sub record_sep {
12516: my $record=shift;
12517: my %components=();
1.258 albertel 12518: if ($env{'form.upfiletype'} eq 'xml') {
12519: } elsif ($env{'form.upfiletype'} eq 'space') {
1.31 albertel 12520: my $i=0;
1.356 albertel 12521: foreach my $field (split(/\s+/,$record)) {
1.31 albertel 12522: $field=~s/^(\"|\')//;
12523: $field=~s/(\"|\')$//;
1.263 www 12524: $components{&takeleft($i)}=$field;
1.31 albertel 12525: $i++;
12526: }
1.258 albertel 12527: } elsif ($env{'form.upfiletype'} eq 'tab') {
1.31 albertel 12528: my $i=0;
1.356 albertel 12529: foreach my $field (split(/\t/,$record)) {
1.31 albertel 12530: $field=~s/^(\"|\')//;
12531: $field=~s/(\"|\')$//;
1.263 www 12532: $components{&takeleft($i)}=$field;
1.31 albertel 12533: $i++;
12534: }
12535: } else {
1.561 www 12536: my $separator=',';
1.480 banghart 12537: if ($env{'form.upfiletype'} eq 'semisv') {
1.561 www 12538: $separator=';';
1.480 banghart 12539: }
1.31 albertel 12540: my $i=0;
1.561 www 12541: # the character we are looking for to indicate the end of a quote or a record
12542: my $looking_for=$separator;
12543: # do not add the characters to the fields
12544: my $ignore=0;
12545: # we just encountered a separator (or the beginning of the record)
12546: my $just_found_separator=1;
12547: # store the field we are working on here
12548: my $field='';
12549: # work our way through all characters in record
12550: foreach my $character ($record=~/(.)/g) {
12551: if ($character eq $looking_for) {
12552: if ($character ne $separator) {
12553: # Found the end of a quote, again looking for separator
12554: $looking_for=$separator;
12555: $ignore=1;
12556: } else {
12557: # Found a separator, store away what we got
12558: $components{&takeleft($i)}=$field;
12559: $i++;
12560: $just_found_separator=1;
12561: $ignore=0;
12562: $field='';
12563: }
12564: next;
12565: }
12566: # single or double quotation marks after a separator indicate beginning of a quote
12567: # we are now looking for the end of the quote and need to ignore separators
12568: if ((($character eq '"') || ($character eq "'")) && ($just_found_separator)) {
12569: $looking_for=$character;
12570: next;
12571: }
12572: # ignore would be true after we reached the end of a quote
12573: if ($ignore) { next; }
12574: if (($just_found_separator) && ($character=~/\s/)) { next; }
12575: $field.=$character;
12576: $just_found_separator=0;
1.31 albertel 12577: }
1.561 www 12578: # catch the very last entry, since we never encountered the separator
12579: $components{&takeleft($i)}=$field;
1.31 albertel 12580: }
12581: return %components;
12582: }
12583:
1.144 matthew 12584: ######################################################
12585: ######################################################
12586:
1.56 matthew 12587: =pod
12588:
1.648 raeburn 12589: =item * &upfile_select_html()
1.41 ng 12590:
1.144 matthew 12591: Return HTML code to select a file from the users machine and specify
12592: the file type.
1.41 ng 12593:
12594: =cut
12595:
1.144 matthew 12596: ######################################################
12597: ######################################################
1.31 albertel 12598: sub upfile_select_html {
1.144 matthew 12599: my %Types = (
12600: csv => &mt('CSV (comma separated values, spreadsheet)'),
1.480 banghart 12601: semisv => &mt('Semicolon separated values'),
1.144 matthew 12602: space => &mt('Space separated'),
12603: tab => &mt('Tabulator separated'),
12604: # xml => &mt('HTML/XML'),
12605: );
12606: my $Str = '<input type="file" name="upfile" size="50" />'.
1.727 riegler 12607: '<br />'.&mt('Type').': <select name="upfiletype">';
1.144 matthew 12608: foreach my $type (sort(keys(%Types))) {
12609: $Str .= '<option value="'.$type.'" >'.$Types{$type}."</option>\n";
12610: }
12611: $Str .= "</select>\n";
12612: return $Str;
1.31 albertel 12613: }
12614:
1.301 albertel 12615: sub get_samples {
12616: my ($records,$toget) = @_;
12617: my @samples=({});
12618: my $got=0;
12619: foreach my $rec (@$records) {
12620: my %temp = &record_sep($rec);
12621: if (! grep(/\S/, values(%temp))) { next; }
12622: if (%temp) {
12623: $samples[$got]=\%temp;
12624: $got++;
12625: if ($got == $toget) { last; }
12626: }
12627: }
12628: return \@samples;
12629: }
12630:
1.144 matthew 12631: ######################################################
12632: ######################################################
12633:
1.56 matthew 12634: =pod
12635:
1.648 raeburn 12636: =item * &csv_print_samples($r,$records)
1.41 ng 12637:
12638: Prints a table of sample values from each column uploaded $r is an
12639: Apache Request ref, $records is an arrayref from
12640: &Apache::loncommon::upfile_record_sep
12641:
12642: =cut
12643:
1.144 matthew 12644: ######################################################
12645: ######################################################
1.31 albertel 12646: sub csv_print_samples {
12647: my ($r,$records) = @_;
1.662 bisitz 12648: my $samples = &get_samples($records,5);
1.301 albertel 12649:
1.594 raeburn 12650: $r->print(&mt('Samples').'<br />'.&start_data_table().
12651: &start_data_table_header_row());
1.356 albertel 12652: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.845 bisitz 12653: $r->print('<th>'.&mt('Column [_1]',($sample+1)).'</th>'); }
1.594 raeburn 12654: $r->print(&end_data_table_header_row());
1.301 albertel 12655: foreach my $hash (@$samples) {
1.594 raeburn 12656: $r->print(&start_data_table_row());
1.356 albertel 12657: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
1.31 albertel 12658: $r->print('<td>');
1.356 albertel 12659: if (defined($$hash{$sample})) { $r->print($$hash{$sample}); }
1.31 albertel 12660: $r->print('</td>');
12661: }
1.594 raeburn 12662: $r->print(&end_data_table_row());
1.31 albertel 12663: }
1.594 raeburn 12664: $r->print(&end_data_table().'<br />'."\n");
1.31 albertel 12665: }
12666:
1.144 matthew 12667: ######################################################
12668: ######################################################
12669:
1.56 matthew 12670: =pod
12671:
1.648 raeburn 12672: =item * &csv_print_select_table($r,$records,$d)
1.41 ng 12673:
12674: Prints a table to create associations between values and table columns.
1.144 matthew 12675:
1.41 ng 12676: $r is an Apache Request ref,
12677: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
1.174 matthew 12678: $d is an array of 2 element arrays (internal name, displayed name,defaultcol)
1.41 ng 12679:
12680: =cut
12681:
1.144 matthew 12682: ######################################################
12683: ######################################################
1.31 albertel 12684: sub csv_print_select_table {
12685: my ($r,$records,$d) = @_;
1.301 albertel 12686: my $i=0;
12687: my $samples = &get_samples($records,1);
1.144 matthew 12688: $r->print(&mt('Associate columns with student attributes.')."\n".
1.594 raeburn 12689: &start_data_table().&start_data_table_header_row().
1.144 matthew 12690: '<th>'.&mt('Attribute').'</th>'.
1.594 raeburn 12691: '<th>'.&mt('Column').'</th>'.
12692: &end_data_table_header_row()."\n");
1.356 albertel 12693: foreach my $array_ref (@$d) {
12694: my ($value,$display,$defaultcol)=@{ $array_ref };
1.729 raeburn 12695: $r->print(&start_data_table_row().'<td>'.$display.'</td>');
1.31 albertel 12696:
1.875 bisitz 12697: $r->print('<td><select name="f'.$i.'"'.
1.32 matthew 12698: ' onchange="javascript:flip(this.form,'.$i.');">');
1.31 albertel 12699: $r->print('<option value="none"></option>');
1.356 albertel 12700: foreach my $sample (sort({$a <=> $b} keys(%{ $samples->[0] }))) {
12701: $r->print('<option value="'.$sample.'"'.
12702: ($sample eq $defaultcol ? ' selected="selected" ' : '').
1.662 bisitz 12703: '>'.&mt('Column [_1]',($sample+1)).'</option>');
1.31 albertel 12704: }
1.594 raeburn 12705: $r->print('</select></td>'.&end_data_table_row()."\n");
1.31 albertel 12706: $i++;
12707: }
1.594 raeburn 12708: $r->print(&end_data_table());
1.31 albertel 12709: $i--;
12710: return $i;
12711: }
1.56 matthew 12712:
1.144 matthew 12713: ######################################################
12714: ######################################################
12715:
1.56 matthew 12716: =pod
1.31 albertel 12717:
1.648 raeburn 12718: =item * &csv_samples_select_table($r,$records,$d)
1.41 ng 12719:
12720: Prints a table of sample values from the upload and can make associate samples to internal names.
12721:
12722: $r is an Apache Request ref,
12723: $records is an arrayref from &Apache::loncommon::upfile_record_sep,
12724: $d is an array of 2 element arrays (internal name, displayed name)
12725:
12726: =cut
12727:
1.144 matthew 12728: ######################################################
12729: ######################################################
1.31 albertel 12730: sub csv_samples_select_table {
12731: my ($r,$records,$d) = @_;
12732: my $i=0;
1.144 matthew 12733: #
1.662 bisitz 12734: my $max_samples = 5;
12735: my $samples = &get_samples($records,$max_samples);
1.594 raeburn 12736: $r->print(&start_data_table().
12737: &start_data_table_header_row().'<th>'.
12738: &mt('Field').'</th><th>'.&mt('Samples').'</th>'.
12739: &end_data_table_header_row());
1.301 albertel 12740:
12741: foreach my $key (sort(keys(%{ $samples->[0] }))) {
1.594 raeburn 12742: $r->print(&start_data_table_row().'<td><select name="f'.$i.'"'.
1.32 matthew 12743: ' onchange="javascript:flip(this.form,'.$i.');">');
1.301 albertel 12744: foreach my $option (@$d) {
12745: my ($value,$display,$defaultcol)=@{ $option };
1.174 matthew 12746: $r->print('<option value="'.$value.'"'.
1.253 albertel 12747: ($i eq $defaultcol ? ' selected="selected" ':'').'>'.
1.174 matthew 12748: $display.'</option>');
1.31 albertel 12749: }
12750: $r->print('</select></td><td>');
1.662 bisitz 12751: foreach my $line (0..($max_samples-1)) {
1.301 albertel 12752: if (defined($samples->[$line]{$key})) {
12753: $r->print($samples->[$line]{$key}."<br />\n");
12754: }
12755: }
1.594 raeburn 12756: $r->print('</td>'.&end_data_table_row());
1.31 albertel 12757: $i++;
12758: }
1.594 raeburn 12759: $r->print(&end_data_table());
1.31 albertel 12760: $i--;
12761: return($i);
1.115 matthew 12762: }
12763:
1.144 matthew 12764: ######################################################
12765: ######################################################
12766:
1.115 matthew 12767: =pod
12768:
1.648 raeburn 12769: =item * &clean_excel_name($name)
1.115 matthew 12770:
12771: Returns a replacement for $name which does not contain any illegal characters.
12772:
12773: =cut
12774:
1.144 matthew 12775: ######################################################
12776: ######################################################
1.115 matthew 12777: sub clean_excel_name {
12778: my ($name) = @_;
12779: $name =~ s/[:\*\?\/\\]//g;
12780: if (length($name) > 31) {
12781: $name = substr($name,0,31);
12782: }
12783: return $name;
1.25 albertel 12784: }
1.84 albertel 12785:
1.85 albertel 12786: =pod
12787:
1.648 raeburn 12788: =item * &check_if_partid_hidden($id,$symb,$udom,$uname)
1.85 albertel 12789:
12790: Returns either 1 or undef
12791:
12792: 1 if the part is to be hidden, undef if it is to be shown
12793:
12794: Arguments are:
12795:
12796: $id the id of the part to be checked
12797: $symb, optional the symb of the resource to check
12798: $udom, optional the domain of the user to check for
12799: $uname, optional the username of the user to check for
12800:
12801: =cut
1.84 albertel 12802:
12803: sub check_if_partid_hidden {
12804: my ($id,$symb,$udom,$uname) = @_;
1.133 albertel 12805: my $hiddenparts=&Apache::lonnet::EXT('resource.0.hiddenparts',
1.84 albertel 12806: $symb,$udom,$uname);
1.141 albertel 12807: my $truth=1;
12808: #if the string starts with !, then the list is the list to show not hide
12809: if ($hiddenparts=~s/^\s*!//) { $truth=undef; }
1.84 albertel 12810: my @hiddenlist=split(/,/,$hiddenparts);
12811: foreach my $checkid (@hiddenlist) {
1.141 albertel 12812: if ($checkid =~ /^\s*\Q$id\E\s*$/) { return $truth; }
1.84 albertel 12813: }
1.141 albertel 12814: return !$truth;
1.84 albertel 12815: }
1.127 matthew 12816:
1.138 matthew 12817:
12818: ############################################################
12819: ############################################################
12820:
12821: =pod
12822:
1.157 matthew 12823: =back
12824:
1.138 matthew 12825: =head1 cgi-bin script and graphing routines
12826:
1.157 matthew 12827: =over 4
12828:
1.648 raeburn 12829: =item * &get_cgi_id()
1.138 matthew 12830:
12831: Inputs: none
12832:
12833: Returns an id which can be used to pass environment variables
12834: to various cgi-bin scripts. These environment variables will
12835: be removed from the users environment after a given time by
12836: the routine &Apache::lonnet::transfer_profile_to_env.
12837:
12838: =cut
12839:
12840: ############################################################
12841: ############################################################
1.152 albertel 12842: my $uniq=0;
1.136 matthew 12843: sub get_cgi_id {
1.154 albertel 12844: $uniq=($uniq+1)%100000;
1.280 albertel 12845: return (time.'_'.$$.'_'.$uniq);
1.136 matthew 12846: }
12847:
1.127 matthew 12848: ############################################################
12849: ############################################################
12850:
12851: =pod
12852:
1.648 raeburn 12853: =item * &DrawBarGraph()
1.127 matthew 12854:
1.138 matthew 12855: Facilitates the plotting of data in a (stacked) bar graph.
12856: Puts plot definition data into the users environment in order for
12857: graph.png to plot it. Returns an <img> tag for the plot.
12858: The bars on the plot are labeled '1','2',...,'n'.
12859:
12860: Inputs:
12861:
12862: =over 4
12863:
12864: =item $Title: string, the title of the plot
12865:
12866: =item $xlabel: string, text describing the X-axis of the plot
12867:
12868: =item $ylabel: string, text describing the Y-axis of the plot
12869:
12870: =item $Max: scalar, the maximum Y value to use in the plot
12871: If $Max is < any data point, the graph will not be rendered.
12872:
1.140 matthew 12873: =item $colors: array ref holding the colors to be used for the data sets when
1.138 matthew 12874: they are plotted. If undefined, default values will be used.
12875:
1.178 matthew 12876: =item $labels: array ref holding the labels to use on the x-axis for the bars.
12877:
1.138 matthew 12878: =item @Values: An array of array references. Each array reference holds data
12879: to be plotted in a stacked bar chart.
12880:
1.239 matthew 12881: =item If the final element of @Values is a hash reference the key/value
12882: pairs will be added to the graph definition.
12883:
1.138 matthew 12884: =back
12885:
12886: Returns:
12887:
12888: An <img> tag which references graph.png and the appropriate identifying
12889: information for the plot.
12890:
1.127 matthew 12891: =cut
12892:
12893: ############################################################
12894: ############################################################
1.134 matthew 12895: sub DrawBarGraph {
1.178 matthew 12896: my ($Title,$xlabel,$ylabel,$Max,$colors,$labels,@Values)=@_;
1.134 matthew 12897: #
12898: if (! defined($colors)) {
12899: $colors = ['#33ff00',
12900: '#0033cc', '#990000', '#aaaa66', '#663399', '#ff9933',
12901: '#66ccff', '#ff9999', '#cccc33', '#660000', '#33cc66',
12902: ];
12903: }
1.228 matthew 12904: my $extra_settings = {};
12905: if (ref($Values[-1]) eq 'HASH') {
12906: $extra_settings = pop(@Values);
12907: }
1.127 matthew 12908: #
1.136 matthew 12909: my $identifier = &get_cgi_id();
12910: my $id = 'cgi.'.$identifier;
1.129 matthew 12911: if (! @Values || ref($Values[0]) ne 'ARRAY') {
1.127 matthew 12912: return '';
12913: }
1.225 matthew 12914: #
12915: my @Labels;
12916: if (defined($labels)) {
12917: @Labels = @$labels;
12918: } else {
12919: for (my $i=0;$i<@{$Values[0]};$i++) {
12920: push (@Labels,$i+1);
12921: }
12922: }
12923: #
1.129 matthew 12924: my $NumBars = scalar(@{$Values[0]});
1.225 matthew 12925: if ($NumBars < scalar(@Labels)) { $NumBars = scalar(@Labels); }
1.129 matthew 12926: my %ValuesHash;
12927: my $NumSets=1;
12928: foreach my $array (@Values) {
12929: next if (! ref($array));
1.136 matthew 12930: $ValuesHash{$id.'.data.'.$NumSets++} =
1.132 matthew 12931: join(',',@$array);
1.129 matthew 12932: }
1.127 matthew 12933: #
1.136 matthew 12934: my ($height,$width,$xskip,$bar_width) = (200,120,1,15);
1.225 matthew 12935: if ($NumBars < 3) {
12936: $width = 120+$NumBars*32;
1.220 matthew 12937: $xskip = 1;
1.225 matthew 12938: $bar_width = 30;
12939: } elsif ($NumBars < 5) {
12940: $width = 120+$NumBars*20;
12941: $xskip = 1;
12942: $bar_width = 20;
1.220 matthew 12943: } elsif ($NumBars < 10) {
1.136 matthew 12944: $width = 120+$NumBars*15;
12945: $xskip = 1;
12946: $bar_width = 15;
12947: } elsif ($NumBars <= 25) {
12948: $width = 120+$NumBars*11;
12949: $xskip = 5;
12950: $bar_width = 8;
12951: } elsif ($NumBars <= 50) {
12952: $width = 120+$NumBars*8;
12953: $xskip = 5;
12954: $bar_width = 4;
12955: } else {
12956: $width = 120+$NumBars*8;
12957: $xskip = 5;
12958: $bar_width = 4;
12959: }
12960: #
1.137 matthew 12961: $Max = 1 if ($Max < 1);
12962: if ( int($Max) < $Max ) {
12963: $Max++;
12964: $Max = int($Max);
12965: }
1.127 matthew 12966: $Title = '' if (! defined($Title));
12967: $xlabel = '' if (! defined($xlabel));
12968: $ylabel = '' if (! defined($ylabel));
1.369 www 12969: $ValuesHash{$id.'.title'} = &escape($Title);
12970: $ValuesHash{$id.'.xlabel'} = &escape($xlabel);
12971: $ValuesHash{$id.'.ylabel'} = &escape($ylabel);
1.137 matthew 12972: $ValuesHash{$id.'.y_max_value'} = $Max;
1.136 matthew 12973: $ValuesHash{$id.'.NumBars'} = $NumBars;
12974: $ValuesHash{$id.'.NumSets'} = $NumSets;
12975: $ValuesHash{$id.'.PlotType'} = 'bar';
12976: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
12977: $ValuesHash{$id.'.height'} = $height;
12978: $ValuesHash{$id.'.width'} = $width;
12979: $ValuesHash{$id.'.xskip'} = $xskip;
12980: $ValuesHash{$id.'.bar_width'} = $bar_width;
12981: $ValuesHash{$id.'.labels'} = join(',',@Labels);
1.127 matthew 12982: #
1.228 matthew 12983: # Deal with other parameters
12984: while (my ($key,$value) = each(%$extra_settings)) {
12985: $ValuesHash{$id.'.'.$key} = $value;
12986: }
12987: #
1.646 raeburn 12988: &Apache::lonnet::appenv(\%ValuesHash);
1.137 matthew 12989: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
12990: }
12991:
12992: ############################################################
12993: ############################################################
12994:
12995: =pod
12996:
1.648 raeburn 12997: =item * &DrawXYGraph()
1.137 matthew 12998:
1.138 matthew 12999: Facilitates the plotting of data in an XY graph.
13000: Puts plot definition data into the users environment in order for
13001: graph.png to plot it. Returns an <img> tag for the plot.
13002:
13003: Inputs:
13004:
13005: =over 4
13006:
13007: =item $Title: string, the title of the plot
13008:
13009: =item $xlabel: string, text describing the X-axis of the plot
13010:
13011: =item $ylabel: string, text describing the Y-axis of the plot
13012:
13013: =item $Max: scalar, the maximum Y value to use in the plot
13014: If $Max is < any data point, the graph will not be rendered.
13015:
13016: =item $colors: Array ref containing the hex color codes for the data to be
13017: plotted in. If undefined, default values will be used.
13018:
13019: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13020:
13021: =item $Ydata: Array ref containing Array refs.
1.185 www 13022: Each of the contained arrays will be plotted as a separate curve.
1.138 matthew 13023:
13024: =item %Values: hash indicating or overriding any default values which are
13025: passed to graph.png.
13026: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13027:
13028: =back
13029:
13030: Returns:
13031:
13032: An <img> tag which references graph.png and the appropriate identifying
13033: information for the plot.
13034:
1.137 matthew 13035: =cut
13036:
13037: ############################################################
13038: ############################################################
13039: sub DrawXYGraph {
13040: my ($Title,$xlabel,$ylabel,$Max,$colors,$Xlabels,$Ydata,%Values)=@_;
13041: #
13042: # Create the identifier for the graph
13043: my $identifier = &get_cgi_id();
13044: my $id = 'cgi.'.$identifier;
13045: #
13046: $Title = '' if (! defined($Title));
13047: $xlabel = '' if (! defined($xlabel));
13048: $ylabel = '' if (! defined($ylabel));
13049: my %ValuesHash =
13050: (
1.369 www 13051: $id.'.title' => &escape($Title),
13052: $id.'.xlabel' => &escape($xlabel),
13053: $id.'.ylabel' => &escape($ylabel),
1.137 matthew 13054: $id.'.y_max_value'=> $Max,
13055: $id.'.labels' => join(',',@$Xlabels),
13056: $id.'.PlotType' => 'XY',
13057: );
13058: #
13059: if (defined($colors) && ref($colors) eq 'ARRAY') {
13060: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13061: }
13062: #
13063: if (! ref($Ydata) || ref($Ydata) ne 'ARRAY') {
13064: return '';
13065: }
13066: my $NumSets=1;
1.138 matthew 13067: foreach my $array (@{$Ydata}){
1.137 matthew 13068: next if (! ref($array));
13069: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
13070: }
1.138 matthew 13071: $ValuesHash{$id.'.NumSets'} = $NumSets-1;
1.137 matthew 13072: #
13073: # Deal with other parameters
13074: while (my ($key,$value) = each(%Values)) {
13075: $ValuesHash{$id.'.'.$key} = $value;
1.127 matthew 13076: }
13077: #
1.646 raeburn 13078: &Apache::lonnet::appenv(\%ValuesHash);
1.136 matthew 13079: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
13080: }
13081:
13082: ############################################################
13083: ############################################################
13084:
13085: =pod
13086:
1.648 raeburn 13087: =item * &DrawXYYGraph()
1.138 matthew 13088:
13089: Facilitates the plotting of data in an XY graph with two Y axes.
13090: Puts plot definition data into the users environment in order for
13091: graph.png to plot it. Returns an <img> tag for the plot.
13092:
13093: Inputs:
13094:
13095: =over 4
13096:
13097: =item $Title: string, the title of the plot
13098:
13099: =item $xlabel: string, text describing the X-axis of the plot
13100:
13101: =item $ylabel: string, text describing the Y-axis of the plot
13102:
13103: =item $colors: Array ref containing the hex color codes for the data to be
13104: plotted in. If undefined, default values will be used.
13105:
13106: =item $Xlabels: Array ref containing the labels to be used for the X-axis.
13107:
13108: =item $Ydata1: The first data set
13109:
13110: =item $Min1: The minimum value of the left Y-axis
13111:
13112: =item $Max1: The maximum value of the left Y-axis
13113:
13114: =item $Ydata2: The second data set
13115:
13116: =item $Min2: The minimum value of the right Y-axis
13117:
13118: =item $Max2: The maximum value of the left Y-axis
13119:
13120: =item %Values: hash indicating or overriding any default values which are
13121: passed to graph.png.
13122: Possible values are: width, xskip, x_ticks, x_tick_offset, among others.
13123:
13124: =back
13125:
13126: Returns:
13127:
13128: An <img> tag which references graph.png and the appropriate identifying
13129: information for the plot.
1.136 matthew 13130:
13131: =cut
13132:
13133: ############################################################
13134: ############################################################
1.137 matthew 13135: sub DrawXYYGraph {
13136: my ($Title,$xlabel,$ylabel,$colors,$Xlabels,$Ydata1,$Min1,$Max1,
13137: $Ydata2,$Min2,$Max2,%Values)=@_;
1.136 matthew 13138: #
13139: # Create the identifier for the graph
13140: my $identifier = &get_cgi_id();
13141: my $id = 'cgi.'.$identifier;
13142: #
13143: $Title = '' if (! defined($Title));
13144: $xlabel = '' if (! defined($xlabel));
13145: $ylabel = '' if (! defined($ylabel));
13146: my %ValuesHash =
13147: (
1.369 www 13148: $id.'.title' => &escape($Title),
13149: $id.'.xlabel' => &escape($xlabel),
13150: $id.'.ylabel' => &escape($ylabel),
1.136 matthew 13151: $id.'.labels' => join(',',@$Xlabels),
13152: $id.'.PlotType' => 'XY',
13153: $id.'.NumSets' => 2,
1.137 matthew 13154: $id.'.two_axes' => 1,
13155: $id.'.y1_max_value' => $Max1,
13156: $id.'.y1_min_value' => $Min1,
13157: $id.'.y2_max_value' => $Max2,
13158: $id.'.y2_min_value' => $Min2,
1.136 matthew 13159: );
13160: #
1.137 matthew 13161: if (defined($colors) && ref($colors) eq 'ARRAY') {
13162: $ValuesHash{$id.'.Colors'} = join(',',@{$colors});
13163: }
13164: #
13165: if (! ref($Ydata1) || ref($Ydata1) ne 'ARRAY' ||
13166: ! ref($Ydata2) || ref($Ydata2) ne 'ARRAY'){
1.136 matthew 13167: return '';
13168: }
13169: my $NumSets=1;
1.137 matthew 13170: foreach my $array ($Ydata1,$Ydata2){
1.136 matthew 13171: next if (! ref($array));
13172: $ValuesHash{$id.'.data.'.$NumSets++} = join(',',@$array);
1.137 matthew 13173: }
13174: #
13175: # Deal with other parameters
13176: while (my ($key,$value) = each(%Values)) {
13177: $ValuesHash{$id.'.'.$key} = $value;
1.136 matthew 13178: }
13179: #
1.646 raeburn 13180: &Apache::lonnet::appenv(\%ValuesHash);
1.130 albertel 13181: return '<img src="/cgi-bin/graph.png?'.$identifier.'" border="1" />';
1.139 matthew 13182: }
13183:
13184: ############################################################
13185: ############################################################
13186:
13187: =pod
13188:
1.157 matthew 13189: =back
13190:
1.139 matthew 13191: =head1 Statistics helper routines?
13192:
13193: Bad place for them but what the hell.
13194:
1.157 matthew 13195: =over 4
13196:
1.648 raeburn 13197: =item * &chartlink()
1.139 matthew 13198:
13199: Returns a link to the chart for a specific student.
13200:
13201: Inputs:
13202:
13203: =over 4
13204:
13205: =item $linktext: The text of the link
13206:
13207: =item $sname: The students username
13208:
13209: =item $sdomain: The students domain
13210:
13211: =back
13212:
1.157 matthew 13213: =back
13214:
1.139 matthew 13215: =cut
13216:
13217: ############################################################
13218: ############################################################
13219: sub chartlink {
13220: my ($linktext, $sname, $sdomain) = @_;
13221: my $link = '<a href="/adm/statistics?reportSelected=student_assessment'.
1.369 www 13222: '&SelectedStudent='.&escape($sname.':'.$sdomain).
1.219 albertel 13223: '&chartoutputmode='.HTML::Entities::encode('html, with all links').
1.139 matthew 13224: '">'.$linktext.'</a>';
1.153 matthew 13225: }
13226:
13227: #######################################################
13228: #######################################################
13229:
13230: =pod
13231:
13232: =head1 Course Environment Routines
1.157 matthew 13233:
13234: =over 4
1.153 matthew 13235:
1.648 raeburn 13236: =item * &restore_course_settings()
1.153 matthew 13237:
1.648 raeburn 13238: =item * &store_course_settings()
1.153 matthew 13239:
13240: Restores/Store indicated form parameters from the course environment.
13241: Will not overwrite existing values of the form parameters.
13242:
13243: Inputs:
13244: a scalar describing the data (e.g. 'chart', 'problem_analysis')
13245:
13246: a hash ref describing the data to be stored. For example:
13247:
13248: %Save_Parameters = ('Status' => 'scalar',
13249: 'chartoutputmode' => 'scalar',
13250: 'chartoutputdata' => 'scalar',
13251: 'Section' => 'array',
1.373 raeburn 13252: 'Group' => 'array',
1.153 matthew 13253: 'StudentData' => 'array',
13254: 'Maps' => 'array');
13255:
13256: Returns: both routines return nothing
13257:
1.631 raeburn 13258: =back
13259:
1.153 matthew 13260: =cut
13261:
13262: #######################################################
13263: #######################################################
13264: sub store_course_settings {
1.496 albertel 13265: return &store_settings($env{'request.course.id'},@_);
13266: }
13267:
13268: sub store_settings {
1.153 matthew 13269: # save to the environment
13270: # appenv the same items, just to be safe
1.300 albertel 13271: my $udom = $env{'user.domain'};
13272: my $uname = $env{'user.name'};
1.496 albertel 13273: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13274: my %SaveHash;
13275: my %AppHash;
13276: while (my ($setting,$type) = each(%$Settings)) {
1.496 albertel 13277: my $basename = join('.','internal',$context,$prefix,$setting);
1.300 albertel 13278: my $envname = 'environment.'.$basename;
1.258 albertel 13279: if (exists($env{'form.'.$setting})) {
1.153 matthew 13280: # Save this value away
13281: if ($type eq 'scalar' &&
1.258 albertel 13282: (! exists($env{$envname}) ||
13283: $env{$envname} ne $env{'form.'.$setting})) {
13284: $SaveHash{$basename} = $env{'form.'.$setting};
13285: $AppHash{$envname} = $env{'form.'.$setting};
1.153 matthew 13286: } elsif ($type eq 'array') {
13287: my $stored_form;
1.258 albertel 13288: if (ref($env{'form.'.$setting})) {
1.153 matthew 13289: $stored_form = join(',',
13290: map {
1.369 www 13291: &escape($_);
1.258 albertel 13292: } sort(@{$env{'form.'.$setting}}));
1.153 matthew 13293: } else {
13294: $stored_form =
1.369 www 13295: &escape($env{'form.'.$setting});
1.153 matthew 13296: }
13297: # Determine if the array contents are the same.
1.258 albertel 13298: if ($stored_form ne $env{$envname}) {
1.153 matthew 13299: $SaveHash{$basename} = $stored_form;
13300: $AppHash{$envname} = $stored_form;
13301: }
13302: }
13303: }
13304: }
13305: my $put_result = &Apache::lonnet::put('environment',\%SaveHash,
1.300 albertel 13306: $udom,$uname);
1.153 matthew 13307: if ($put_result !~ /^(ok|delayed)/) {
13308: &Apache::lonnet::logthis('unable to save form parameters, '.
13309: 'got error:'.$put_result);
13310: }
13311: # Make sure these settings stick around in this session, too
1.646 raeburn 13312: &Apache::lonnet::appenv(\%AppHash);
1.153 matthew 13313: return;
13314: }
13315:
13316: sub restore_course_settings {
1.499 albertel 13317: return &restore_settings($env{'request.course.id'},@_);
1.496 albertel 13318: }
13319:
13320: sub restore_settings {
13321: my ($context,$prefix,$Settings) = @_;
1.153 matthew 13322: while (my ($setting,$type) = each(%$Settings)) {
1.258 albertel 13323: next if (exists($env{'form.'.$setting}));
1.496 albertel 13324: my $envname = 'environment.internal.'.$context.'.'.$prefix.
1.153 matthew 13325: '.'.$setting;
1.258 albertel 13326: if (exists($env{$envname})) {
1.153 matthew 13327: if ($type eq 'scalar') {
1.258 albertel 13328: $env{'form.'.$setting} = $env{$envname};
1.153 matthew 13329: } elsif ($type eq 'array') {
1.258 albertel 13330: $env{'form.'.$setting} = [
1.153 matthew 13331: map {
1.369 www 13332: &unescape($_);
1.258 albertel 13333: } split(',',$env{$envname})
1.153 matthew 13334: ];
13335: }
13336: }
13337: }
1.127 matthew 13338: }
13339:
1.618 raeburn 13340: #######################################################
13341: #######################################################
13342:
13343: =pod
13344:
13345: =head1 Domain E-mail Routines
13346:
13347: =over 4
13348:
1.648 raeburn 13349: =item * &build_recipient_list()
1.618 raeburn 13350:
1.1144 raeburn 13351: Build recipient lists for following types of e-mail:
1.766 raeburn 13352: (a) Error Reports, (b) Package Updates, (c) lonstatus warnings/errors
1.1144 raeburn 13353: (d) Help requests, (e) Course requests needing approval, (f) loncapa
13354: module change checking, student/employee ID conflict checks, as
13355: generated by lonerrorhandler.pm, CHECKRPMS, loncron,
13356: lonsupportreq.pm, loncoursequeueadmin.pm, searchcat.pl respectively.
1.618 raeburn 13357:
13358: Inputs:
1.619 raeburn 13359: defmail (scalar - email address of default recipient),
1.1144 raeburn 13360: mailing type (scalar: errormail, packagesmail, helpdeskmail,
13361: requestsmail, updatesmail, or idconflictsmail).
13362:
1.619 raeburn 13363: defdom (domain for which to retrieve configuration settings),
1.1144 raeburn 13364:
1.619 raeburn 13365: origmail (scalar - email address of recipient from loncapa.conf,
13366: i.e., predates configuration by DC via domainprefs.pm
1.618 raeburn 13367:
1.655 raeburn 13368: Returns: comma separated list of addresses to which to send e-mail.
13369:
13370: =back
1.618 raeburn 13371:
13372: =cut
13373:
13374: ############################################################
13375: ############################################################
13376: sub build_recipient_list {
1.619 raeburn 13377: my ($defmail,$mailing,$defdom,$origmail) = @_;
1.618 raeburn 13378: my @recipients;
13379: my $otheremails;
13380: my %domconfig =
13381: &Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
13382: if (ref($domconfig{'contacts'}) eq 'HASH') {
1.766 raeburn 13383: if (exists($domconfig{'contacts'}{$mailing})) {
13384: if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
13385: my @contacts = ('adminemail','supportemail');
13386: foreach my $item (@contacts) {
13387: if ($domconfig{'contacts'}{$mailing}{$item}) {
13388: my $addr = $domconfig{'contacts'}{$item};
13389: if (!grep(/^\Q$addr\E$/,@recipients)) {
13390: push(@recipients,$addr);
13391: }
1.619 raeburn 13392: }
1.766 raeburn 13393: $otheremails = $domconfig{'contacts'}{$mailing}{'others'};
1.618 raeburn 13394: }
13395: }
1.766 raeburn 13396: } elsif ($origmail ne '') {
13397: push(@recipients,$origmail);
1.618 raeburn 13398: }
1.619 raeburn 13399: } elsif ($origmail ne '') {
13400: push(@recipients,$origmail);
1.618 raeburn 13401: }
1.688 raeburn 13402: if (defined($defmail)) {
13403: if ($defmail ne '') {
13404: push(@recipients,$defmail);
13405: }
1.618 raeburn 13406: }
13407: if ($otheremails) {
1.619 raeburn 13408: my @others;
13409: if ($otheremails =~ /,/) {
13410: @others = split(/,/,$otheremails);
1.618 raeburn 13411: } else {
1.619 raeburn 13412: push(@others,$otheremails);
13413: }
13414: foreach my $addr (@others) {
13415: if (!grep(/^\Q$addr\E$/,@recipients)) {
13416: push(@recipients,$addr);
13417: }
1.618 raeburn 13418: }
13419: }
1.619 raeburn 13420: my $recipientlist = join(',',@recipients);
1.618 raeburn 13421: return $recipientlist;
13422: }
13423:
1.127 matthew 13424: ############################################################
13425: ############################################################
1.154 albertel 13426:
1.655 raeburn 13427: =pod
13428:
13429: =head1 Course Catalog Routines
13430:
13431: =over 4
13432:
13433: =item * &gather_categories()
13434:
13435: Converts category definitions - keys of categories hash stored in
13436: coursecategories in configuration.db on the primary library server in a
13437: domain - to an array. Also generates javascript and idx hash used to
13438: generate Domain Coordinator interface for editing Course Categories.
13439:
13440: Inputs:
1.663 raeburn 13441:
1.655 raeburn 13442: categories (reference to hash of category definitions).
1.663 raeburn 13443:
1.655 raeburn 13444: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13445: categories and subcategories).
1.663 raeburn 13446:
1.655 raeburn 13447: idx (reference to hash of counters used in Domain Coordinator interface for
13448: editing Course Categories).
1.663 raeburn 13449:
1.655 raeburn 13450: jsarray (reference to array of categories used to create Javascript arrays for
13451: Domain Coordinator interface for editing Course Categories).
13452:
13453: Returns: nothing
13454:
13455: Side effects: populates cats, idx and jsarray.
13456:
13457: =cut
13458:
13459: sub gather_categories {
13460: my ($categories,$cats,$idx,$jsarray) = @_;
13461: my %counters;
13462: my $num = 0;
13463: foreach my $item (keys(%{$categories})) {
13464: my ($cat,$container,$depth) = map { &unescape($_); } split(/:/,$item);
13465: if ($container eq '' && $depth == 0) {
13466: $cats->[$depth][$categories->{$item}] = $cat;
13467: } else {
13468: $cats->[$depth]{$container}[$categories->{$item}] = $cat;
13469: }
13470: my ($escitem,$tail) = split(/:/,$item,2);
13471: if ($counters{$tail} eq '') {
13472: $counters{$tail} = $num;
13473: $num ++;
13474: }
13475: if (ref($idx) eq 'HASH') {
13476: $idx->{$item} = $counters{$tail};
13477: }
13478: if (ref($jsarray) eq 'ARRAY') {
13479: push(@{$jsarray->[$counters{$tail}]},$item);
13480: }
13481: }
13482: return;
13483: }
13484:
13485: =pod
13486:
13487: =item * &extract_categories()
13488:
13489: Used to generate breadcrumb trails for course categories.
13490:
13491: Inputs:
1.663 raeburn 13492:
1.655 raeburn 13493: categories (reference to hash of category definitions).
1.663 raeburn 13494:
1.655 raeburn 13495: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13496: categories and subcategories).
1.663 raeburn 13497:
1.655 raeburn 13498: trails (reference to array of breacrumb trails for each category).
1.663 raeburn 13499:
1.655 raeburn 13500: allitems (reference to hash - key is category key
13501: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13502:
1.655 raeburn 13503: idx (reference to hash of counters used in Domain Coordinator interface for
13504: editing Course Categories).
1.663 raeburn 13505:
1.655 raeburn 13506: jsarray (reference to array of categories used to create Javascript arrays for
13507: Domain Coordinator interface for editing Course Categories).
13508:
1.665 raeburn 13509: subcats (reference to hash of arrays containing all subcategories within each
13510: category, -recursive)
13511:
1.655 raeburn 13512: Returns: nothing
13513:
13514: Side effects: populates trails and allitems hash references.
13515:
13516: =cut
13517:
13518: sub extract_categories {
1.665 raeburn 13519: my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
1.655 raeburn 13520: if (ref($categories) eq 'HASH') {
13521: &gather_categories($categories,$cats,$idx,$jsarray);
13522: if (ref($cats->[0]) eq 'ARRAY') {
13523: for (my $i=0; $i<@{$cats->[0]}; $i++) {
13524: my $name = $cats->[0][$i];
13525: my $item = &escape($name).'::0';
13526: my $trailstr;
13527: if ($name eq 'instcode') {
13528: $trailstr = &mt('Official courses (with institutional codes)');
1.919 raeburn 13529: } elsif ($name eq 'communities') {
13530: $trailstr = &mt('Communities');
1.655 raeburn 13531: } else {
13532: $trailstr = $name;
13533: }
13534: if ($allitems->{$item} eq '') {
13535: push(@{$trails},$trailstr);
13536: $allitems->{$item} = scalar(@{$trails})-1;
13537: }
13538: my @parents = ($name);
13539: if (ref($cats->[1]{$name}) eq 'ARRAY') {
13540: for (my $j=0; $j<@{$cats->[1]{$name}}; $j++) {
13541: my $category = $cats->[1]{$name}[$j];
1.665 raeburn 13542: if (ref($subcats) eq 'HASH') {
13543: push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
13544: }
13545: &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
13546: }
13547: } else {
13548: if (ref($subcats) eq 'HASH') {
13549: $subcats->{$item} = [];
1.655 raeburn 13550: }
13551: }
13552: }
13553: }
13554: }
13555: return;
13556: }
13557:
13558: =pod
13559:
1.1162 raeburn 13560: =item * &recurse_categories()
1.655 raeburn 13561:
13562: Recursively used to generate breadcrumb trails for course categories.
13563:
13564: Inputs:
1.663 raeburn 13565:
1.655 raeburn 13566: cats (reference to array of arrays/hashes which encapsulates hierarchy of
13567: categories and subcategories).
1.663 raeburn 13568:
1.655 raeburn 13569: depth (current depth in hierarchy of categories and sub-categories - 0 indexed).
1.663 raeburn 13570:
13571: category (current course category, for which breadcrumb trail is being generated).
13572:
13573: trails (reference to array of breadcrumb trails for each category).
13574:
1.655 raeburn 13575: allitems (reference to hash - key is category key
13576: (format: escaped(name):escaped(parent category):depth in hierarchy).
1.663 raeburn 13577:
1.655 raeburn 13578: parents (array containing containers directories for current category,
13579: back to top level).
13580:
13581: Returns: nothing
13582:
13583: Side effects: populates trails and allitems hash references
13584:
13585: =cut
13586:
13587: sub recurse_categories {
1.665 raeburn 13588: my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
1.655 raeburn 13589: my $shallower = $depth - 1;
13590: if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
13591: for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
13592: my $name = $cats->[$depth]{$category}[$k];
13593: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13594: my $trailstr = join(' -> ',(@{$parents},$category));
13595: if ($allitems->{$item} eq '') {
13596: push(@{$trails},$trailstr);
13597: $allitems->{$item} = scalar(@{$trails})-1;
13598: }
13599: my $deeper = $depth+1;
13600: push(@{$parents},$category);
1.665 raeburn 13601: if (ref($subcats) eq 'HASH') {
13602: my $subcat = &escape($name).':'.$category.':'.$depth;
13603: for (my $j=@{$parents}; $j>=0; $j--) {
13604: my $higher;
13605: if ($j > 0) {
13606: $higher = &escape($parents->[$j]).':'.
13607: &escape($parents->[$j-1]).':'.$j;
13608: } else {
13609: $higher = &escape($parents->[$j]).'::'.$j;
13610: }
13611: push(@{$subcats->{$higher}},$subcat);
13612: }
13613: }
13614: &recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
13615: $subcats);
1.655 raeburn 13616: pop(@{$parents});
13617: }
13618: } else {
13619: my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
13620: my $trailstr = join(' -> ',(@{$parents},$category));
13621: if ($allitems->{$item} eq '') {
13622: push(@{$trails},$trailstr);
13623: $allitems->{$item} = scalar(@{$trails})-1;
13624: }
13625: }
13626: return;
13627: }
13628:
1.663 raeburn 13629: =pod
13630:
1.1162 raeburn 13631: =item * &assign_categories_table()
1.663 raeburn 13632:
13633: Create a datatable for display of hierarchical categories in a domain,
13634: with checkboxes to allow a course to be categorized.
13635:
13636: Inputs:
13637:
13638: cathash - reference to hash of categories defined for the domain (from
13639: configuration.db)
13640:
13641: currcat - scalar with an & separated list of categories assigned to a course.
13642:
1.919 raeburn 13643: type - scalar contains course type (Course or Community).
13644:
1.663 raeburn 13645: Returns: $output (markup to be displayed)
13646:
13647: =cut
13648:
13649: sub assign_categories_table {
1.919 raeburn 13650: my ($cathash,$currcat,$type) = @_;
1.663 raeburn 13651: my $output;
13652: if (ref($cathash) eq 'HASH') {
13653: my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
13654: &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
13655: $maxdepth = scalar(@cats);
13656: if (@cats > 0) {
13657: my $itemcount = 0;
13658: if (ref($cats[0]) eq 'ARRAY') {
13659: my @currcategories;
13660: if ($currcat ne '') {
13661: @currcategories = split('&',$currcat);
13662: }
1.919 raeburn 13663: my $table;
1.663 raeburn 13664: for (my $i=0; $i<@{$cats[0]}; $i++) {
13665: my $parent = $cats[0][$i];
1.919 raeburn 13666: next if ($parent eq 'instcode');
13667: if ($type eq 'Community') {
13668: next unless ($parent eq 'communities');
13669: } else {
13670: next if ($parent eq 'communities');
13671: }
1.663 raeburn 13672: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
13673: my $item = &escape($parent).'::0';
13674: my $checked = '';
13675: if (@currcategories > 0) {
13676: if (grep(/^\Q$item\E$/,@currcategories)) {
1.772 bisitz 13677: $checked = ' checked="checked"';
1.663 raeburn 13678: }
13679: }
1.919 raeburn 13680: my $parent_title = $parent;
13681: if ($parent eq 'communities') {
13682: $parent_title = &mt('Communities');
13683: }
13684: $table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
13685: '<input type="checkbox" name="usecategory" value="'.
13686: $item.'"'.$checked.' />'.$parent_title.'</span>'.
13687: '<input type="hidden" name="catname" value="'.$parent.'" /></td>';
1.663 raeburn 13688: my $depth = 1;
13689: push(@path,$parent);
1.919 raeburn 13690: $table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);
1.663 raeburn 13691: pop(@path);
1.919 raeburn 13692: $table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
1.663 raeburn 13693: $itemcount ++;
13694: }
1.919 raeburn 13695: if ($itemcount) {
13696: $output = &Apache::loncommon::start_data_table().
13697: $table.
13698: &Apache::loncommon::end_data_table();
13699: }
1.663 raeburn 13700: }
13701: }
13702: }
13703: return $output;
13704: }
13705:
13706: =pod
13707:
1.1162 raeburn 13708: =item * &assign_category_rows()
1.663 raeburn 13709:
13710: Create a datatable row for display of nested categories in a domain,
13711: with checkboxes to allow a course to be categorized,called recursively.
13712:
13713: Inputs:
13714:
13715: itemcount - track row number for alternating colors
13716:
13717: cats - reference to array of arrays/hashes which encapsulates hierarchy of
13718: categories and subcategories.
13719:
13720: depth - current depth in hierarchy of categories and sub-categories - 0 indexed.
13721:
13722: parent - parent of current category item
13723:
13724: path - Array containing all categories back up through the hierarchy from the
13725: current category to the top level.
13726:
13727: currcategories - reference to array of current categories assigned to the course
13728:
13729: Returns: $output (markup to be displayed).
13730:
13731: =cut
13732:
13733: sub assign_category_rows {
13734: my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;
13735: my ($text,$name,$item,$chgstr);
13736: if (ref($cats) eq 'ARRAY') {
13737: my $maxdepth = scalar(@{$cats});
13738: if (ref($cats->[$depth]) eq 'HASH') {
13739: if (ref($cats->[$depth]{$parent}) eq 'ARRAY') {
13740: my $numchildren = @{$cats->[$depth]{$parent}};
13741: my $css_class = $itemcount%2?' class="LC_odd_row"':'';
1.1145 raeburn 13742: $text .= '<td><table class="LC_data_table">';
1.663 raeburn 13743: for (my $j=0; $j<$numchildren; $j++) {
13744: $name = $cats->[$depth]{$parent}[$j];
13745: $item = &escape($name).':'.&escape($parent).':'.$depth;
13746: my $deeper = $depth+1;
13747: my $checked = '';
13748: if (ref($currcategories) eq 'ARRAY') {
13749: if (@{$currcategories} > 0) {
13750: if (grep(/^\Q$item\E$/,@{$currcategories})) {
1.772 bisitz 13751: $checked = ' checked="checked"';
1.663 raeburn 13752: }
13753: }
13754: }
1.664 raeburn 13755: $text .= '<tr><td><span class="LC_nobreak"><label>'.
13756: '<input type="checkbox" name="usecategory" value="'.
1.675 raeburn 13757: $item.'"'.$checked.' />'.$name.'</label></span>'.
13758: '<input type="hidden" name="catname" value="'.$name.'" />'.
13759: '</td><td>';
1.663 raeburn 13760: if (ref($path) eq 'ARRAY') {
13761: push(@{$path},$name);
13762: $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
13763: pop(@{$path});
13764: }
13765: $text .= '</td></tr>';
13766: }
13767: $text .= '</table></td>';
13768: }
13769: }
13770: }
13771: return $text;
13772: }
13773:
1.1181 raeburn 13774: =pod
13775:
13776: =back
13777:
13778: =cut
13779:
1.655 raeburn 13780: ############################################################
13781: ############################################################
13782:
13783:
1.443 albertel 13784: sub commit_customrole {
1.664 raeburn 13785: my ($udom,$uname,$url,$three,$four,$five,$start,$end,$context) = @_;
1.630 raeburn 13786: my $output = &mt('Assigning custom role').' "'.$five.'" by '.$four.':'.$three.' in '.$url.
1.443 albertel 13787: ($start?', '.&mt('starting').' '.localtime($start):'').
13788: ($end?', ending '.localtime($end):'').': <b>'.
13789: &Apache::lonnet::assigncustomrole(
1.664 raeburn 13790: $udom,$uname,$url,$three,$four,$five,$end,$start,undef,undef,$context).
1.443 albertel 13791: '</b><br />';
13792: return $output;
13793: }
13794:
13795: sub commit_standardrole {
1.1116 raeburn 13796: my ($udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,$credits) = @_;
1.541 raeburn 13797: my ($output,$logmsg,$linefeed);
13798: if ($context eq 'auto') {
13799: $linefeed = "\n";
13800: } else {
13801: $linefeed = "<br />\n";
13802: }
1.443 albertel 13803: if ($three eq 'st') {
1.541 raeburn 13804: my $result = &commit_studentrole(\$logmsg,$udom,$uname,$url,$three,$start,$end,
1.1116 raeburn 13805: $one,$two,$sec,$context,$credits);
1.541 raeburn 13806: if (($result =~ /^error/) || ($result eq 'not_in_class') ||
1.626 raeburn 13807: ($result eq 'unknown_course') || ($result eq 'refused')) {
13808: $output = $logmsg.' '.&mt('Error: ').$result."\n";
1.443 albertel 13809: } else {
1.541 raeburn 13810: $output = $logmsg.$linefeed.&mt('Assigning').' '.$three.' in '.$url.
1.443 albertel 13811: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13812: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
13813: if ($context eq 'auto') {
13814: $output .= $result.$linefeed.&mt('Add to classlist').': ok';
13815: } else {
13816: $output .= '<b>'.$result.'</b>'.$linefeed.
13817: &mt('Add to classlist').': <b>ok</b>';
13818: }
13819: $output .= $linefeed;
1.443 albertel 13820: }
13821: } else {
13822: $output = &mt('Assigning').' '.$three.' in '.$url.
13823: ($start?', '.&mt('starting').' '.localtime($start):'').
1.541 raeburn 13824: ($end?', '.&mt('ending').' '.localtime($end):'').': ';
1.652 raeburn 13825: my $result = &Apache::lonnet::assignrole($udom,$uname,$url,$three,$end,$start,'','',$context);
1.541 raeburn 13826: if ($context eq 'auto') {
13827: $output .= $result.$linefeed;
13828: } else {
13829: $output .= '<b>'.$result.'</b>'.$linefeed;
13830: }
1.443 albertel 13831: }
13832: return $output;
13833: }
13834:
13835: sub commit_studentrole {
1.1116 raeburn 13836: my ($logmsg,$udom,$uname,$url,$three,$start,$end,$one,$two,$sec,$context,
13837: $credits) = @_;
1.626 raeburn 13838: my ($result,$linefeed,$oldsecurl,$newsecurl);
1.541 raeburn 13839: if ($context eq 'auto') {
13840: $linefeed = "\n";
13841: } else {
13842: $linefeed = '<br />'."\n";
13843: }
1.443 albertel 13844: if (defined($one) && defined($two)) {
13845: my $cid=$one.'_'.$two;
13846: my $oldsec=&Apache::lonnet::getsection($udom,$uname,$cid);
13847: my $secchange = 0;
13848: my $expire_role_result;
13849: my $modify_section_result;
1.628 raeburn 13850: if ($oldsec ne '-1') {
13851: if ($oldsec ne $sec) {
1.443 albertel 13852: $secchange = 1;
1.628 raeburn 13853: my $now = time;
1.443 albertel 13854: my $uurl='/'.$cid;
13855: $uurl=~s/\_/\//g;
13856: if ($oldsec) {
13857: $uurl.='/'.$oldsec;
13858: }
1.626 raeburn 13859: $oldsecurl = $uurl;
1.628 raeburn 13860: $expire_role_result =
1.652 raeburn 13861: &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
1.628 raeburn 13862: if ($env{'request.course.sec'} ne '') {
13863: if ($expire_role_result eq 'refused') {
13864: my @roles = ('st');
13865: my @statuses = ('previous');
13866: my @roledoms = ($one);
13867: my $withsec = 1;
13868: my %roleshash =
13869: &Apache::lonnet::get_my_roles($uname,$udom,'userroles',
13870: \@statuses,\@roles,\@roledoms,$withsec);
13871: if (defined ($roleshash{$two.':'.$one.':st:'.$oldsec})) {
13872: my ($oldstart,$oldend) =
13873: split(':',$roleshash{$two.':'.$one.':st:'.$oldsec});
13874: if ($oldend > 0 && $oldend <= $now) {
13875: $expire_role_result = 'ok';
13876: }
13877: }
13878: }
13879: }
1.443 albertel 13880: $result = $expire_role_result;
13881: }
13882: }
13883: if (($expire_role_result eq 'ok') || ($secchange == 0)) {
1.1116 raeburn 13884: $modify_section_result =
13885: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
13886: undef,undef,undef,$sec,
13887: $end,$start,'','',$cid,
13888: '',$context,$credits);
1.443 albertel 13889: if ($modify_section_result =~ /^ok/) {
13890: if ($secchange == 1) {
1.628 raeburn 13891: if ($sec eq '') {
13892: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to student role without a section.',$uname,$oldsec).$linefeed;
13893: } else {
13894: $$logmsg .= &mt('Section for [_1] switched from (possibly expired) old section: [_2] to new section: [_3].',$uname,$oldsec,$sec).$linefeed;
13895: }
1.443 albertel 13896: } elsif ($oldsec eq '-1') {
1.628 raeburn 13897: if ($sec eq '') {
13898: $$logmsg .= &mt('New student role without a section for [_1] in course [_2].',$uname,$cid).$linefeed;
13899: } else {
13900: $$logmsg .= &mt('New student role for [_1] in section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13901: }
1.443 albertel 13902: } else {
1.628 raeburn 13903: if ($sec eq '') {
13904: $$logmsg .= &mt('Student [_1] assigned to course [_2] without a section.',$uname,$cid).$linefeed;
13905: } else {
13906: $$logmsg .= &mt('Student [_1] assigned to section [_2] in course [_3].',$uname,$sec,$cid).$linefeed;
13907: }
1.443 albertel 13908: }
13909: } else {
1.1115 raeburn 13910: if ($secchange) {
1.628 raeburn 13911: $$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;
13912: } else {
13913: $$logmsg .= &mt('Error when attempting to modify role for [_1] for section: "[_2]" in course [_3] -error:',$uname,$sec,$cid).' '.$modify_section_result.$linefeed;
13914: }
1.443 albertel 13915: }
13916: $result = $modify_section_result;
13917: } elsif ($secchange == 1) {
1.628 raeburn 13918: if ($oldsec eq '') {
1.1103 raeburn 13919: $$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 13920: } else {
13921: $$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;
13922: }
1.626 raeburn 13923: if ($expire_role_result eq 'refused') {
13924: my $newsecurl = '/'.$cid;
13925: $newsecurl =~ s/\_/\//g;
13926: if ($sec ne '') {
13927: $newsecurl.='/'.$sec;
13928: }
13929: if (&Apache::lonnet::allowed('cst',$newsecurl) && !(&Apache::lonnet::allowed('cst',$oldsecurl))) {
13930: if ($sec eq '') {
13931: $$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;
13932: } else {
13933: $$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;
13934: }
13935: }
13936: }
1.443 albertel 13937: }
13938: } else {
1.626 raeburn 13939: $$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 13940: $result = "error: incomplete course id\n";
13941: }
13942: return $result;
13943: }
13944:
1.1108 raeburn 13945: sub show_role_extent {
13946: my ($scope,$context,$role) = @_;
13947: $scope =~ s{^/}{};
13948: my @courseroles = &Apache::lonuserutils::roles_by_context('course',1);
13949: push(@courseroles,'co');
13950: my @authorroles = &Apache::lonuserutils::roles_by_context('author');
13951: if (($context eq 'course') || (grep(/^\Q$role\E/,@courseroles))) {
13952: $scope =~ s{/}{_};
13953: return '<span class="LC_cusr_emph">'.$env{'course.'.$scope.'.description'}.'</span>';
13954: } elsif (($context eq 'author') || (grep(/^\Q$role\E/,@authorroles))) {
13955: my ($audom,$auname) = split(/\//,$scope);
13956: return &mt('[_1] Author Space','<span class="LC_cusr_emph">'.
13957: &Apache::loncommon::plainname($auname,$audom).'</span>');
13958: } else {
13959: $scope =~ s{/$}{};
13960: return &mt('Domain: [_1]','<span class="LC_cusr_emph">'.
13961: &Apache::lonnet::domain($scope,'description').'</span>');
13962: }
13963: }
13964:
1.443 albertel 13965: ############################################################
13966: ############################################################
13967:
1.566 albertel 13968: sub check_clone {
1.578 raeburn 13969: my ($args,$linefeed) = @_;
1.566 albertel 13970: my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
13971: my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
13972: my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
13973: my $clonemsg;
13974: my $can_clone = 0;
1.944 raeburn 13975: my $lctype = lc($args->{'crstype'});
1.908 raeburn 13976: if ($lctype ne 'community') {
13977: $lctype = 'course';
13978: }
1.566 albertel 13979: if ($clonehome eq 'no_host') {
1.944 raeburn 13980: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13981: $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'});
13982: } else {
13983: $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'});
13984: }
1.566 albertel 13985: } else {
13986: my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
1.944 raeburn 13987: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 13988: if ($clonedesc{'type'} ne 'Community') {
13989: $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'});
13990: return ($can_clone, $clonemsg, $cloneid, $clonehome);
13991: }
13992: }
1.882 raeburn 13993: if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
13994: (&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
1.566 albertel 13995: $can_clone = 1;
13996: } else {
13997: my %clonehash = &Apache::lonnet::get('environment',['cloners'],
13998: $args->{'clonedomain'},$args->{'clonecourse'});
13999: my @cloners = split(/,/,$clonehash{'cloners'});
1.578 raeburn 14000: if (grep(/^\*$/,@cloners)) {
14001: $can_clone = 1;
14002: } elsif (grep(/^\*\:\Q$args->{'ccdomain'}\E$/,@cloners)) {
14003: $can_clone = 1;
14004: } else {
1.908 raeburn 14005: my $ccrole = 'cc';
1.944 raeburn 14006: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14007: $ccrole = 'co';
14008: }
1.578 raeburn 14009: my %roleshash =
14010: &Apache::lonnet::get_my_roles($args->{'ccuname'},
14011: $args->{'ccdomain'},
1.908 raeburn 14012: 'userroles',['active'],[$ccrole],
1.578 raeburn 14013: [$args->{'clonedomain'}]);
1.908 raeburn 14014: if (($roleshash{$args->{'clonecourse'}.':'.$args->{'clonedomain'}.':'.$ccrole}) || (grep(/^\Q$args->{'ccuname'}\E:\Q$args->{'ccdomain'}\E$/,@cloners))) {
1.942 raeburn 14015: $can_clone = 1;
14016: } elsif (&Apache::lonnet::is_course_owner($args->{'clonedomain'},$args->{'clonecourse'},$args->{'ccuname'},$args->{'ccdomain'})) {
14017: $can_clone = 1;
14018: } else {
1.944 raeburn 14019: if ($args->{'crstype'} eq 'Community') {
1.908 raeburn 14020: $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'});
14021: } else {
14022: $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'});
14023: }
1.578 raeburn 14024: }
1.566 albertel 14025: }
1.578 raeburn 14026: }
1.566 albertel 14027: }
14028: return ($can_clone, $clonemsg, $cloneid, $clonehome);
14029: }
14030:
1.444 albertel 14031: sub construct_course {
1.1166 raeburn 14032: my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;
1.444 albertel 14033: my $outcome;
1.541 raeburn 14034: my $linefeed = '<br />'."\n";
14035: if ($context eq 'auto') {
14036: $linefeed = "\n";
14037: }
1.566 albertel 14038:
14039: #
14040: # Are we cloning?
14041: #
14042: my ($can_clone, $clonemsg, $cloneid, $clonehome);
14043: if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
1.578 raeburn 14044: ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
1.566 albertel 14045: if ($context ne 'auto') {
1.578 raeburn 14046: if ($clonemsg ne '') {
14047: $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>';
14048: }
1.566 albertel 14049: }
14050: $outcome .= $clonemsg.$linefeed;
14051:
14052: if (!$can_clone) {
14053: return (0,$outcome);
14054: }
14055: }
14056:
1.444 albertel 14057: #
14058: # Open course
14059: #
14060: my $crstype = lc($args->{'crstype'});
14061: my %cenv=();
14062: $$courseid=&Apache::lonnet::createcourse($args->{'course_domain'},
14063: $args->{'cdescr'},
14064: $args->{'curl'},
14065: $args->{'course_home'},
14066: $args->{'nonstandard'},
14067: $args->{'crscode'},
14068: $args->{'ccuname'}.':'.
14069: $args->{'ccdomain'},
1.882 raeburn 14070: $args->{'crstype'},
1.885 raeburn 14071: $cnum,$context,$category);
1.444 albertel 14072:
14073: # Note: The testing routines depend on this being output; see
14074: # Utils::Course. This needs to at least be output as a comment
14075: # if anyone ever decides to not show this, and Utils::Course::new
14076: # will need to be suitably modified.
1.541 raeburn 14077: $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
1.943 raeburn 14078: if ($$courseid =~ /^error:/) {
14079: return (0,$outcome);
14080: }
14081:
1.444 albertel 14082: #
14083: # Check if created correctly
14084: #
1.479 albertel 14085: ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
1.444 albertel 14086: my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
1.943 raeburn 14087: if ($crsuhome eq 'no_host') {
14088: $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
14089: return (0,$outcome);
14090: }
1.541 raeburn 14091: $outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
1.566 albertel 14092:
1.444 albertel 14093: #
1.566 albertel 14094: # Do the cloning
14095: #
14096: if ($can_clone && $cloneid) {
14097: $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
14098: if ($context ne 'auto') {
14099: $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
14100: }
14101: $outcome .= $clonemsg.$linefeed;
14102: my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
1.444 albertel 14103: # Copy all files
1.637 www 14104: &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
1.444 albertel 14105: # Restore URL
1.566 albertel 14106: $cenv{'url'}=$oldcenv{'url'};
1.444 albertel 14107: # Restore title
1.566 albertel 14108: $cenv{'description'}=$oldcenv{'description'};
1.955 raeburn 14109: # Restore creation date, creator and creation context.
14110: $cenv{'internal.created'}=$oldcenv{'internal.created'};
14111: $cenv{'internal.creator'}=$oldcenv{'internal.creator'};
14112: $cenv{'internal.creationcontext'}=$oldcenv{'internal.creationcontext'};
1.444 albertel 14113: # Mark as cloned
1.566 albertel 14114: $cenv{'clonedfrom'}=$cloneid;
1.638 www 14115: # Need to clone grading mode
14116: my %newenv=&Apache::lonnet::get('environment',['grading'],$$crsudom,$$crsunum);
14117: $cenv{'grading'}=$newenv{'grading'};
14118: # Do not clone these environment entries
14119: &Apache::lonnet::del('environment',
14120: ['default_enrollment_start_date',
14121: 'default_enrollment_end_date',
14122: 'question.email',
14123: 'policy.email',
14124: 'comment.email',
14125: 'pch.users.denied',
1.725 raeburn 14126: 'plc.users.denied',
14127: 'hidefromcat',
1.1121 raeburn 14128: 'checkforpriv',
1.1166 raeburn 14129: 'categories',
14130: 'internal.uniquecode'],
1.638 www 14131: $$crsudom,$$crsunum);
1.1170 raeburn 14132: if ($args->{'textbook'}) {
14133: $cenv{'internal.textbook'} = $args->{'textbook'};
14134: }
1.444 albertel 14135: }
1.566 albertel 14136:
1.444 albertel 14137: #
14138: # Set environment (will override cloned, if existing)
14139: #
14140: my @sections = ();
14141: my @xlists = ();
14142: if ($args->{'crstype'}) {
14143: $cenv{'type'}=$args->{'crstype'};
14144: }
14145: if ($args->{'crsid'}) {
14146: $cenv{'courseid'}=$args->{'crsid'};
14147: }
14148: if ($args->{'crscode'}) {
14149: $cenv{'internal.coursecode'}=$args->{'crscode'};
14150: }
14151: if ($args->{'crsquota'} ne '') {
14152: $cenv{'internal.coursequota'}=$args->{'crsquota'};
14153: } else {
14154: $cenv{'internal.coursequota'}=$args->{'crsquota'} = 20;
14155: }
14156: if ($args->{'ccuname'}) {
14157: $cenv{'internal.courseowner'} = $args->{'ccuname'}.
14158: ':'.$args->{'ccdomain'};
14159: } else {
14160: $cenv{'internal.courseowner'} = $args->{'curruser'};
14161: }
1.1116 raeburn 14162: if ($args->{'defaultcredits'}) {
14163: $cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
14164: }
1.444 albertel 14165: my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
14166: if ($args->{'crssections'}) {
14167: $cenv{'internal.sectionnums'} = '';
14168: if ($args->{'crssections'} =~ m/,/) {
14169: @sections = split/,/,$args->{'crssections'};
14170: } else {
14171: $sections[0] = $args->{'crssections'};
14172: }
14173: if (@sections > 0) {
14174: foreach my $item (@sections) {
14175: my ($sec,$gp) = split/:/,$item;
14176: my $class = $args->{'crscode'}.$sec;
14177: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
14178: $cenv{'internal.sectionnums'} .= $item.',';
14179: unless ($addcheck eq 'ok') {
14180: push @badclasses, $class;
14181: }
14182: }
14183: $cenv{'internal.sectionnums'} =~ s/,$//;
14184: }
14185: }
14186: # do not hide course coordinator from staff listing,
14187: # even if privileged
14188: $cenv{'nothideprivileged'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
1.1121 raeburn 14189: # add course coordinator's domain to domains to check for privileged users
14190: # if different to course domain
14191: if ($$crsudom ne $args->{'ccdomain'}) {
14192: $cenv{'checkforpriv'} = $args->{'ccdomain'};
14193: }
1.444 albertel 14194: # add crosslistings
14195: if ($args->{'crsxlist'}) {
14196: $cenv{'internal.crosslistings'}='';
14197: if ($args->{'crsxlist'} =~ m/,/) {
14198: @xlists = split/,/,$args->{'crsxlist'};
14199: } else {
14200: $xlists[0] = $args->{'crsxlist'};
14201: }
14202: if (@xlists > 0) {
14203: foreach my $item (@xlists) {
14204: my ($xl,$gp) = split/:/,$item;
14205: my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
14206: $cenv{'internal.crosslistings'} .= $item.',';
14207: unless ($addcheck eq 'ok') {
14208: push @badclasses, $xl;
14209: }
14210: }
14211: $cenv{'internal.crosslistings'} =~ s/,$//;
14212: }
14213: }
14214: if ($args->{'autoadds'}) {
14215: $cenv{'internal.autoadds'}=$args->{'autoadds'};
14216: }
14217: if ($args->{'autodrops'}) {
14218: $cenv{'internal.autodrops'}=$args->{'autodrops'};
14219: }
14220: # check for notification of enrollment changes
14221: my @notified = ();
14222: if ($args->{'notify_owner'}) {
14223: if ($args->{'ccuname'} ne '') {
14224: push(@notified,$args->{'ccuname'}.':'.$args->{'ccdomain'});
14225: }
14226: }
14227: if ($args->{'notify_dc'}) {
14228: if ($uname ne '') {
1.630 raeburn 14229: push(@notified,$uname.':'.$udom);
1.444 albertel 14230: }
14231: }
14232: if (@notified > 0) {
14233: my $notifylist;
14234: if (@notified > 1) {
14235: $notifylist = join(',',@notified);
14236: } else {
14237: $notifylist = $notified[0];
14238: }
14239: $cenv{'internal.notifylist'} = $notifylist;
14240: }
14241: if (@badclasses > 0) {
14242: my %lt=&Apache::lonlocal::texthash(
14243: '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',
14244: 'dnhr' => 'does not have rights to access enrollment in these classes',
14245: 'adby' => 'as determined by the policies of your institution on access to official classlists'
14246: );
1.541 raeburn 14247: my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.
14248: ' ('.$lt{'adby'}.')';
14249: if ($context eq 'auto') {
14250: $outcome .= $badclass_msg.$linefeed;
1.566 albertel 14251: $outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
1.541 raeburn 14252: foreach my $item (@badclasses) {
14253: if ($context eq 'auto') {
14254: $outcome .= " - $item\n";
14255: } else {
14256: $outcome .= "<li>$item</li>\n";
14257: }
14258: }
14259: if ($context eq 'auto') {
14260: $outcome .= $linefeed;
14261: } else {
1.566 albertel 14262: $outcome .= "</ul><br /><br /></div>\n";
1.541 raeburn 14263: }
14264: }
1.444 albertel 14265: }
14266: if ($args->{'no_end_date'}) {
14267: $args->{'endaccess'} = 0;
14268: }
14269: $cenv{'internal.autostart'}=$args->{'enrollstart'};
14270: $cenv{'internal.autoend'}=$args->{'enrollend'};
14271: $cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
14272: $cenv{'default_enrollment_end_date'}=$args->{'endaccess'};
14273: if ($args->{'showphotos'}) {
14274: $cenv{'internal.showphotos'}=$args->{'showphotos'};
14275: }
14276: $cenv{'internal.authtype'} = $args->{'authtype'};
14277: $cenv{'internal.autharg'} = $args->{'autharg'};
14278: if ( ($cenv{'internal.authtype'} =~ /^krb/) && ($cenv{'internal.autoadds'} == 1)) {
14279: if (! defined($cenv{'internal.autharg'}) || $cenv{'internal.autharg'} eq '') {
1.541 raeburn 14280: 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');
14281: if ($context eq 'auto') {
14282: $outcome .= $krb_msg;
14283: } else {
1.566 albertel 14284: $outcome .= '<span class="LC_error">'.$krb_msg.'</span>';
1.541 raeburn 14285: }
14286: $outcome .= $linefeed;
1.444 albertel 14287: }
14288: }
14289: if (($args->{'ccdomain'}) && ($args->{'ccuname'})) {
14290: if ($args->{'setpolicy'}) {
14291: $cenv{'policy.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14292: }
14293: if ($args->{'setcontent'}) {
14294: $cenv{'question.email'}=$args->{'ccuname'}.':'.$args->{'ccdomain'};
14295: }
14296: }
14297: if ($args->{'reshome'}) {
14298: $cenv{'reshome'}=$args->{'reshome'}.'/';
14299: $cenv{'reshome'}=~s/\/+$/\//;
14300: }
14301: #
14302: # course has keyed access
14303: #
14304: if ($args->{'setkeys'}) {
14305: $cenv{'keyaccess'}='yes';
14306: }
14307: # if specified, key authority is not course, but user
14308: # only active if keyaccess is yes
14309: if ($args->{'keyauth'}) {
1.487 albertel 14310: my ($user,$domain) = split(':',$args->{'keyauth'});
14311: $user = &LONCAPA::clean_username($user);
14312: $domain = &LONCAPA::clean_username($domain);
1.488 foxr 14313: if ($user ne '' && $domain ne '') {
1.487 albertel 14314: $cenv{'keyauth'}=$user.':'.$domain;
1.444 albertel 14315: }
14316: }
14317:
1.1166 raeburn 14318: #
1.1167 raeburn 14319: # generate and store uniquecode (available to course requester), if course should have one.
1.1166 raeburn 14320: #
14321: if ($args->{'uniquecode'}) {
14322: my ($code,$error) = &make_unique_code($$crsudom,$$crsunum);
14323: if ($code) {
14324: $cenv{'internal.uniquecode'} = $code;
1.1167 raeburn 14325: my %crsinfo =
14326: &Apache::lonnet::courseiddump($$crsudom,'.',1,'.','.',$$crsunum,undef,undef,'.');
14327: if (ref($crsinfo{$$crsudom.'_'.$$crsunum}) eq 'HASH') {
14328: $crsinfo{$$crsudom.'_'.$$crsunum}{'uniquecode'} = $code;
14329: my $putres = &Apache::lonnet::courseidput($$crsudom,\%crsinfo,$crsuhome,'notime');
14330: }
1.1166 raeburn 14331: if (ref($coderef)) {
14332: $$coderef = $code;
14333: }
14334: }
14335: }
14336:
1.444 albertel 14337: if ($args->{'disresdis'}) {
14338: $cenv{'pch.roles.denied'}='st';
14339: }
14340: if ($args->{'disablechat'}) {
14341: $cenv{'plc.roles.denied'}='st';
14342: }
14343:
14344: # Record we've not yet viewed the Course Initialization Helper for this
14345: # course
14346: $cenv{'course.helper.not.run'} = 1;
14347: #
14348: # Use new Randomseed
14349: #
14350: $cenv{'rndseed'}=&Apache::lonnet::latest_rnd_algorithm_id();;
14351: $cenv{'receiptalg'}=&Apache::lonnet::latest_receipt_algorithm_id();;
14352: #
14353: # The encryption code and receipt prefix for this course
14354: #
14355: $cenv{'internal.encseed'}=$Apache::lonnet::perlvar{'lonReceipt'}.$$.time.int(rand(9999));
14356: $cenv{'internal.encpref'}=100+int(9*rand(99));
14357: #
14358: # By default, use standard grading
14359: if (!defined($cenv{'grading'})) { $cenv{'grading'} = 'standard'; }
14360:
1.541 raeburn 14361: $outcome .= $linefeed.&mt('Setting environment').': '.
14362: &Apache::lonnet::put('environment',\%cenv,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14363: #
14364: # Open all assignments
14365: #
14366: if ($args->{'openall'}) {
14367: my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
14368: my %storecontent = ($storeunder => time,
14369: $storeunder.'.type' => 'date_start');
14370:
14371: $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
1.541 raeburn 14372: ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
1.444 albertel 14373: }
14374: #
14375: # Set first page
14376: #
14377: unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
14378: || ($cloneid)) {
1.445 albertel 14379: use LONCAPA::map;
1.444 albertel 14380: $outcome .= &mt('Setting first resource').': ';
1.445 albertel 14381:
14382: my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
14383: my ($errtext,$fatal)=&LONCAPA::map::mapread($map);
14384:
1.444 albertel 14385: $outcome .= ($fatal?$errtext:'read ok').' - ';
14386: my $title; my $url;
14387: if ($args->{'firstres'} eq 'syl') {
1.690 bisitz 14388: $title=&mt('Syllabus');
1.444 albertel 14389: $url='/public/'.$$crsudom.'/'.$$crsunum.'/syllabus';
14390: } else {
1.963 raeburn 14391: $title=&mt('Table of Contents');
1.444 albertel 14392: $url='/adm/navmaps';
14393: }
1.445 albertel 14394:
14395: $LONCAPA::map::resources[1]=$title.':'.$url.':false:start:res';
14396: (my $outtext,$errtext) = &LONCAPA::map::storemap($map,1);
14397:
14398: if ($errtext) { $fatal=2; }
1.541 raeburn 14399: $outcome .= ($fatal?$errtext:'write ok').$linefeed;
1.444 albertel 14400: }
1.566 albertel 14401:
14402: return (1,$outcome);
1.444 albertel 14403: }
14404:
1.1166 raeburn 14405: sub make_unique_code {
14406: my ($cdom,$cnum) = @_;
14407: # get lock on uniquecodes db
14408: my $lockhash = {
14409: $cnum."\0".'uniquecodes' => $env{'user.name'}.
14410: ':'.$env{'user.domain'},
14411: };
14412: my $tries = 0;
14413: my $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14414: my ($code,$error);
14415:
14416: while (($gotlock ne 'ok') && ($tries<3)) {
14417: $tries ++;
14418: sleep 1;
14419: $gotlock = &Apache::lonnet::newput_dom('uniquecodes',$lockhash,$cdom);
14420: }
14421: if ($gotlock eq 'ok') {
14422: my %currcodes = &Apache::lonnet::dump_dom('uniquecodes',$cdom);
14423: my $gotcode;
14424: my $attempts = 0;
14425: while ((!$gotcode) && ($attempts < 100)) {
14426: $code = &generate_code();
14427: if (!exists($currcodes{$code})) {
14428: $gotcode = 1;
14429: unless (&Apache::lonnet::newput_dom('uniquecodes',{ $code => $cnum },$cdom) eq 'ok') {
14430: $error = 'nostore';
14431: }
14432: }
14433: $attempts ++;
14434: }
14435: my @del_lock = ($cnum."\0".'uniquecodes');
14436: my $dellockoutcome = &Apache::lonnet::del_dom('uniquecodes',\@del_lock,$cdom);
14437: } else {
14438: $error = 'nolock';
14439: }
14440: return ($code,$error);
14441: }
14442:
14443: sub generate_code {
14444: my $code;
14445: my @letts = qw(B C D G H J K M N P Q R S T V W X Z);
14446: for (my $i=0; $i<6; $i++) {
14447: my $lettnum = int (rand 2);
14448: my $item = '';
14449: if ($lettnum) {
14450: $item = $letts[int( rand(18) )];
14451: } else {
14452: $item = 1+int( rand(8) );
14453: }
14454: $code .= $item;
14455: }
14456: return $code;
14457: }
14458:
1.444 albertel 14459: ############################################################
14460: ############################################################
14461:
1.953 droeschl 14462: #SD
14463: # only Community and Course, or anything else?
1.378 raeburn 14464: sub course_type {
14465: my ($cid) = @_;
14466: if (!defined($cid)) {
14467: $cid = $env{'request.course.id'};
14468: }
1.404 albertel 14469: if (defined($env{'course.'.$cid.'.type'})) {
14470: return $env{'course.'.$cid.'.type'};
1.378 raeburn 14471: } else {
14472: return 'Course';
1.377 raeburn 14473: }
14474: }
1.156 albertel 14475:
1.406 raeburn 14476: sub group_term {
14477: my $crstype = &course_type();
14478: my %names = (
14479: 'Course' => 'group',
1.865 raeburn 14480: 'Community' => 'group',
1.406 raeburn 14481: );
14482: return $names{$crstype};
14483: }
14484:
1.902 raeburn 14485: sub course_types {
1.1165 raeburn 14486: my @types = ('official','unofficial','community','textbook');
1.902 raeburn 14487: my %typename = (
14488: official => 'Official course',
14489: unofficial => 'Unofficial course',
14490: community => 'Community',
1.1165 raeburn 14491: textbook => 'Textbook course',
1.902 raeburn 14492: );
14493: return (\@types,\%typename);
14494: }
14495:
1.156 albertel 14496: sub icon {
14497: my ($file)=@_;
1.505 albertel 14498: my $curfext = lc((split(/\./,$file))[-1]);
1.168 albertel 14499: my $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/unknown.gif';
1.156 albertel 14500: my $embstyle = &Apache::loncommon::fileembstyle($curfext);
1.168 albertel 14501: if (!(!defined($embstyle) || $embstyle eq 'unk' || $embstyle eq 'hdn')) {
14502: if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/'.
14503: $Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14504: $curfext.".gif") {
14505: $iconname=$Apache::lonnet::perlvar{'lonIconsURL'}.'/'.
14506: $curfext.".gif";
14507: }
14508: }
1.249 albertel 14509: return &lonhttpdurl($iconname);
1.154 albertel 14510: }
1.84 albertel 14511:
1.575 albertel 14512: sub lonhttpdurl {
1.692 www 14513: #
14514: # Had been used for "small fry" static images on separate port 8080.
14515: # Modify here if lightweight http functionality desired again.
14516: # Currently eliminated due to increasing firewall issues.
14517: #
1.575 albertel 14518: my ($url)=@_;
1.692 www 14519: return $url;
1.215 albertel 14520: }
14521:
1.213 albertel 14522: sub connection_aborted {
14523: my ($r)=@_;
14524: $r->print(" ");$r->rflush();
14525: my $c = $r->connection;
14526: return $c->aborted();
14527: }
14528:
1.221 foxr 14529: # Escapes strings that may have embedded 's that will be put into
1.222 foxr 14530: # strings as 'strings'.
14531: sub escape_single {
1.221 foxr 14532: my ($input) = @_;
1.223 albertel 14533: $input =~ s/\\/\\\\/g; # Escape the \'s..(must be first)>
1.221 foxr 14534: $input =~ s/\'/\\\'/g; # Esacpe the 's....
14535: return $input;
14536: }
1.223 albertel 14537:
1.222 foxr 14538: # Same as escape_single, but escape's "'s This
14539: # can be used for "strings"
14540: sub escape_double {
14541: my ($input) = @_;
14542: $input =~ s/\\/\\\\/g; # Escape the /'s..(must be first)>
14543: $input =~ s/\"/\\\"/g; # Esacpe the "s....
14544: return $input;
14545: }
1.223 albertel 14546:
1.222 foxr 14547: # Escapes the last element of a full URL.
14548: sub escape_url {
14549: my ($url) = @_;
1.238 raeburn 14550: my @urlslices = split(/\//, $url,-1);
1.369 www 14551: my $lastitem = &escape(pop(@urlslices));
1.223 albertel 14552: return join('/',@urlslices).'/'.$lastitem;
1.222 foxr 14553: }
1.462 albertel 14554:
1.820 raeburn 14555: sub compare_arrays {
14556: my ($arrayref1,$arrayref2) = @_;
14557: my (@difference,%count);
14558: @difference = ();
14559: %count = ();
14560: if ((ref($arrayref1) eq 'ARRAY') && (ref($arrayref2) eq 'ARRAY')) {
14561: foreach my $element (@{$arrayref1}, @{$arrayref2}) { $count{$element}++; }
14562: foreach my $element (keys(%count)) {
14563: if ($count{$element} == 1) {
14564: push(@difference,$element);
14565: }
14566: }
14567: }
14568: return @difference;
14569: }
14570:
1.817 bisitz 14571: # -------------------------------------------------------- Initialize user login
1.462 albertel 14572: sub init_user_environment {
1.463 albertel 14573: my ($r, $username, $domain, $authhost, $form, $args) = @_;
1.462 albertel 14574: my $lonids=$Apache::lonnet::perlvar{'lonIDsDir'};
14575:
14576: my $public=($username eq 'public' && $domain eq 'public');
14577:
14578: # See if old ID present, if so, remove
14579:
1.1062 raeburn 14580: my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
1.462 albertel 14581: my $now=time;
14582:
14583: if ($public) {
14584: my $max_public=100;
14585: my $oldest;
14586: my $oldest_time=0;
14587: for(my $next=1;$next<=$max_public;$next++) {
14588: if (-e $lonids."/publicuser_$next.id") {
14589: my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
14590: if ($mtime<$oldest_time || !$oldest_time) {
14591: $oldest_time=$mtime;
14592: $oldest=$next;
14593: }
14594: } else {
14595: $cookie="publicuser_$next";
14596: last;
14597: }
14598: }
14599: if (!$cookie) { $cookie="publicuser_$oldest"; }
14600: } else {
1.463 albertel 14601: # if this isn't a robot, kill any existing non-robot sessions
14602: if (!$args->{'robot'}) {
14603: opendir(DIR,$lonids);
14604: while ($filename=readdir(DIR)) {
14605: if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
14606: unlink($lonids.'/'.$filename);
14607: }
1.462 albertel 14608: }
1.463 albertel 14609: closedir(DIR);
1.462 albertel 14610: }
14611: # Give them a new cookie
1.463 albertel 14612: my $id = ($args->{'robot'} ? 'robot'.$args->{'robot'}
1.684 www 14613: : $now.$$.int(rand(10000)));
1.463 albertel 14614: $cookie="$username\_$id\_$domain\_$authhost";
1.462 albertel 14615:
14616: # Initialize roles
14617:
1.1062 raeburn 14618: ($userroles,$firstaccenv,$timerintenv) =
14619: &Apache::lonnet::rolesinit($domain,$username,$authhost);
1.462 albertel 14620: }
14621: # ------------------------------------ Check browser type and MathML capability
14622:
1.1194 raeburn 14623: my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,$clientunicode,
14624: $clientos,$clientmobile,$clientinfo,$clientosversion) = &decode_user_agent($r);
1.462 albertel 14625:
14626: # ------------------------------------------------------------- Get environment
14627:
14628: my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
14629: my ($tmp) = keys(%userenv);
14630: if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
14631: } else {
14632: undef(%userenv);
14633: }
14634: if (($userenv{'interface'}) && (!$form->{'interface'})) {
14635: $form->{'interface'}=$userenv{'interface'};
14636: }
14637: if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
14638:
14639: # --------------- Do not trust query string to be put directly into environment
1.817 bisitz 14640: foreach my $option ('interface','localpath','localres') {
14641: $form->{$option}=~s/[\n\r\=]//gs;
1.462 albertel 14642: }
14643: # --------------------------------------------------------- Write first profile
14644:
14645: {
14646: my %initial_env =
14647: ("user.name" => $username,
14648: "user.domain" => $domain,
14649: "user.home" => $authhost,
14650: "browser.type" => $clientbrowser,
14651: "browser.version" => $clientversion,
14652: "browser.mathml" => $clientmathml,
14653: "browser.unicode" => $clientunicode,
14654: "browser.os" => $clientos,
1.1137 raeburn 14655: "browser.mobile" => $clientmobile,
1.1141 raeburn 14656: "browser.info" => $clientinfo,
1.1194 raeburn 14657: "browser.osversion" => $clientosversion,
1.462 albertel 14658: "server.domain" => $Apache::lonnet::perlvar{'lonDefDomain'},
14659: "request.course.fn" => '',
14660: "request.course.uri" => '',
14661: "request.course.sec" => '',
14662: "request.role" => 'cm',
14663: "request.role.adv" => $env{'user.adv'},
14664: "request.host" => $ENV{'REMOTE_ADDR'},);
14665:
14666: if ($form->{'localpath'}) {
14667: $initial_env{"browser.localpath"} = $form->{'localpath'};
14668: $initial_env{"browser.localres"} = $form->{'localres'};
14669: }
14670:
14671: if ($form->{'interface'}) {
14672: $form->{'interface'}=~s/\W//gs;
14673: $initial_env{"browser.interface"} = $form->{'interface'};
14674: $env{'browser.interface'}=$form->{'interface'};
14675: }
14676:
1.1157 raeburn 14677: if ($form->{'iptoken'}) {
14678: my $lonhost = $r->dir_config('lonHostID');
14679: $initial_env{"user.noloadbalance"} = $lonhost;
14680: $env{'user.noloadbalance'} = $lonhost;
14681: }
14682:
1.981 raeburn 14683: my %is_adv = ( is_adv => $env{'user.adv'} );
1.1016 raeburn 14684: my %domdef;
14685: unless ($domain eq 'public') {
14686: %domdef = &Apache::lonnet::get_domain_defaults($domain);
14687: }
1.980 raeburn 14688:
1.1081 raeburn 14689: foreach my $tool ('aboutme','blog','webdav','portfolio') {
1.724 raeburn 14690: $userenv{'availabletools.'.$tool} =
1.980 raeburn 14691: &Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
14692: undef,\%userenv,\%domdef,\%is_adv);
1.724 raeburn 14693: }
14694:
1.1165 raeburn 14695: foreach my $crstype ('official','unofficial','community','textbook') {
1.765 raeburn 14696: $userenv{'canrequest.'.$crstype} =
14697: &Apache::lonnet::usertools_access($username,$domain,$crstype,
1.980 raeburn 14698: 'reload','requestcourses',
14699: \%userenv,\%domdef,\%is_adv);
1.765 raeburn 14700: }
14701:
1.1092 raeburn 14702: $userenv{'canrequest.author'} =
14703: &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
14704: 'reload','requestauthor',
14705: \%userenv,\%domdef,\%is_adv);
14706: my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
14707: $domain,$username);
14708: my $reqstatus = $reqauthor{'author_status'};
14709: if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
14710: if (ref($reqauthor{'author'}) eq 'HASH') {
14711: $userenv{'requestauthorqueued'} = $reqstatus.':'.
14712: $reqauthor{'author'}{'timestamp'};
14713: }
14714: }
14715:
1.462 albertel 14716: $env{'user.environment'} = "$lonids/$cookie.id";
1.1062 raeburn 14717:
1.462 albertel 14718: if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
14719: &GDBM_WRCREAT(),0640)) {
14720: &_add_to_env(\%disk_env,\%initial_env);
14721: &_add_to_env(\%disk_env,\%userenv,'environment.');
14722: &_add_to_env(\%disk_env,$userroles);
1.1062 raeburn 14723: if (ref($firstaccenv) eq 'HASH') {
14724: &_add_to_env(\%disk_env,$firstaccenv);
14725: }
14726: if (ref($timerintenv) eq 'HASH') {
14727: &_add_to_env(\%disk_env,$timerintenv);
14728: }
1.463 albertel 14729: if (ref($args->{'extra_env'})) {
14730: &_add_to_env(\%disk_env,$args->{'extra_env'});
14731: }
1.462 albertel 14732: untie(%disk_env);
14733: } else {
1.705 tempelho 14734: &Apache::lonnet::logthis("<span style=\"color:blue;\">WARNING: ".
14735: 'Could not create environment storage in lonauth: '.$!.'</span>');
1.462 albertel 14736: return 'error: '.$!;
14737: }
14738: }
14739: $env{'request.role'}='cm';
14740: $env{'request.role.adv'}=$env{'user.adv'};
14741: $env{'browser.type'}=$clientbrowser;
14742:
14743: return $cookie;
14744:
14745: }
14746:
14747: sub _add_to_env {
14748: my ($idf,$env_data,$prefix) = @_;
1.676 raeburn 14749: if (ref($env_data) eq 'HASH') {
14750: while (my ($key,$value) = each(%$env_data)) {
14751: $idf->{$prefix.$key} = $value;
14752: $env{$prefix.$key} = $value;
14753: }
1.462 albertel 14754: }
14755: }
14756:
1.685 tempelho 14757: # --- Get the symbolic name of a problem and the url
14758: sub get_symb {
14759: my ($request,$silent) = @_;
1.726 raeburn 14760: (my $url=$env{'form.url'}) =~ s-^https?\://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.685 tempelho 14761: my $symb=($env{'form.symb'} ne '' ? $env{'form.symb'} : (&Apache::lonnet::symbread($url)));
14762: if ($symb eq '') {
14763: if (!$silent) {
1.1071 raeburn 14764: if (ref($request)) {
14765: $request->print("Unable to handle ambiguous references:$url:.");
14766: }
1.685 tempelho 14767: return ();
14768: }
14769: }
14770: &Apache::lonenc::check_decrypt(\$symb);
14771: return ($symb);
14772: }
14773:
14774: # --------------------------------------------------------------Get annotation
14775:
14776: sub get_annotation {
14777: my ($symb,$enc) = @_;
14778:
14779: my $key = $symb;
14780: if (!$enc) {
14781: $key =
14782: &Apache::lonnet::clutter((&Apache::lonnet::decode_symb($symb))[2]);
14783: }
14784: my %annotation=&Apache::lonnet::get('nohist_annotations',[$key]);
14785: return $annotation{$key};
14786: }
14787:
14788: sub clean_symb {
1.731 raeburn 14789: my ($symb,$delete_enc) = @_;
1.685 tempelho 14790:
14791: &Apache::lonenc::check_decrypt(\$symb);
14792: my $enc = $env{'request.enc'};
1.731 raeburn 14793: if ($delete_enc) {
1.730 raeburn 14794: delete($env{'request.enc'});
14795: }
1.685 tempelho 14796:
14797: return ($symb,$enc);
14798: }
1.462 albertel 14799:
1.1181 raeburn 14800: ############################################################
14801: ############################################################
14802:
14803: =pod
14804:
14805: =head1 Routines for building display used to search for courses
14806:
14807:
14808: =over 4
14809:
14810: =item * &build_filters()
14811:
14812: Create markup for a table used to set filters to use when selecting
1.1182 raeburn 14813: courses in a domain. Used by lonpickcourse.pm, lonmodifycourse.pm
14814: and quotacheck.pl
14815:
1.1181 raeburn 14816:
14817: Inputs:
14818:
14819: filterlist - anonymous array of fields to include as potential filters
14820:
14821: crstype - course type
14822:
14823: roleelement - fifth arg in selectcourse_link() populates fifth arg in javascript: opencrsbrowser() function, used
14824: to pop-open a course selector (will contain "extra element").
14825:
14826: multelement - if multiple course selections will be allowed, this will be a hidden form element: name: multiple; value: 1
14827:
14828: filter - anonymous hash of criteria and their values
14829:
14830: action - form action
14831:
14832: numfiltersref - ref to scalar (count of number of elements in institutional codes -- e.g., 4 for year, semester, department, and number)
14833:
1.1182 raeburn 14834: caller - caller context (e.g., set to 'modifycourse' when routine is called from lonmodifycourse.pm)
1.1181 raeburn 14835:
14836: cloneruname - username of owner of new course who wants to clone
14837:
14838: clonerudom - domain of owner of new course who wants to clone
14839:
14840: typeelem - text to use for left column in row containing course type (i.e., Course, Community or Course/Community)
14841:
14842: codetitlesref - reference to array of titles of components in institutional codes (official courses)
14843:
14844: codedom - domain
14845:
14846: formname - value of form element named "form".
14847:
14848: fixeddom - domain, if fixed.
14849:
14850: prevphase - value to assign to form element named "phase" when going back to the previous screen
14851:
14852: cnameelement - name of form element in form on opener page which will receive title of selected course
14853:
14854: cnumelement - name of form element in form on opener page which will receive courseID of selected course
14855:
14856: cdomelement - name of form element in form on opener page which will receive domain of selected course
14857:
14858: setroles - includes access constraint identifier when setting a roles-based condition for acces to a portfolio file
14859:
14860: clonetext - hidden form elements containing list of courses cloneable by intended course owner when DC creates a course
14861:
14862: clonewarning - warning message about missing information for intended course owner when DC creates a course
14863:
1.1182 raeburn 14864:
1.1181 raeburn 14865: Returns: $output - HTML for display of search criteria, and hidden form elements.
14866:
1.1182 raeburn 14867:
1.1181 raeburn 14868: Side Effects: None
14869:
14870: =cut
14871:
14872: # ---------------------------------------------- search for courses based on last activity etc.
14873:
14874: sub build_filters {
14875: my ($filterlist,$crstype,$roleelement,$multelement,$filter,$action,
14876: $numtitlesref,$caller,$cloneruname,$clonerudom,$typeelement,
14877: $codetitlesref,$codedom,$formname,$fixeddom,$prevphase,
14878: $cnameelement,$cnumelement,$cdomelement,$setroles,
14879: $clonetext,$clonewarning) = @_;
1.1182 raeburn 14880: my ($list,$jscript);
1.1181 raeburn 14881: my $onchange = 'javascript:updateFilters(this)';
14882: my ($domainselectform,$sincefilterform,$createdfilterform,
14883: $ownerdomselectform,$persondomselectform,$instcodeform,
14884: $typeselectform,$instcodetitle);
14885: if ($formname eq '') {
14886: $formname = $caller;
14887: }
14888: foreach my $item (@{$filterlist}) {
14889: unless (($item eq 'descriptfilter') || ($item eq 'instcodefilter') ||
14890: ($item eq 'sincefilter') || ($item eq 'createdfilter')) {
14891: if ($item eq 'domainfilter') {
14892: $filter->{$item} = &LONCAPA::clean_domain($filter->{$item});
14893: } elsif ($item eq 'coursefilter') {
14894: $filter->{$item} = &LONCAPA::clean_courseid($filter->{$item});
14895: } elsif ($item eq 'ownerfilter') {
14896: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14897: } elsif ($item eq 'ownerdomfilter') {
14898: $filter->{'ownerdomfilter'} =
14899: &LONCAPA::clean_domain($filter->{$item});
14900: $ownerdomselectform = &select_dom_form($filter->{'ownerdomfilter'},
14901: 'ownerdomfilter',1);
14902: } elsif ($item eq 'personfilter') {
14903: $filter->{$item} = &LONCAPA::clean_username($filter->{$item});
14904: } elsif ($item eq 'persondomfilter') {
14905: $persondomselectform = &select_dom_form($filter->{'persondomfilter'},
14906: 'persondomfilter',1);
14907: } else {
14908: $filter->{$item} =~ s/\W//g;
14909: }
14910: if (!$filter->{$item}) {
14911: $filter->{$item} = '';
14912: }
14913: }
14914: if ($item eq 'domainfilter') {
14915: my $allow_blank = 1;
14916: if ($formname eq 'portform') {
14917: $allow_blank=0;
14918: } elsif ($formname eq 'studentform') {
14919: $allow_blank=0;
14920: }
14921: if ($fixeddom) {
14922: $domainselectform = '<input type="hidden" name="domainfilter"'.
14923: ' value="'.$codedom.'" />'.
14924: &Apache::lonnet::domain($codedom,'description');
14925: } else {
14926: $domainselectform = &select_dom_form($filter->{$item},
14927: 'domainfilter',
14928: $allow_blank,'',$onchange);
14929: }
14930: } else {
14931: $list->{$item} = &HTML::Entities::encode($filter->{$item},'<>&"');
14932: }
14933: }
14934:
14935: # last course activity filter and selection
14936: $sincefilterform = &timebased_select_form('sincefilter',$filter);
14937:
14938: # course created filter and selection
14939: if (exists($filter->{'createdfilter'})) {
14940: $createdfilterform = &timebased_select_form('createdfilter',$filter);
14941: }
14942:
14943: my %lt = &Apache::lonlocal::texthash(
14944: 'cac' => "$crstype Activity",
14945: 'ccr' => "$crstype Created",
14946: 'cde' => "$crstype Title",
14947: 'cdo' => "$crstype Domain",
14948: 'ins' => 'Institutional Code',
14949: 'inc' => 'Institutional Categorization',
14950: 'cow' => "$crstype Owner/Co-owner",
14951: 'cop' => "$crstype Personnel Includes",
14952: 'cog' => 'Type',
14953: );
14954:
14955: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
14956: my $typeval = 'Course';
14957: if ($crstype eq 'Community') {
14958: $typeval = 'Community';
14959: }
14960: $typeselectform = '<input type="hidden" name="type" value="'.$typeval.'" />';
14961: } else {
14962: $typeselectform = '<select name="type" size="1"';
14963: if ($onchange) {
14964: $typeselectform .= ' onchange="'.$onchange.'"';
14965: }
14966: $typeselectform .= '>'."\n";
14967: foreach my $posstype ('Course','Community') {
14968: $typeselectform.='<option value="'.$posstype.'"'.
14969: ($posstype eq $crstype ? ' selected="selected" ' : ''). ">".&mt($posstype)."</option>\n";
14970: }
14971: $typeselectform.="</select>";
14972: }
14973:
14974: my ($cloneableonlyform,$cloneabletitle);
14975: if (exists($filter->{'cloneableonly'})) {
14976: my $cloneableon = '';
14977: my $cloneableoff = ' checked="checked"';
14978: if ($filter->{'cloneableonly'}) {
14979: $cloneableon = $cloneableoff;
14980: $cloneableoff = '';
14981: }
14982: $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>';
14983: if ($formname eq 'ccrs') {
1.1187 bisitz 14984: $cloneabletitle = &mt('Cloneable for [_1]',$cloneruname.':'.$clonerudom);
1.1181 raeburn 14985: } else {
14986: $cloneabletitle = &mt('Cloneable by you');
14987: }
14988: }
14989: my $officialjs;
14990: if ($crstype eq 'Course') {
14991: if (exists($filter->{'instcodefilter'})) {
1.1182 raeburn 14992: # if (($fixeddom) || ($formname eq 'requestcrs') ||
14993: # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) {
14994: if ($codedom) {
1.1181 raeburn 14995: $officialjs = 1;
14996: ($instcodeform,$jscript,$$numtitlesref) =
14997: &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker',
14998: $officialjs,$codetitlesref);
14999: if ($jscript) {
1.1182 raeburn 15000: $jscript = '<script type="text/javascript">'."\n".
15001: '// <![CDATA['."\n".
15002: $jscript."\n".
15003: '// ]]>'."\n".
15004: '</script>'."\n";
1.1181 raeburn 15005: }
15006: }
15007: if ($instcodeform eq '') {
15008: $instcodeform =
15009: '<input type="text" name="instcodefilter" size="10" value="'.
15010: $list->{'instcodefilter'}.'" />';
15011: $instcodetitle = $lt{'ins'};
15012: } else {
15013: $instcodetitle = $lt{'inc'};
15014: }
15015: if ($fixeddom) {
15016: $instcodetitle .= '<br />('.$codedom.')';
15017: }
15018: }
15019: }
15020: my $output = qq|
15021: <form method="post" name="filterpicker" action="$action">
15022: <input type="hidden" name="form" value="$formname" />
15023: |;
15024: if ($formname eq 'modifycourse') {
15025: $output .= '<input type="hidden" name="phase" value="courselist" />'."\n".
15026: '<input type="hidden" name="prevphase" value="'.
15027: $prevphase.'" />'."\n";
1.1198 musolffc 15028: } elsif ($formname eq 'quotacheck') {
15029: $output .= qq|
15030: <input type="hidden" name="sortby" value="" />
15031: <input type="hidden" name="sortorder" value="" />
15032: |;
15033: } else {
1.1181 raeburn 15034: my $name_input;
15035: if ($cnameelement ne '') {
15036: $name_input = '<input type="hidden" name="cnameelement" value="'.
15037: $cnameelement.'" />';
15038: }
15039: $output .= qq|
1.1182 raeburn 15040: <input type="hidden" name="cnumelement" value="$cnumelement" />
15041: <input type="hidden" name="cdomelement" value="$cdomelement" />
1.1181 raeburn 15042: $name_input
15043: $roleelement
15044: $multelement
15045: $typeelement
15046: |;
15047: if ($formname eq 'portform') {
15048: $output .= '<input type="hidden" name="setroles" value="'.$setroles.'" />'."\n";
15049: }
15050: }
15051: if ($fixeddom) {
15052: $output .= '<input type="hidden" name="fixeddom" value="'.$fixeddom.'" />'."\n";
15053: }
15054: $output .= "<br />\n".&Apache::lonhtmlcommon::start_pick_box();
15055: if ($sincefilterform) {
15056: $output .= &Apache::lonhtmlcommon::row_title($lt{'cac'})
15057: .$sincefilterform
15058: .&Apache::lonhtmlcommon::row_closure();
15059: }
15060: if ($createdfilterform) {
15061: $output .= &Apache::lonhtmlcommon::row_title($lt{'ccr'})
15062: .$createdfilterform
15063: .&Apache::lonhtmlcommon::row_closure();
15064: }
15065: if ($domainselectform) {
15066: $output .= &Apache::lonhtmlcommon::row_title($lt{'cdo'})
15067: .$domainselectform
15068: .&Apache::lonhtmlcommon::row_closure();
15069: }
15070: if ($typeselectform) {
15071: if (($formname eq 'ccrs') || ($formname eq 'requestcrs')) {
15072: $output .= $typeselectform;
15073: } else {
15074: $output .= &Apache::lonhtmlcommon::row_title($lt{'cog'})
15075: .$typeselectform
15076: .&Apache::lonhtmlcommon::row_closure();
15077: }
15078: }
15079: if ($instcodeform) {
15080: $output .= &Apache::lonhtmlcommon::row_title($instcodetitle)
15081: .$instcodeform
15082: .&Apache::lonhtmlcommon::row_closure();
15083: }
15084: if (exists($filter->{'ownerfilter'})) {
15085: $output .= &Apache::lonhtmlcommon::row_title($lt{'cow'}).
15086: '<table><tr><td>'.&mt('Username').'<br />'.
15087: '<input type="text" name="ownerfilter" size="20" value="'.
15088: $list->{'ownerfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15089: $ownerdomselectform.'</td></tr></table>'.
15090: &Apache::lonhtmlcommon::row_closure();
15091: }
15092: if (exists($filter->{'personfilter'})) {
15093: $output .= &Apache::lonhtmlcommon::row_title($lt{'cop'}).
15094: '<table><tr><td>'.&mt('Username').'<br />'.
15095: '<input type="text" name="personfilter" size="20" value="'.
15096: $list->{'personfilter'}.'" /></td><td>'.&mt('Domain').'<br />'.
15097: $persondomselectform.'</td></tr></table>'.
15098: &Apache::lonhtmlcommon::row_closure();
15099: }
15100: if (exists($filter->{'coursefilter'})) {
15101: $output .= &Apache::lonhtmlcommon::row_title(&mt('LON-CAPA course ID'))
15102: .'<input type="text" name="coursefilter" size="25" value="'
15103: .$list->{'coursefilter'}.'" />'
15104: .&Apache::lonhtmlcommon::row_closure();
15105: }
15106: if ($cloneableonlyform) {
15107: $output .= &Apache::lonhtmlcommon::row_title($cloneabletitle).
15108: $cloneableonlyform.&Apache::lonhtmlcommon::row_closure();
15109: }
15110: if (exists($filter->{'descriptfilter'})) {
15111: $output .= &Apache::lonhtmlcommon::row_title($lt{'cde'})
15112: .'<input type="text" name="descriptfilter" size="40" value="'
15113: .$list->{'descriptfilter'}.'" />'
15114: .&Apache::lonhtmlcommon::row_closure(1);
15115: }
15116: $output .= &Apache::lonhtmlcommon::end_pick_box().'<p>'.$clonetext."\n".
15117: '<input type="hidden" name="updater" value="" />'."\n".
15118: '<input type="submit" name="gosearch" value="'.
15119: &mt('Search').'" /></p>'."\n".'</form>'."\n".'<hr />'."\n";
15120: return $jscript.$clonewarning.$output;
15121: }
15122:
15123: =pod
15124:
15125: =item * &timebased_select_form()
15126:
1.1182 raeburn 15127: Create markup for a dropdown list used to select a time-based
1.1181 raeburn 15128: filter e.g., Course Activity, Course Created, when searching for courses
15129: or communities
15130:
15131: Inputs:
15132:
15133: item - name of form element (sincefilter or createdfilter)
15134:
15135: filter - anonymous hash of criteria and their values
15136:
15137: Returns: HTML for a select box contained a blank, then six time selections,
15138: with value set in incoming form variables currently selected.
15139:
15140: Side Effects: None
15141:
15142: =cut
15143:
15144: sub timebased_select_form {
15145: my ($item,$filter) = @_;
15146: if (ref($filter) eq 'HASH') {
15147: $filter->{$item} =~ s/[^\d-]//g;
15148: if (!$filter->{$item}) { $filter->{$item}=-1; }
15149: return &select_form(
15150: $filter->{$item},
15151: $item,
15152: { '-1' => '',
15153: '86400' => &mt('today'),
15154: '604800' => &mt('last week'),
15155: '2592000' => &mt('last month'),
15156: '7776000' => &mt('last three months'),
15157: '15552000' => &mt('last six months'),
15158: '31104000' => &mt('last year'),
15159: 'select_form_order' =>
15160: ['-1','86400','604800','2592000','7776000',
15161: '15552000','31104000']});
15162: }
15163: }
15164:
15165: =pod
15166:
15167: =item * &js_changer()
15168:
15169: Create script tag containing Javascript used to submit course search form
1.1183 raeburn 15170: when course type or domain is changed, and also to hide 'Searching ...' on
15171: page load completion for page showing search result.
1.1181 raeburn 15172:
15173: Inputs: None
15174:
1.1183 raeburn 15175: Returns: markup containing updateFilters() and hideSearching() javascript functions.
1.1181 raeburn 15176:
15177: Side Effects: None
15178:
15179: =cut
15180:
15181: sub js_changer {
15182: return <<ENDJS;
15183: <script type="text/javascript">
15184: // <![CDATA[
15185: function updateFilters(caller) {
15186: if (typeof(caller) != "undefined") {
15187: document.filterpicker.updater.value = caller.name;
15188: }
15189: document.filterpicker.submit();
15190: }
1.1183 raeburn 15191:
15192: function hideSearching() {
15193: if (document.getElementById('searching')) {
15194: document.getElementById('searching').style.display = 'none';
15195: }
15196: return;
15197: }
15198:
1.1181 raeburn 15199: // ]]>
15200: </script>
15201:
15202: ENDJS
15203: }
15204:
15205: =pod
15206:
1.1182 raeburn 15207: =item * &search_courses()
15208:
15209: Process selected filters form course search form and pass to lonnet::courseiddump
15210: to retrieve a hash for which keys are courseIDs which match the selected filters.
15211:
15212: Inputs:
15213:
15214: dom - domain being searched
15215:
15216: type - course type ('Course' or 'Community' or '.' if any).
15217:
15218: filter - anonymous hash of criteria and their values
15219:
15220: numtitles - for institutional codes - number of categories
15221:
15222: cloneruname - optional username of new course owner
15223:
15224: clonerudom - optional domain of new course owner
15225:
15226: domcloner - Optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by,
15227: (used when DC is using course creation form)
15228:
15229: codetitles - reference to array of titles of components in institutional codes (official courses).
15230:
15231:
15232: Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type.
15233:
15234:
15235: Side Effects: None
15236:
15237: =cut
15238:
15239:
15240: sub search_courses {
15241: my ($dom,$type,$filter,$numtitles,$cloneruname,$clonerudom,$domcloner,$codetitles) = @_;
15242: my (%courses,%showcourses,$cloner);
15243: if (($filter->{'ownerfilter'} ne '') ||
15244: ($filter->{'ownerdomfilter'} ne '')) {
15245: $filter->{'combownerfilter'} = $filter->{'ownerfilter'}.':'.
15246: $filter->{'ownerdomfilter'};
15247: }
15248: foreach my $item ('descriptfilter','coursefilter','combownerfilter') {
15249: if (!$filter->{$item}) {
15250: $filter->{$item}='.';
15251: }
15252: }
15253: my $now = time;
15254: my $timefilter =
15255: ($filter->{'sincefilter'}==-1?1:$now-$filter->{'sincefilter'});
15256: my ($createdbefore,$createdafter);
15257: if (($filter->{'createdfilter'} ne '') && ($filter->{'createdfilter'} !=-1)) {
15258: $createdbefore = $now;
15259: $createdafter = $now-$filter->{'createdfilter'};
15260: }
15261: my ($instcodefilter,$regexpok);
15262: if ($numtitles) {
15263: if ($env{'form.official'} eq 'on') {
15264: $instcodefilter =
15265: &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15266: $regexpok = 1;
15267: } elsif ($env{'form.official'} eq 'off') {
15268: $instcodefilter = &Apache::courseclassifier::instcode_search_str($dom,$numtitles,$codetitles);
15269: unless ($instcodefilter eq '') {
15270: $regexpok = -1;
15271: }
15272: }
15273: } else {
15274: $instcodefilter = $filter->{'instcodefilter'};
15275: }
15276: if ($instcodefilter eq '') { $instcodefilter = '.'; }
15277: if ($type eq '') { $type = '.'; }
15278:
15279: if (($clonerudom ne '') && ($cloneruname ne '')) {
15280: $cloner = $cloneruname.':'.$clonerudom;
15281: }
15282: %courses = &Apache::lonnet::courseiddump($dom,
15283: $filter->{'descriptfilter'},
15284: $timefilter,
15285: $instcodefilter,
15286: $filter->{'combownerfilter'},
15287: $filter->{'coursefilter'},
15288: undef,undef,$type,$regexpok,undef,undef,
15289: undef,undef,$cloner,$env{'form.cc_clone'},
15290: $filter->{'cloneableonly'},
15291: $createdbefore,$createdafter,undef,
15292: $domcloner);
15293: if (($filter->{'personfilter'} ne '') && ($filter->{'persondomfilter'} ne '')) {
15294: my $ccrole;
15295: if ($type eq 'Community') {
15296: $ccrole = 'co';
15297: } else {
15298: $ccrole = 'cc';
15299: }
15300: my %rolehash = &Apache::lonnet::get_my_roles($filter->{'personfilter'},
15301: $filter->{'persondomfilter'},
15302: 'userroles',undef,
15303: [$ccrole,'in','ad','ep','ta','cr'],
15304: $dom);
15305: foreach my $role (keys(%rolehash)) {
15306: my ($cnum,$cdom,$courserole) = split(':',$role);
15307: my $cid = $cdom.'_'.$cnum;
15308: if (exists($courses{$cid})) {
15309: if (ref($courses{$cid}) eq 'HASH') {
15310: if (ref($courses{$cid}{roles}) eq 'ARRAY') {
15311: if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
15312: push (@{$courses{$cid}{roles}},$courserole);
15313: }
15314: } else {
15315: $courses{$cid}{roles} = [$courserole];
15316: }
15317: $showcourses{$cid} = $courses{$cid};
15318: }
15319: }
15320: }
15321: %courses = %showcourses;
15322: }
15323: return %courses;
15324: }
15325:
15326:
15327: =pod
15328:
1.1181 raeburn 15329: =back
15330:
15331: =cut
15332:
15333:
1.1083 raeburn 15334: sub update_content_constraints {
15335: my ($cdom,$cnum,$chome,$cid) = @_;
15336: my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
15337: my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
15338: my %checkresponsetypes;
15339: foreach my $key (keys(%Apache::lonnet::needsrelease)) {
15340: my ($item,$name,$value) = split(/:/,$key);
15341: if ($item eq 'resourcetag') {
15342: if ($name eq 'responsetype') {
15343: $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
15344: }
15345: }
15346: }
15347: my $navmap = Apache::lonnavmaps::navmap->new();
15348: if (defined($navmap)) {
15349: my %allresponses;
15350: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {
15351: my %responses = $res->responseTypes();
15352: foreach my $key (keys(%responses)) {
15353: next unless(exists($checkresponsetypes{$key}));
15354: $allresponses{$key} += $responses{$key};
15355: }
15356: }
15357: foreach my $key (keys(%allresponses)) {
15358: my ($major,$minor) = split(/\./,$checkresponsetypes{$key});
15359: if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) {
15360: ($reqdmajor,$reqdminor) = ($major,$minor);
15361: }
15362: }
15363: undef($navmap);
15364: }
15365: unless (($reqdmajor eq '') && ($reqdminor eq '')) {
15366: &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
15367: }
15368: return;
15369: }
15370:
1.1110 raeburn 15371: sub allmaps_incourse {
15372: my ($cdom,$cnum,$chome,$cid) = @_;
15373: if ($cdom eq '' || $cnum eq '' || $chome eq '' || $cid eq '') {
15374: $cid = $env{'request.course.id'};
15375: $cdom = $env{'course.'.$cid.'.domain'};
15376: $cnum = $env{'course.'.$cid.'.num'};
15377: $chome = $env{'course.'.$cid.'.home'};
15378: }
15379: my %allmaps = ();
15380: my $lastchange =
15381: &Apache::lonnet::get_coursechange($cdom,$cnum);
15382: if ($lastchange > $env{'request.course.tied'}) {
15383: my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
15384: unless ($ferr) {
15385: &update_content_constraints($cdom,$cnum,$chome,$cid);
15386: }
15387: }
15388: my $navmap = Apache::lonnavmaps::navmap->new();
15389: if (defined($navmap)) {
15390: foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_map() },1,0,1)) {
15391: $allmaps{$res->src()} = 1;
15392: }
15393: }
15394: return \%allmaps;
15395: }
15396:
1.1083 raeburn 15397: sub parse_supplemental_title {
15398: my ($title) = @_;
15399:
15400: my ($foldertitle,$renametitle);
15401: if ($title =~ /&&&/) {
15402: $title = &HTML::Entites::decode($title);
15403: }
15404: if ($title =~ m/^(\d+)___&&&___($match_username)___&&&___($match_domain)___&&&___(.*)$/) {
15405: $renametitle=$4;
15406: my ($time,$uname,$udom) = ($1,$2,$3);
15407: $foldertitle=&Apache::lontexconvert::msgtexconverted($4);
15408: my $name = &plainname($uname,$udom);
15409: $name = &HTML::Entities::encode($name,'"<>&\'');
15410: $renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
15411: $title='<i>'.&Apache::lonlocal::locallocaltime($time).'</i> '.
15412: $name.': <br />'.$foldertitle;
15413: }
15414: if (wantarray) {
15415: return ($title,$foldertitle,$renametitle);
15416: }
15417: return $title;
15418: }
15419:
1.1143 raeburn 15420: sub recurse_supplemental {
15421: my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
15422: if ($suppmap) {
15423: my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
15424: if ($fatal) {
15425: $errors ++;
15426: } else {
15427: if ($#LONCAPA::map::resources > 0) {
15428: foreach my $res (@LONCAPA::map::resources) {
15429: my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
15430: if (($src ne '') && ($status eq 'res')) {
1.1146 raeburn 15431: if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
15432: ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
1.1143 raeburn 15433: } else {
15434: $numfiles ++;
15435: }
15436: }
15437: }
15438: }
15439: }
15440: }
15441: return ($numfiles,$errors);
15442: }
15443:
1.1101 raeburn 15444: sub symb_to_docspath {
15445: my ($symb) = @_;
15446: return unless ($symb);
15447: my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
15448: if ($resurl=~/\.(sequence|page)$/) {
15449: $mapurl=$resurl;
15450: } elsif ($resurl eq 'adm/navmaps') {
15451: $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
15452: }
15453: my $mapresobj;
15454: my $navmap = Apache::lonnavmaps::navmap->new();
15455: if (ref($navmap)) {
15456: $mapresobj = $navmap->getResourceByUrl($mapurl);
15457: }
15458: $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
15459: my $type=$2;
15460: my $path;
15461: if (ref($mapresobj)) {
15462: my $pcslist = $mapresobj->map_hierarchy();
15463: if ($pcslist ne '') {
15464: foreach my $pc (split(/,/,$pcslist)) {
15465: next if ($pc <= 1);
15466: my $res = $navmap->getByMapPc($pc);
15467: if (ref($res)) {
15468: my $thisurl = $res->src();
15469: $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
15470: my $thistitle = $res->title();
15471: $path .= '&'.
15472: &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
1.1146 raeburn 15473: &escape($thistitle).
1.1101 raeburn 15474: ':'.$res->randompick().
15475: ':'.$res->randomout().
15476: ':'.$res->encrypted().
15477: ':'.$res->randomorder().
15478: ':'.$res->is_page();
15479: }
15480: }
15481: }
15482: $path =~ s/^\&//;
15483: my $maptitle = $mapresobj->title();
15484: if ($mapurl eq 'default') {
1.1129 raeburn 15485: $maptitle = 'Main Content';
1.1101 raeburn 15486: }
15487: $path .= (($path ne '')? '&' : '').
15488: &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 15489: &escape($maptitle).
1.1101 raeburn 15490: ':'.$mapresobj->randompick().
15491: ':'.$mapresobj->randomout().
15492: ':'.$mapresobj->encrypted().
15493: ':'.$mapresobj->randomorder().
15494: ':'.$mapresobj->is_page();
15495: } else {
15496: my $maptitle = &Apache::lonnet::gettitle($mapurl);
15497: my $ispage = (($type eq 'page')? 1 : '');
15498: if ($mapurl eq 'default') {
1.1129 raeburn 15499: $maptitle = 'Main Content';
1.1101 raeburn 15500: }
15501: $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
1.1146 raeburn 15502: &escape($maptitle).':::::'.$ispage;
1.1101 raeburn 15503: }
15504: unless ($mapurl eq 'default') {
15505: $path = 'default&'.
1.1146 raeburn 15506: &escape('Main Content').
1.1101 raeburn 15507: ':::::&'.$path;
15508: }
15509: return $path;
15510: }
15511:
1.1094 raeburn 15512: sub captcha_display {
15513: my ($context,$lonhost) = @_;
15514: my ($output,$error);
15515: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 15516: if ($captcha eq 'original') {
1.1094 raeburn 15517: $output = &create_captcha();
15518: unless ($output) {
1.1172 raeburn 15519: $error = 'captcha';
1.1094 raeburn 15520: }
15521: } elsif ($captcha eq 'recaptcha') {
15522: $output = &create_recaptcha($pubkey);
15523: unless ($output) {
1.1172 raeburn 15524: $error = 'recaptcha';
1.1094 raeburn 15525: }
15526: }
1.1176 raeburn 15527: return ($output,$error,$captcha);
1.1094 raeburn 15528: }
15529:
15530: sub captcha_response {
15531: my ($context,$lonhost) = @_;
15532: my ($captcha_chk,$captcha_error);
15533: my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
1.1095 raeburn 15534: if ($captcha eq 'original') {
1.1094 raeburn 15535: ($captcha_chk,$captcha_error) = &check_captcha();
15536: } elsif ($captcha eq 'recaptcha') {
15537: $captcha_chk = &check_recaptcha($privkey);
15538: } else {
15539: $captcha_chk = 1;
15540: }
15541: return ($captcha_chk,$captcha_error);
15542: }
15543:
15544: sub get_captcha_config {
15545: my ($context,$lonhost) = @_;
1.1095 raeburn 15546: my ($captcha,$pubkey,$privkey,$hashtocheck);
1.1094 raeburn 15547: my $hostname = &Apache::lonnet::hostname($lonhost);
15548: my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
15549: my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
1.1095 raeburn 15550: if ($context eq 'usercreation') {
15551: my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
15552: if (ref($domconfig{$context}) eq 'HASH') {
15553: $hashtocheck = $domconfig{$context}{'cancreate'};
15554: if (ref($hashtocheck) eq 'HASH') {
15555: if ($hashtocheck->{'captcha'} eq 'recaptcha') {
15556: if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
15557: $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
15558: $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
15559: }
15560: if ($privkey && $pubkey) {
15561: $captcha = 'recaptcha';
15562: } else {
15563: $captcha = 'original';
15564: }
15565: } elsif ($hashtocheck->{'captcha'} ne 'notused') {
15566: $captcha = 'original';
15567: }
1.1094 raeburn 15568: }
1.1095 raeburn 15569: } else {
15570: $captcha = 'captcha';
15571: }
15572: } elsif ($context eq 'login') {
15573: my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
15574: if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
15575: $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
15576: $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
1.1094 raeburn 15577: if ($privkey && $pubkey) {
15578: $captcha = 'recaptcha';
1.1095 raeburn 15579: } else {
15580: $captcha = 'original';
1.1094 raeburn 15581: }
1.1095 raeburn 15582: } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
15583: $captcha = 'original';
1.1094 raeburn 15584: }
15585: }
15586: return ($captcha,$pubkey,$privkey);
15587: }
15588:
15589: sub create_captcha {
15590: my %captcha_params = &captcha_settings();
15591: my ($output,$maxtries,$tries) = ('',10,0);
15592: while ($tries < $maxtries) {
15593: $tries ++;
15594: my $captcha = Authen::Captcha->new (
15595: output_folder => $captcha_params{'output_dir'},
15596: data_folder => $captcha_params{'db_dir'},
15597: );
15598: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
15599:
15600: if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
15601: $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
15602: &mt('Type in the letters/numbers shown below').' '.
1.1176 raeburn 15603: '<input type="text" size="5" name="code" value="" autocomplete="off" />'.
15604: '<br />'.
15605: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
1.1094 raeburn 15606: last;
15607: }
15608: }
15609: return $output;
15610: }
15611:
15612: sub captcha_settings {
15613: my %captcha_params = (
15614: output_dir => $Apache::lonnet::perlvar{'lonCaptchaDir'},
15615: www_output_dir => "/captchaspool",
15616: db_dir => $Apache::lonnet::perlvar{'lonCaptchaDb'},
15617: numchars => '5',
15618: );
15619: return %captcha_params;
15620: }
15621:
15622: sub check_captcha {
15623: my ($captcha_chk,$captcha_error);
15624: my $code = $env{'form.code'};
15625: my $md5sum = $env{'form.crypt'};
15626: my %captcha_params = &captcha_settings();
15627: my $captcha = Authen::Captcha->new(
15628: output_folder => $captcha_params{'output_dir'},
15629: data_folder => $captcha_params{'db_dir'},
15630: );
1.1109 raeburn 15631: $captcha_chk = $captcha->check_code($code,$md5sum);
1.1094 raeburn 15632: my %captcha_hash = (
15633: 0 => 'Code not checked (file error)',
15634: -1 => 'Failed: code expired',
15635: -2 => 'Failed: invalid code (not in database)',
15636: -3 => 'Failed: invalid code (code does not match crypt)',
15637: );
15638: if ($captcha_chk != 1) {
15639: $captcha_error = $captcha_hash{$captcha_chk}
15640: }
15641: return ($captcha_chk,$captcha_error);
15642: }
15643:
15644: sub create_recaptcha {
15645: my ($pubkey) = @_;
1.1153 raeburn 15646: my $use_ssl;
15647: if ($ENV{'SERVER_PORT'} == 443) {
15648: $use_ssl = 1;
15649: }
1.1094 raeburn 15650: my $captcha = Captcha::reCAPTCHA->new;
15651: return $captcha->get_options_setter({theme => 'white'})."\n".
1.1153 raeburn 15652: $captcha->get_html($pubkey,undef,$use_ssl).
1.1094 raeburn 15653: &mt('If either word is hard to read, [_1] will replace them.',
1.1133 raeburn 15654: '<img src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
1.1094 raeburn 15655: '<br /><br />';
15656: }
15657:
15658: sub check_recaptcha {
15659: my ($privkey) = @_;
15660: my $captcha_chk;
15661: my $captcha = Captcha::reCAPTCHA->new;
15662: my $captcha_result =
15663: $captcha->check_answer(
15664: $privkey,
15665: $ENV{'REMOTE_ADDR'},
15666: $env{'form.recaptcha_challenge_field'},
15667: $env{'form.recaptcha_response_field'},
15668: );
15669: if ($captcha_result->{is_valid}) {
15670: $captcha_chk = 1;
15671: }
15672: return $captcha_chk;
15673: }
15674:
1.1174 raeburn 15675: sub emailusername_info {
1.1177 raeburn 15676: my @fields = ('firstname','lastname','institution','web','location','officialemail');
1.1174 raeburn 15677: my %titles = &Apache::lonlocal::texthash (
15678: lastname => 'Last Name',
15679: firstname => 'First Name',
15680: institution => 'School/college/university',
15681: location => "School's city, state/province, country",
15682: web => "School's web address",
15683: officialemail => 'E-mail address at institution (if different)',
15684: );
15685: return (\@fields,\%titles);
15686: }
15687:
1.1161 raeburn 15688: sub cleanup_html {
15689: my ($incoming) = @_;
15690: my $outgoing;
15691: if ($incoming ne '') {
15692: $outgoing = $incoming;
15693: $outgoing =~ s/;/;/g;
15694: $outgoing =~ s/\#/#/g;
15695: $outgoing =~ s/\&/&/g;
15696: $outgoing =~ s/</</g;
15697: $outgoing =~ s/>/>/g;
15698: $outgoing =~ s/\(/(/g;
15699: $outgoing =~ s/\)/)/g;
15700: $outgoing =~ s/"/"/g;
15701: $outgoing =~ s/'/'/g;
15702: $outgoing =~ s/\$/$/g;
15703: $outgoing =~ s{/}{/}g;
15704: $outgoing =~ s/=/=/g;
15705: $outgoing =~ s/\\/\/g
15706: }
15707: return $outgoing;
15708: }
15709:
1.1190 musolffc 15710: # Checks for critical messages and returns a redirect url if one exists.
15711: # $interval indicates how often to check for messages.
15712: sub critical_redirect {
15713: my ($interval) = @_;
15714: if ((time-$env{'user.criticalcheck.time'})>$interval) {
15715: my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
15716: $env{'user.name'});
15717: &Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
1.1191 raeburn 15718: my $redirecturl;
1.1190 musolffc 15719: if ($what[0]) {
15720: if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
15721: $redirecturl='/adm/email?critical=display';
1.1191 raeburn 15722: my $url=&Apache::lonnet::absolute_url().$redirecturl;
15723: return (1, $url);
1.1190 musolffc 15724: }
1.1191 raeburn 15725: }
15726: }
15727: return ();
1.1190 musolffc 15728: }
15729:
1.1174 raeburn 15730: # Use:
15731: # my $answer=reply("encrypt:passwd:$udom:$uname:$upass",$tryserver);
15732: #
15733: ##################################################
15734: # password associated functions #
15735: ##################################################
15736: sub des_keys {
15737: # Make a new key for DES encryption.
15738: # Each key has two parts which are returned separately.
15739: # Please note: Each key must be passed through the &hex function
15740: # before it is output to the web browser. The hex versions cannot
15741: # be used to decrypt.
15742: my @hexstr=('0','1','2','3','4','5','6','7',
15743: '8','9','a','b','c','d','e','f');
15744: my $lkey='';
15745: for (0..7) {
15746: $lkey.=$hexstr[rand(15)];
15747: }
15748: my $ukey='';
15749: for (0..7) {
15750: $ukey.=$hexstr[rand(15)];
15751: }
15752: return ($lkey,$ukey);
15753: }
15754:
15755: sub des_decrypt {
15756: my ($key,$cyphertext) = @_;
15757: my $keybin=pack("H16",$key);
15758: my $cypher;
15759: if ($Crypt::DES::VERSION>=2.03) {
15760: $cypher=new Crypt::DES $keybin;
15761: } else {
15762: $cypher=new DES $keybin;
15763: }
15764: my $plaintext=
15765: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,0,16))));
15766: $plaintext.=
15767: $cypher->decrypt(unpack("a8",pack("H16",substr($cyphertext,16,16))));
15768: $plaintext=substr($plaintext,1,ord(substr($plaintext,0,1)) );
15769: return $plaintext;
15770: }
15771:
1.112 bowersj2 15772: 1;
15773: __END__;
1.41 ng 15774:
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